9 files changed, 167 insertions(+), 106 deletions(-)

M main.janet
M src/adverbs.janet
M src/calc.janet
M src/parser.janet
M src/print.janet
M test-support.janet
M test/calc.janet
M test/parser.janet
M test/regressions.janet

@@ 2,37 2,42 @@
 (import /src/print)
 (import /src/parser)
 
-(defn display
+(defn handle-signal
+  [input]
+  (let [str (string input)]
+    (when (= str "") (os/exit 0))
+    str))
+
+(defn- display
   [data]
   (print (print/p data))
   "")
 
-(defn display-all
+(defn- display-all
   [stack]
   (let [inner (map print/p stack)]
     (print (string/join inner " ")))
   "")
 
-(defn display-help
+(defn- display-help
   []
   (each [k v] (pairs parser/dictionary)
     (printf "%s: %s" k (string (v :type))))
   "")
 
-(defn describe
-  [elem]
-  (printf "%s\n\n%s: %s"
-          (print/p elem)
-          (string (elem :type))
-          (elem :doc)))
-
-(defn describe-all
+(defn- describe-all
   [q]
+  (defn- describe
+    [elem]
+    (printf "%s\n\n%s: %s"
+            (print/p elem)
+            (string (elem :type))
+            (elem :doc)))
   (each item (q :data)
     (describe item))
   "")
 
-(defn handle-special
+(defn- handle-special
   [s special]
   (case (freeze (string/trim special))
     "." (display (calc/peek s))


@@ 43,32 48,33 @@
 
 (defn handle-commands
   [s input]
-  (when (= (string input) "") (os/exit 0))
-  
   (each token input
     (match token
       @[:special patt] (handle-special s patt)
       _ (calc/push s token))))
 
+(defn- prompt
+  [s]
+  (->> s
+       (calc/peek)
+       (print/p)
+       (string/format "(%s)> ")))
 
 (defn repl
   []
   (def s (:new calc/Stack))
   (while true
     (def bak (array/slice (s :data)))
-    (try (as-> s _
-               (calc/peek _)
-               (print/p _)
-               (string/format "(%s)> " _)
-               (getline _ @"" parser/dictionary)
-               (parser/parse _)
-               (handle-commands s _))
-         
-         ([err fib]
-          (eprint err)
-          (if (os/getenv "EC_TRACEBACK")
-            (propagate err fib)
-            (put s :data bak))))))
+    (try (->> (getline (prompt s) @"" parser/dictionary)
+              (handle-signal)
+              (parser/parse)
+              (handle-commands s))
+
+      ([err fib]
+        (eprint err)
+        (if (os/getenv "EC_TRACEBACK")
+          (propagate err fib)
+          (put s :data bak))))))
 
 (defn handle-line
   [line]

@@ 15,7 15,7 @@
   `1 1 [+] apply` is equivalent to `1 1 +`.
   ```
   (let [quotation (calc/pop stack)]
-    (if (calc/Quotation? quotation)
+    (if (calc/Quotation*? quotation)
       (do (calc/check-arity stack quotation)
         (each elem (calc/data quotation)
           (calc/push stack elem)))


@@ 28,23 28,23 @@
   `v`. If `v` is not a quotation, then `distribute` is equivalent to
   `apply`.
   ```
-  (let [quotation (calc/pop stack)
-        object (calc/pop stack)]
-
-    (unless (calc/Quotation? quotation)
-      (error "Distribute error: top argument must be a quotation"))
+  (let [q (calc/pop stack)
+        quotation (if (calc/Quotation*? q)
+                    q
+                    (calc/quote-wrap q))
+        v (calc/pop stack)]
 
     (defn push-verb []
       (calc/check-arity stack quotation)
       (each verb-elem (calc/data quotation)
         (calc/push stack verb-elem)))
 
-    (if (calc/Quotation? object)
-      (each elem (calc/data object)
+    (if (calc/Quotation*? v)
+      (each elem (calc/data v)
         (calc/push stack elem)
         (push-verb))
       (do
-        (calc/push stack object)
+        (calc/push stack v)
         (push-verb)))))
 
 (defadv wrap-stack 0


@@ 91,11 91,11 @@
   quotation.
   ```
   (let [elem (calc/pop stack)
-        quotation (calc/pop stack)
-        new-quotation (if (calc/Quotation? quotation)
-                        (calc/wrap ;(quotation :data) elem)
-                        (calc/wrap quotation elem))]
-    (calc/push stack new-quotation)))
+        vector (calc/pop stack)
+        new-vector (if (calc/Vector? vector)
+                     (calc/wrap ;(vector :data) elem)
+                     (calc/wrap vector elem))]
+    (calc/push stack new-vector)))
 
 (defadv slurp-left 2
   ```


@@ 106,12 106,12 @@
   If either element is a quotation, wraps the two top elements in a
   quotation.
   ```
-  (let [quotation (calc/pop stack)
+  (let [vector (calc/pop stack)
         elem (calc/pop stack)
-        new-quotation (if (calc/Quotation? quotation)
-                        (calc/wrap elem ;(quotation :data))
-                        (calc/wrap elem quotation))]
-    (calc/push stack new-quotation)))
+        new-vector (if (calc/Vector? vector)
+                     (calc/wrap elem ;(vector :data))
+                     (calc/wrap elem vector))]
+    (calc/push stack new-vector)))
 
 (defadv fill 2
   ```


@@ 135,7 135,17 @@
   Returns the number of stack elements that `a` would consume if it
   were pushed to the stack.
   ```
-  (let [elem (calc/pop stack)]
-    (let [arity (calc/get-arity elem)
-          new-elem (calc/make-element arity)]
-      (calc/push stack new-elem))))
+  (let [elem (calc/pop stack)
+        arity (calc/get-arity elem)
+        new-elem (calc/make-element arity)]
+    (calc/push stack new-elem)))
+
+(defadv shape 1
+  ```
+  v -- w
+  Returns the shape of the vector `v`.
+  ```
+  (let [v (calc/pop stack)
+        shape (calc/get-shape v)
+        new-elem (calc/wrap ;(map calc/make-element shape))]
+    (calc/push stack new-elem)))

@@ 28,13 28,19 @@
   out-arity {})
 
 (defproto Quotation Element
-  shape {:default [] :init? true}
   out-arity {:allocate-value 1}
   data {:init? true}
   type {:allocate-value :quotation})
 
-(defgeneric get-shape [_] [])
-(defmethod get-shape Quotation [self] (self :shape))
+(defproto Vector Quotation
+  shape {:default [] :init? true}
+  data {:init? true}
+  type {:allocate-value :vector})
+
+(defmethod get-shape Number [self] [])
+(defmethod get-shape Vector [self] (self :shape))
+(defmethod get-shape Quotation [_]
+  (error "Shape error: attempted vector operation on a quotation"))
 
 (defgeneric get-arity [_] 0)
 (defmethod get-arity Adverb [a] (a :arity))


@@ 50,16 56,16 @@
                         (((q :data) (dec i)) :out-arity))))))
   (max ;arities))
 
-(defgeneric fill
+(defmethod fill Number
   [element shape-to-fill]
   (if (empty? shape-to-fill)
     element
     (let [y (array ;shape-to-fill)
           yi (last y)
-          v (:new Quotation [yi] (array/new-filled yi element))]
+          v (:new Vector [yi] (array/new-filled yi element))]
       (fill v y))))
 
-(defmethod fill Quotation
+(defmethod fill Vector
   [self shape-to-fill]
   (let [x (array ;(shape self))
         y (array ;shape-to-fill)]


@@ 68,13 74,13 @@
       (let [xi (array/pop x)
             yi (array/pop y)]
         (unless (= xi yi)
-          (errorf "Shape error: can't fill quotation with shape %q to %q"
+          (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)]
-                (:new Quotation new-shape new-data)))
+                (:new Vector new-shape new-data)))
             self
             (reverse y))))
 


@@ 86,8 92,8 @@
 (defn- inner-apply
   [op & args]
   (let [x (first args)]
-    (if (Quotation? x)
-      (:new Quotation
+    (if (Vector? x)
+      (:new Vector
             (x :shape)
             (map (partial inner-apply op) ;(map |($ :data) args)))
       (let [f (op :fun-ref)


@@ 102,16 108,20 @@
         filled (map |(fill $ largest) args)]
     (inner-apply op ;filled)))
 
+(defn quote-wrap
+  [& data]
+  (:new Quotation data))
+
 (defn wrap
   [& data]
   (let [hd (first data)
-        inner-shape (get-shape hd)]
+        inner-shape (if hd (get-shape hd) ())]
     (each datum data
       (unless (deep= (get-shape datum) inner-shape)
-        (errorf "Quotation error: can't wrap heterogeneous data. Expected %j, got %j."
+        (errorf "Vector error: can't wrap heterogeneous data. Expected %j, got %j."
                 inner-shape
                 (get-shape datum))))
-    (:new Quotation (tuple (length data) ;inner-shape) data)))
+    (:new Vector (tuple (length data) ;inner-shape) data)))
 
 (defmethod pop Stack
   [self]


@@ 157,4 167,4 @@
 
 (defn shape?
   [obj]
-  (and (Quotation? obj) (all Number*? (obj :data))))
+  (and (Vector? obj) (all Number*? (obj :data))))

@@ 30,6 30,7 @@
                  "fill" adverbs/fill
                  "dup" adverbs/dup
                  "arity" adverbs/arity
+                 "shape" adverbs/shape
 
                  "sqr" compose/square})
 


@@ 39,6 40,10 @@
 
 (defn handle-brackets
   [& patt]
+  (calc/quote-wrap ;patt))
+
+(defn handle-vbrackets
+  [& patt]
   (calc/wrap ;patt))
 
 (defn handle-float


@@ 54,19 59,20 @@
 (defn handle-word
   [patt]
   (cond (index-of patt ["." "p" "s" "?" "??"])
-        [:special patt]
-        true
-        (or (dictionary patt)
-            (errorf "syntax error: unknown word %s" patt))))
+    [:special patt]
+    true
+    (or (dictionary patt)
+        (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+ :vbrackets :brackets :token))
+              :vbrackets (cmt (* ".[" :main "]") ,handle-vbrackets)
+              :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]

@@ 2,22 2,30 @@
 
 (import /src/calc)
 
-(defgeneric p
-  [val] (describe val))
-
-(defmethod p calc/Int
+(defmulti p [calc/Int]
   [n] (string (n :value)))
 
-(defmethod p calc/Float
+(defmulti p [calc/Float]
   [n] (string (n :value)))
 
-(defmethod p calc/Operation
+(defmulti p [calc/Operation]
   [o] (string (o :type)))
 
-(defmethod p calc/Adverb
+(defmulti p [calc/Adverb]
   [a] (string (a :type)))
 
-(defmethod p calc/Quotation
-  [v]
-  (let [inner (map p (v :data))]
-    (string "[" (string/join inner " ") "]")))
+(varfn join [q] nil)
+
+(defmulti p [calc/Quotation] [q] (join q "[" "]"))
+
+(defmulti p [calc/Vector] [v] (join v ".[" "]"))
+
+(varfn join
+  [q l r]
+  (let [inner (map p (q :data))]
+    (string l (string/join inner " ") r)))
+
+(defmulti p [:nil] [_] "")
+
+(defmulti p [_]
+  [val] (describe val))

@@ 12,16 12,23 @@
   [val obj]
   (is (== val (unwrap obj))))
 
+(defn- make-element
+  [x]
+  (if (number? x) (:new calc/Int x) x))
+
 (defn wrap
   [& args]
-  (calc/wrap ;(map |(if (number? $)
-                      (:new calc/Int $)
-                      $)
-                   args)))
+  (calc/wrap ;(map make-element args)))
+
+(defn quote-wrap
+  [& args]
+  (calc/quote-wrap ;(map make-element args)))
 
 (defn pop-and-compare
   [val s]
-  (is (= val (calc/value (calc/pop s)))))
+  (let [found (match (calc/pop s)
+                {:value value} value)]
+    (is (== val found))))
 
 (defn push-all
   [stack args]

@@ 6,7 6,7 @@
 (use testament)
 (use /test-support)
 
-(deftest quotations
+(deftest vectors
   (def v (wrap 1 2 3))
   (def v2 (wrap 2 5 10))
 


@@ 36,7 36,7 @@
         filled)
 
   (is (thrown? (calc/fill m [2 3 3]))
-      "Quotations can be filled into shapes that share a suffix")
+      "Vectors can be filled into shapes that share a suffix")
 
   (vec= @[@[@[2 4 6]
             @[8 10 12]]


@@ 51,7 51,7 @@
   # Operands
   (calc/push s (wrap 1 2 3))
   # Operator
-  (calc/push s (wrap o/add))
+  (calc/push s (quote-wrap o/add))
   (calc/push s a/distribute)
   (pop-and-compare 6 s))
 


@@ 59,12 59,21 @@
   (def s (:new calc/Stack))
   (calc/push s (:new calc/Int 0))
   (calc/push s (wrap 1 2 3))
-  (calc/push s (wrap 3 o/mul o/add))
+  (calc/push s (quote-wrap 3 o/mul o/add))
   (calc/push s a/distribute)
   (pop-and-compare 18 s))
 
 (deftest apply-quotation
   (def s (:new calc/Stack))
+  (calc/push s (quote-wrap 1 2 3))
+  (calc/push s a/apply-quotation)
+  (pop-and-compare 3 s)
+  (pop-and-compare 2 s)
+  (pop-and-compare 1 s)
+  (is (empty? (s :data))))
+
+(deftest apply-vector
+  (def s (:new calc/Stack))
   (calc/push s (wrap 1 2 3))
   (calc/push s a/apply-quotation)
   (pop-and-compare 3 s)


@@ 76,7 85,7 @@
   (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 (quote-wrap o/add))
   (calc/push s a/apply-quotation)
   (pop-and-compare 8 s)
   (is (empty? (s :data))))


@@ 110,23 119,23 @@
       "Wrapping a stack requires homogeneous data"))
 
 (deftest get-arity
-  (is (= 2 (calc/get-arity (wrap o/add)))
+  (is (= 2 (calc/get-arity (quote-wrap o/add)))
       "A quoted operation's arity is the operation's arity")
-  (is (= 3 (calc/get-arity (wrap o/add o/add)))
+  (is (= 3 (calc/get-arity (quote-wrap o/add o/add)))
       ```
       A composition of operations' arity is the greatest of the
       individual operations' arities, each adjusted for the out-arity
       of the one prior
       ```)
-  (is (= 2 (calc/get-arity (wrap o/add 2 o/add)))
+  (is (= 2 (calc/get-arity (quote-wrap o/add 2 o/add)))
       "Interposed numbers will reduce the arity of a quotation")
   (is (= 0 (calc/get-arity (:new calc/Int 2)))
       "A number's arity is 0")
-  (is (= 0 (calc/get-arity (wrap 2)))
+  (is (= 0 (calc/get-arity (quote-wrap 2)))
       "A quoted number's arity is 0")
-  (is (= 0 (calc/get-arity (wrap 2 2 2 2)))
+  (is (= 0 (calc/get-arity (quote-wrap 2 2 2 2)))
       "A quoted sequence of numbers is 0")
-  (is (= 0 (calc/get-arity (wrap 2 2 o/add)))
+  (is (= 0 (calc/get-arity (quote-wrap 2 2 o/add)))
       "A quoted operation is 0 if the quote enough values to fulfill it"))
 
 (run-tests!)

@@ 9,6 9,11 @@
 
 (deftest brackets
   (let [[parsed] (parser/parse "[]")]
+    (is (== nil (parsed :shape)))
+    (is (== [] (parsed :data)))))
+
+(deftest vector
+  (let [[parsed] (parser/parse ".[]")]
     (is (== [0] (parsed :shape)))
     (is (== [] (parsed :data)))))
 

@@ 10,7 10,7 @@
 (deftest regression1
   # [1] 1 + 1 +
   (def s (:new calc/Stack))
-  (let [in (parser/parse "[1] 1 + 1 +")]
+  (let [in (parser/parse ".[1] 1 + 1 +")]
     (calc/push s (in 0))
     (vec= [1] (calc/peek s))
     (calc/push s (in 1))


@@ 27,7 27,7 @@
 (deftest regression2
   # [4 5] 6 +  8 +
   (def s (:new calc/Stack))
-  (let [in (parser/parse "[4 5] 6 + 8 +")]
+  (let [in (parser/parse ".[4 5] 6 + 8 +")]
     (push-all s in))
 
   (def res (calc/pop s))


@@ 36,7 36,7 @@
 (deftest regression3
   # [2 3 4] 1 -
   (def s (:new calc/Stack))
-  (let [in (parser/parse "[2 3 4] 1 -")]
+  (let [in (parser/parse ".[2 3 4] 1 -")]
     (push-all s in))
 
   (def res (calc/pop s))


@@ 46,7 46,7 @@
   # ([[1] [2] [3]])> !
   #could not find method :- for 0, or :r- for nil
   (def s (:new calc/Stack))
-  (let [in (parser/parse "[[1][2]] !")]
+  (let [in (parser/parse ".[.[1].[2]] !")]
     (push-all s in))
   (while ((complement empty?) (s :data))
     (def inner-q (calc/pop s))