ad hoc defs of string-named words

Author: bbqbaron

src/purr/client.cljs

@@ -17,19 +17,22 @@
   (let [{:keys [expr error]} (rum/react state)]
     [:div
      [:h3 "Type some code!"]
-     [:input {:on-change (fn [evt]
-                           (let [val (get-val evt)
-                                 result (try
-                                          {:expr (run val)
-                                           :error nil}
-                                          (catch js/Error e
-                                            {:error (.-message e)
-                                             :expr nil}))]
-                             (swap! state
-                                    (fn [old]
-                                      (-> old
-                                          (assoc :code val)
-                                          (merge result))))))}]
+     [:textarea
+      {:auto-focus true
+       :on-change (fn [evt]
+                    (let [val (get-val evt)
+                          result (try
+                                   {:expr  (run val)
+                                    :error nil}
+                                   (catch js/Error e
+                                     {:error (.-message e)
+                                      :expr  nil}))]
+                      (swap! state
+                             (fn [old]
+                               (-> old
+                                   (assoc :code val)
+                                   (merge result))))))
+       :rows 5}]
      (when expr
        [:p "Result: " expr])
      (when error

src/purr/parse.cljc

@@ -11,7 +11,7 @@
      BLOCK = '[' TERM* ']' ;
      NUM = #'\\-?\\d+(\\.\\d+)?' ;
      OP = '+' | '/' | '-' | '*' | '>' | '<' | '<=' | '>=' ;
-     TERM = (WORD | BLOCK | STR | NUM | OP) #' ?' ; "))
+     TERM = (WORD | BLOCK | STR | NUM | OP) #'\\s?' ; "))
 
 (defn to-num [string]
   #?(:clj (read-string string)

src/purr/run.cljc

@@ -13,6 +13,10 @@
    stack])
 
 (def words
+  "Map of word names to functions that return:
+  [new-expressions
+   new-stack
+   new-library]"
   {"+"      (partial binary +)
    "-"      (partial binary -)
    "*"      (partial binary *)
@@ -22,6 +26,13 @@
    "<="     (partial binary <=)
    ">="     (partial binary >=)
    "!="     (partial binary not=)
+   "def"    (fn [[fn-name body & rest]]
+              [[]
+               rest
+               {fn-name
+                (if (coll? body)
+                    body
+                    [body])}])
    "dup"    (fn [stack] [[(first stack)] stack])
    "dup2"   (fn [stack] [(reverse (take 2 stack)) stack])
    "drop"   (fn [stack] [[] (rest stack)])
@@ -50,21 +61,26 @@
 (defn run-word [word lib stack]
   (let [task (get lib word)]
     (if task
-      (task stack)
+      (if (fn? task)
+        (task stack)
+        [task stack])
       (let [error (str "word not found: " word)]
         #?(:clj  (throw (Exception. error))
            :cljs (throw (js/Error. error)))))))
 
-(defn exec [stack-0 lib exprs-0]
-  (loop [stack stack-0 exprs exprs-0]
+(defn exec [stack-0 lib-0 exprs-0]
+  (loop [stack stack-0 exprs exprs-0 lib lib-0]
     (let [expr (first exprs)]
       (cond
         (nil? expr) stack
         (symbol? expr)
-        (let [[newexprs newstack] (run-word (str expr) lib stack)]
-          (recur newstack (concat newexprs (rest exprs))))
+        (let [[newexprs newstack new-lib] (run-word (str expr) lib stack)]
+          (recur
+            newstack
+            (concat newexprs (rest exprs))
+            (merge lib new-lib)))
         (or (= expr true) (= expr false) (number? expr) (string? expr) (char? expr) (coll? expr))
-        (recur (cons expr stack) (rest exprs))
+        (recur (cons expr stack) (rest exprs) lib)
         true
         (let [error (str "unrecognized: "
                          expr " of " (type expr))]

test/purr/core_test.clj

@@ -57,4 +57,10 @@
 (deftest fibonacci
   (is (= (run "1 1 [dup2 +] 5 repeat") "1 1 2 3 5 8 13")))
 
+(deftest def-word-alias
+  (is (= (run "1 \"one\" def one") "1")))
+
+(deftest def-words
+  (is (= (run "[1 +] \"inc\" def 2 inc") "3")))
+
 (run-tests 'purr.core-test)

test/purr/parse_test.clj

@@ -18,4 +18,7 @@
 (deftest block
   (is (= (parse "1 [2 3]") [1 [2 3]])))
 
+(deftest newlines
+  (is (= (parse "1\n2\n+") [1 2 '+])))
+
 (run-tests 'purr.parse-test)