add a pretty-printer (that sometimes causes errors!), lots of bugs but functions for all the things

janet/recursive.janet

@@ -296,9 +296,20 @@
  (advance parser)
  ast)
 
+(defn- synth-root [parser]
+ (def origin (current parser))
+ (advance parser)
+ (case (type origin)
+  :word {:type :word :data (origin :lexeme) :token origin}
+  :keyword {:type :keyword :data (origin :literal) :token origin}
+  :pkg-name {:type :pkg-name :data (origin :lexem) :token origin}
+  (panic parser "expected word, keyword, or package")
+ )
+)
+
 (defrec synthetic [parser]
  (def origin (current parser))
- (def ast {:type :synthetic :data @[origin] :token origin})
+ (def ast {:type :synthetic :data @[(synth-root origin)] :token origin})
  (advance parser)
  (while (has-value? sequels (-> parser current type))
   (def term 
@@ -367,7 +378,7 @@
   (def term (if (check parser :splat)
    (do
     (advance parser)
-    (def splatted (try (word parser) ([e] e)))
+    (def splatted (capture word parser))
     {:type :splat :data splatted :token origin}
    )
    (try (nonbinding parser) ([e] e))))
@@ -415,7 +426,13 @@
  (expect parser :word)
  (def origin (current parser))
  (advance parser)
- {:type :word :data (origin :lexeme) :token origin})
+ (def the-word {:type :word :data (origin :lexeme) :token origin})
+ (if (check parser :as)
+  (do
+   (advance parser)
+   (def type (kw parser))
+   {:type :typed :data [type the-word] :token origin})
+  the-word))
 
 (defn- tup-pattern [parser]
  (def origin (current parser))
@@ -585,12 +602,15 @@
   (do 
    (def ast {:type :clause :data @[] :origin (current parser)})
    (def lhs (pattern parser))
+   (def guard (when (check parser :if)
+     (advance parser)
+     (simple parser)))
    (expect parser :arrow)
    (advance parser)
    (accept-many parser :newline)
    (def rhs (nonbinding parser))
    (terminator parser)
-   [lhs rhs])
+   [lhs guard rhs])
   ([err]
    (accept-many parser ;terminators)
    err)))
@@ -618,10 +638,13 @@
  (try
   (do
    (def lhs (pattern parser))
+   (def guard (when (check parser :if)
+    (advance parser)
+    (simple parser)))
    (expect parser :equals) (advance parser)
    (def rhs (nonbinding parser))
    (terminator parser)
-   [lhs rhs]
+   [lhs guard rhs]
   )
   ([err] 
    (accept-many parser ;terminators)
@@ -662,10 +685,13 @@
 (defn- fn-simple [parser]
  (try
   (do
-   (def lhs (tuple-pattern parser))
+   (def lhs (tup-pattern parser))
+   (def guard (when (check parser :if)
+    (advance parser)
+    (simple parser)))
    (expect parser :arrow) (advance parser)
    (def rhs (nonbinding parser))
-   [[lhs rhs]]
+   [[lhs guard rhs]]
   )
   ([err] err)
  )
@@ -675,11 +701,14 @@
  (def origin (current parser))
  (try
   (do
-   (def lhs (tuple-pattern parser))
+   (def lhs (tup-pattern parser))
+   (def guard (when (check parser :if)
+    (advance parser)
+    (simple parser)))
    (expect parser :arrow) (advance parser)
    (def rhs (nonbinding parser))
    (terminator parser)
-   [lhs rhs])
+   [lhs guard rhs])
   ([err]
    (advance parser)
    (accept-many parser ;terminators)
@@ -705,7 +734,7 @@
    (def origin (current parser))
    (expect parser :fn) (advance parser)
    (def name (word parser))
-   (def data (case (-> parser peek type)
+   (def data (case (-> parser current type)
     :lbrace (fn-clauses parser)
     :lparen (fn-simple parser)
     (panic parser (string "expected clause or clauses, got " (-> current parser type)))))
@@ -761,6 +790,7 @@
 (defn- pkg-name [parser]
  (expect parser :pkg-name)
  (def origin (current parser))
+ (if (= :keyword (-> parser peek type)) (break (synthetic parser)))
  (advance parser)
  {:type :pkg-name :data (origin :lexeme) :token origin})
 
@@ -776,9 +806,9 @@
  (try
   (do
    (def origin (current parser))
-   (expect :pkg) (advance parser)
+   (expect parser :pkg) (advance parser)
    (def name (pkg-name parser))
-   (expect :lbrace) (advance parser)
+   (expect parser :lbrace) (advance parser)
    (accept-many parser ;terminators)
    (def data @[])
    (while (not (check parser :rbrace))
@@ -802,7 +832,7 @@
  (try 
   (do  
    (def origin (current parser))
-   (expect :ns) (advance parser)
+   (expect parser :ns) (advance parser)
    (def name (pkg-name parser))
    (def body (block parser))
    {:type :ns :data body :name name :token origin})
@@ -824,6 +854,34 @@
  (def body (nonbinding parser))
  {:type :test :data [desc body] :token origin})
 
+### loops and repeates
+(defn- loopp [parser]
+ (def origin (current parser))
+ (expect parser :loop) (advance parser)
+ (def args (tup parser))
+ (expect parser :with) (advance parser)
+ (def clauses (case (-> parser current type)
+  :lparen (fn-simple parser)
+  :lbrace (fn-clauses parser)
+ ))
+ {:type :loop :data [args clauses] :token origin})
+
+(defn- recur [parser]
+ (def origin (current parser))
+ (expect parser :recur) (advance parser)
+ (def args (tup parser))
+ {:type :recur :data args :token origin})
+
+(defn- repeatt [parser]
+ (def origin (current parser))
+ (def times (case (-> parser current type)
+  :number (num parser)
+  :word (word parser)
+  (panic parser "expected number or word")
+ ))
+ (def body (block parser))
+ {:type :repeat :data [times body] :token origin})
+
 ### expressions
 # four levels of expression complexity:
 # simple (atoms, collections, synthetic expressions; no conditionals or binding or blocks)
@@ -847,6 +905,8 @@
   :startdict (dict parser)
   :startset (sett parser)
   :word (word parser)
+  :pkg-name (pkg-name parser)
+  :recur (recur parser)
   (panic parser (string expect "expected simple expression, got " (type curr)))
  )
 )
@@ -877,6 +937,8 @@
 
   # synthetic
   :word (word parser)
+  :pkg-name (pkg-name parser)
+  :recur (recur parser)
 
   # conditional forms
   :if (iff parser)
@@ -917,6 +979,8 @@
   :startdict (dict parser)
   :startset (sett parser)
   :word (word parser)
+  :pkg-name (pkg-name parser)
+  :recur (recur parser)
   :if (iff parser)
   :when (whenn parser)
   :match (matchh parser)
@@ -942,7 +1006,7 @@
  )
 )
 
-(def script [parser]
+(defn- script [parser]
  (def origin (current parser))
  (def lines @[])
  (while (not (check parser :eof))
@@ -950,21 +1014,39 @@
   (capture terminator parser))
  {:type :script :data lines :token origin})
 
+(defn- indent-by [n]
+ (def indentation @"")
+ (repeat n (buffer/push indentation ".."))
+ indentation)
+
+(defn- pp-ast [ast &opt indent]
+ (default indent 0)
+ (def {:type t :name n :data d :msg m} ast)
+ (string (indent-by indent) t ": " n m
+  (if (indexed? d)
+   (string "\n" (string/join (map (fn [a] (pp-ast a (inc indent))) d)))  
+   d
+  )
+  "\n"
+ )
+)
+
+
 (do
 #(comment
-(def source `match foo with {
- 1 -> 2 4
- _ -> :foo
-}
+(def source `
+fn foo (x) -> :foo
 `)
 (def scanned (s/scan source))
 (def a-parser (new-parser scanned))
-(def parsed (try (matchh a-parser) ([e] e)))
+(def parsed (script a-parser))
+(print "\n***NEW PARSE***\n")
+(print (pp-ast parsed))
 )
 
 
 # FIXME:
 # TODO:
-# - if guards on patterns
 # DECIDE:
 # - when to use a flat try/catch format, and when to use capture/expect-ret to get values instead of errors
+

janet/validate.janet

@@ -11,5 +11,7 @@ Tracking here, before I start writing this code, the kinds of validation we're h
 * no unbound names with `use` forms
 * no circular imports
 * first-level property access with pkg, e.g. `Foo :bar`--bar must be on Foo
+* recur in tail position in `loop` forms
+* recur not called outside of `loop` forms
 
 )