6 files changed, 127 insertions(+), 44 deletions(-)

M main.janet
M src/adverbs.janet
M src/calc.janet
M src/parser.janet
M test/calc.janet
M test/parser.janet

@@ 1,5 1,33 @@
 (import /src/calc)
+(import /src/print)
+(import /src/parser)
+
+(defn display
+  [data]
+  (print (print/p data))
+  "")
+
+(defn display-all
+  [stack]
+  (let [inner (map print/p stack)]
+    (print (string/join inner " ")))
+  "")
+
+(defn handle-commands
+  [in s]
+  (case (freeze (string/trim in))
+    "." (display (calc/peek s))
+    "p" (display (calc/pop s))
+    "s" (display-all (s :data))
+    in))
 
 (defn main
   [args]
-  (let [s (:new calc/Stack)]))
+  (let [s (:new calc/Stack)]
+    (while true
+      (let [buf @""
+            prompt (string/format "[%s]> " (print/p (calc/peek s)))
+            in (getline prompt buf parser/dictionary)
+            after-commands (handle-commands in s)
+            parsed (parser/parse after-commands)]
+        (calc/push-all s parsed)))))

@@ 16,7 16,12 @@
       (each verb-elem (calc/data quoted-verb)
         (calc/push stack verb-elem)))))
 
-(defadv apply-operation 1
+(defadv apply-vector 1
   (let [quoted-verb (calc/pop stack)]
     (each elem (calc/data quoted-verb)
       (calc/push stack elem))))
+
+(defadv wrap-stack 0
+  (let [v (calc/wrap ;(stack :data))]
+    (array/clear (stack :data))
+    (calc/push stack v)))

@@ 30,14 30,14 @@
   [self shape-to-fill]
   (let [x (array ;(shape self))
         y (array ;shape-to-fill)]
-    
+
     (while (not (empty? x))
       (let [xi (array/pop x)
             yi (array/pop y)]
         (unless (= xi yi)
           (errorf "Shape error: can't fill vector with shape %q to %q"
                   (shape self) shape-to-fill))))
-    
+
     (reduce (fn [acc length]
               (let [new-shape (tuple length ;(shape acc))
                     new-data (array/new-filled length acc)]


@@ 92,11 92,9 @@
             arity
             (size stack))))
 
-(defn- make-element
-  # TODO: Do we want to do something more sophisticated here?
-  [elem]
-  (cond (number? elem)
-        (:new Float elem)))
+# TODO: Do we want to do something more sophisticated here?
+(defmulti make-element [:number] [n] (:new Float n))
+(defmulti make-element [_] [v] v)
 
 (defmulti push [Stack Operation]
   [self op]


@@ 106,7 104,7 @@
     (def buf @[])
     (loop [_ :range [0 arity]]
       (array/push buf (pop self)))
-    
+
     (push self (make-element (apply-operation op ;buf)))))
 
 (defmulti push [Stack _]

@@ 2,19 2,21 @@
 (import /src/operations)
 (import /src/adverbs)
 
-(def- dictionary {"+" operations/add
-                  "-" operations/sub
-                  "*" operations/mul
-                  "x" operations/mul
-                  "%" operations/div
-                  "sqrt" operations/sqrt
-                  "/" adverbs/distribute-dyad
-                  ">" operations/gt
-                  "<" operations/lt
-                  ">=" operations/gte
-                  "<=" operations/lte
-                  "=" operations/eq
-                 "cmp" operations/cmp})
+(def dictionary {"+" operations/add
+                 "-" operations/sub
+                 "*" operations/mul
+                 "x" operations/mul
+                 "%" operations/div
+                 "sqrt" operations/sqrt
+                 ">" operations/gt
+                 "<" operations/lt
+                 ">=" operations/gte
+                 "<=" operations/lte
+                 "=" operations/eq
+                 "cmp" operations/cmp
+                 "/" adverbs/distribute-dyad
+                 "!" adverbs/apply-vector
+                 "@" adverbs/wrap-stack})
 
 (defn handle-parens
   [& patt]


@@ 38,13 40,13 @@
       (errorf "syntax error: unknown word %s" patt)))
 
 (def- peg (peg/compile
-           ~{:main (any (+ :s+ :brackets :token))
-             :brackets (cmt (* "[" :main "]") ,handle-brackets)
-             :number-part (some (+ :d "_"))
-             :float (cmt (<- (* (? "-") :number-part "." :number-part)) ,handle-float)
-             :int (cmt (<- (* (? "-") :number-part)) ,handle-int)
-             :word (cmt (<- (some (if-not (+ :s (set "()[]")) 1))) ,handle-word)
-             :token (+ :float :int :word)}))
+            ~{:main (any (+ :s+ :brackets :token))
+              :brackets (cmt (* "[" :main "]") ,handle-brackets)
+              :number-part (some (+ :d "_"))
+              :float (cmt (<- (* (? "-") :number-part "." :number-part)) ,handle-float)
+              :int (cmt (<- (* (? "-") :number-part)) ,handle-int)
+              :word (cmt (<- (some (if-not (+ :s (set "()[]")) 1))) ,handle-word)
+              :token (+ :float :int :word)}))
 
 (defn parse
   [str]

@@ 4,7 4,7 @@
 (import /src/adverbs :prefix "a/")
 
 (use testament)
-  
+
 (defn- rec-data [vec]
   (match vec
     {:data data} (map rec-data data)


@@ 25,7 25,7 @@
 (deftest vectors
   (def v (wrap 1 2 3))
   (def v2 (wrap 2 5 10))
-  
+
   (vec= [4 5 6] (calc/apply-operation o/add v (:new calc/Int 3)))
   (vec= [3 7 13] (calc/apply-operation o/add v v2))
 


@@ 37,14 37,14 @@
 (deftest matrices
   (is (thrown? (wrap (wrap 1) (wrap 1 2)))
       "Inner vectors are of differing sizes")
-  
+
   (def m (wrap (wrap 1 2 3)
                (wrap 4 5 6)))
   (is (= [2 3] (calc/get-shape m)))
-  
+
   (def filled (calc/fill m [2 2 3]))
   (is (= [2 2 3] (calc/get-shape filled)))
-  
+
   (vec= @[@[@[1 2 3]
             @[4 5 6]]
           @[@[1 2 3]


@@ 60,6 60,10 @@
             @[8 10 12]]]
         (calc/apply-operation o/add m filled)))
 
+(defn- pop-and-compare
+  [val s]
+  (is (= val (calc/value (calc/pop s)))))
+
 (deftest distribute-dyad-add
   (def s (:new calc/Stack))
   # Initial value


@@ 69,7 73,7 @@
   # Operator
   (calc/push s (wrap o/add))
   (calc/push s a/distribute-dyad)
-  (is (= 6 (calc/value (calc/peek s)))))
+  (pop-and-compare 6 s))
 
 (deftest distribute-dyad-multiple-operations
   (def s (:new calc/Stack))


@@ 77,6 81,52 @@
   (calc/push s (wrap 1 2 3))
   (calc/push s (wrap 3 o/mul o/add))
   (calc/push s a/distribute-dyad)
-  (is (= 18 (calc/value (calc/peek s)))))
+  (pop-and-compare 18 s))
+
+(deftest apply-vector
+  (def s (:new calc/Stack))
+  (calc/push s (wrap 1 2 3))
+  (calc/push s a/apply-vector)
+  (pop-and-compare 3 s)
+  (pop-and-compare 2 s)
+  (pop-and-compare 1 s)
+  (is (empty? (s :data))))
+
+(deftest apply-operation
+  (def s (:new calc/Stack))
+  (calc/push s (:new calc/Int 3))
+  (calc/push s (:new calc/Int 5))
+  (calc/push s (wrap o/add))
+  (calc/push s a/apply-vector)
+  (pop-and-compare 8 s)
+  (is (empty? (s :data))))
+
+(deftest wrap-stack
+  (def s (:new calc/Stack))
+  (calc/push s (:new calc/Int 3))
+  (calc/push s (:new calc/Int 4))
+  (calc/push s a/wrap-stack)
+
+  (def vec (calc/pop s))
+  (is (= [2] (calc/shape vec)))
+  (is (empty? (s :data))))
+
+(deftest wrap-vectors
+  (def s (:new calc/Stack))
+  (calc/push s (wrap 1 2))
+  (calc/push s (wrap 2 4))
+  (calc/push s a/wrap-stack)
+
+  (def vec (calc/pop s))
+  (is (= [2 2] (calc/shape vec)))
+  (is (empty? (s :data))))
+
+(deftest wrap-failure
+  (def s (:new calc/Stack))
+  (calc/push s (wrap 1))
+  (calc/push s (wrap 2 4))
+  (is (thrown?
+        (calc/push s a/wrap-stack))
+      "Wrapping a stack requires homogeneous data"))
 
 (run-tests!)

@@ 16,16 16,16 @@
         [float] (parser/parse "5.0")
         [neg] (parser/parse "-5")
         [underscored] (parser/parse "5_000")]
-    
+
     (is (= 5 (int :value)))
     (is (calc/Int? int))
-    
+
     (is (= 5 (float :value)))
     (is (calc/Float? float))
-    
+
     (is (= -5 (neg :value)))
     (is (calc/Int? neg))
-    
+
     (is (= 5000 (underscored :value)))
     (is (calc/Int? underscored))))
 


@@ 41,7 41,7 @@
   (let [s (:new calc/Stack)
         parsed (parser/parse "4 5 +")]
     (calc/push-all s parsed)
-    
+
     (is (= 1 (length (s :data))))
     (def res (first (s :data)))
 


@@ 51,8 51,8 @@
 (deftest push-adverb
   (let [s (:new calc/Stack)
         parsed (parser/parse "0 [1 2 3] [+] /")]
-    (calc/push-all s parsed)    
-    
+    (calc/push-all s parsed)
+
     (is (= 1 (length (s :data))))
     (def res (first (s :data)))