forth

config.json

@@ -502,6 +502,14 @@
         "practices": [],
         "prerequisites": [],
         "difficulty": 7
+      },
+      {
+        "slug": "forth",
+        "name": "Forth",
+        "uuid": "effcc47c-8a75-46be-b6f1-b0a9f00527ff",
+        "practices": [],
+        "prerequisites": [],
+        "difficulty": 8
       }
     ]
   },

exercises/practice/forth/.busted

@@ -0,0 +1,5 @@
+return {
+  default = {
+    ROOT = { '.' }
+  }
+}

exercises/practice/forth/.docs/instructions.md

@@ -0,0 +1,23 @@
+# Instructions
+
+Implement an evaluator for a very simple subset of Forth.
+
+[Forth][forth]
+is a stack-based programming language.
+Implement a very basic evaluator for a small subset of Forth.
+
+Your evaluator has to support the following words:
+
+- `+`, `-`, `*`, `/` (integer arithmetic)
+- `DUP`, `DROP`, `SWAP`, `OVER` (stack manipulation)
+
+Your evaluator also has to support defining new words using the customary syntax: `: word-name definition ;`.
+
+To keep things simple the only data type you need to support is signed integers of at least 16 bits size.
+
+You should use the following rules for the syntax: a number is a sequence of one or more (ASCII) digits, a word is a sequence of one or more letters, digits, symbols or punctuation that is not a number.
+(Forth probably uses slightly different rules, but this is close enough.)
+
+Words are case-insensitive.
+
+[forth]: https://en.wikipedia.org/wiki/Forth_%28programming_language%29

exercises/practice/forth/.meta/config.json

@@ -0,0 +1,17 @@
+{
+  "authors": [
+    "glennj"
+  ],
+  "files": {
+    "solution": [
+      "forth.moon"
+    ],
+    "test": [
+      "forth_spec.moon"
+    ],
+    "example": [
+      ".meta/example.moon"
+    ]
+  },
+  "blurb": "Implement an evaluator for a very simple subset of Forth."
+}

exercises/practice/forth/.meta/example.moon

@@ -0,0 +1,109 @@
+class Stack
+  new: (@stack = {}) =>
+
+  push: (val) => table.insert @stack, val
+  pop: => table.remove @stack
+  peek: => @stack[#@stack]
+  size: => #@stack
+  tolist: => @stack
+
+
+class Forth
+  new: =>
+    @_stack = Stack!
+    @_primatives = {
+      dup:   (-> @dup!),
+      drop:  (-> @drop!),
+      swap:  (-> @swap!),
+      over:  (-> @over!),
+      ['+']: (-> @add!),
+      ['-']: (-> @sub!),
+      ['*']: (-> @mul!),
+      ['/']: (-> @div!),
+    }
+    @_words = {}
+
+  stack: => @_stack\tolist!
+
+  evaluate: (script) =>
+    program = (table.concat script, ' ')\lower!
+    tokens = [token for token in program\gmatch('[^%s]+')]
+
+    while #tokens > 0
+      token = table.remove tokens, 1
+
+      if @_words[token]
+        -- prepend the user-defined word into the tokens list
+        table.insert(tokens, i, v) for i, v in ipairs @_words[token]
+
+      elseif token == ':'
+        -- consume a bunch of tokens for the user word, and return the rest
+        tokens = @_user_word tokens
+
+      elseif @_primatives[token]
+        @_primatives[token]!
+
+      else
+        num = tonumber token
+        assert num, 'undefined operation'
+        @_stack\push num
+
+  -- user-defined words
+  _user_word: (tokens) =>
+    name = table.remove tokens, 1
+    assert not tonumber(name), 'illegal operation'
+
+    definition = {}
+    while true
+      token = table.remove tokens, 1
+      break if token == ';'
+      if @_words[token]
+        table.insert definition, i, v for i, v in ipairs @_words[token]
+      else
+        table.insert definition, token
+
+    @_words[name] = definition
+    tokens
+
+  -- Arithmetic
+  add: => @_binary_op (a, b) -> a + b
+  sub: => @_binary_op (a, b) -> a - b
+  mul: => @_binary_op (a, b) -> a * b
+  div: =>
+    assert @_stack\peek! != 0,  'divide by zero'
+    @_binary_op (a, b) -> a // b
+
+  _binary_op: (f) =>
+    @_need 2
+    b = @_stack\pop!
+    a = @_stack\pop!
+    @_stack\push f(a, b)
+
+  -- stack manipulation
+  dup: =>
+    @_need 1
+    @_stack\push @_stack\peek!
+
+  drop: =>
+    @_need 1
+    _ = @_stack\pop!
+
+  swap: =>
+    @_need 2
+    b = @_stack\pop!
+    a = @_stack\pop!
+    @_stack\push b
+    @_stack\push a
+
+  over: =>
+    @_need 2
+    b = @_stack\pop!
+    a = @_stack\peek!
+    @_stack\push b
+    @_stack\push a
+
+  -- utils
+  _need: (n) =>
+    switch @_stack\size!
+      when 0 then error 'empty stack'
+      when 1 then error 'only one value on the stack' if n > 1

exercises/practice/forth/.meta/spec_generator.moon

@@ -0,0 +1,53 @@
+table_contains = (list, target) ->
+  for elem in *list
+    return true if elem == target
+  false
+
+int_list = (list) -> "{#{table.concat list, ', '}}"
+
+instruction_list = (list, level) ->
+  if #list <= 2
+    "{#{table.concat [quote elem for elem in *list], ', '}}"
+  else
+    instrs = [indent quote(elem) .. ',', level + 1 for elem in *list]
+    table.insert instrs, 1, '{'
+    table.insert instrs, indent('}', level)
+    table.concat instrs, '\n'
+
+
+{
+  module_name: 'Forth',
+
+  generate_test: (case, level) ->
+    local lines
+    if case.scenarios and table_contains case.scenarios, 'local-scope'
+      lines = {
+        "interp1 = Forth!",
+        "interp2 = Forth!",
+        "interp1\\evaluate #{instruction_list case.input.instructionsFirst, level}",
+        "interp2\\evaluate #{instruction_list case.input.instructionsSecond, level}",
+        "assert.are.same #{int_list case.expected[1]}, interp1\\stack!",
+        "assert.are.same #{int_list case.expected[2]}, interp2\\stack!",
+      }
+
+    else
+      lines = {
+        'interpreter = Forth!',
+        "instructions = #{instruction_list case.input.instructions, level}",
+      }
+
+      if case.expected.error
+        table.insert lines, line for line in *{
+          'f = -> interpreter\\evaluate instructions',
+          "assert.has.errors f, #{quote case.expected.error}"
+        }
+
+      else
+        table.insert lines, line for line in *{
+          'interpreter\\evaluate instructions',
+          "expected = #{int_list case.expected}",
+          'assert.is.same expected, interpreter\\stack!'
+        }
+
+    table.concat [indent line, level for line in *lines], '\n'
+}