janet/recursive.janet

@@ -701,7 +701,6 @@
    (print "parsed guard")
    (expect parser :arrow) (advance parser)
    (print "parsed arrow")
-   (accept-many parser :newline)
    (def rhs (nonbinding parser))
    (print "parsed rhs")
    [[lhs guard rhs]]
@@ -719,7 +718,6 @@
     (advance parser)
     (simple parser)))
    (expect parser :arrow) (advance parser)
-   (accept-many parser :newline)
    (def rhs (nonbinding parser))
    (terminator parser)
    [lhs guard rhs])
@@ -747,7 +745,7 @@
 (defn- lambda [parser]
  (def origin (current parser))
  (expect parser :fn) (advance parser)
- @{:type :fn :data (fn-simple parser) :token origin})
+ {:type :fn :data (fn-simple parser) :token origin})
 
 (defn- fnn [parser]
  (if (= :lparen (-> parser peek type)) (break (lambda parser)))
@@ -766,7 +764,7 @@
     :lbrace (fn-clauses parser)
     :lparen (fn-simple parser)
     (panic parser (string "expected clause or clauses, got " (-> current parser type)))))
-   @{:type :fn :name name :data data :token origin})
+   {:type :fn :name name :data data :token origin})
   ([err] err)))
 
 ### compoound forms
@@ -848,15 +846,10 @@
       (def key (capture kw parser))
       (def value (capture simple parser))
       (array/push data {:type :pair :data [key value] :token origin}))
-     :word (do
-      (def value (word-only parser))
-      (def key (keyword (value :data)))
-      (def kw-ast {:type :keyword :data key :token origin})
-      (array/push data {:type :pair :data [key value] :token origin})) 
-     (panic parser "expected pkg term"))
+     :word (array/push (capture word-only parser))
+     (panic parser "expected dict term"))
     (terminator parser))
-   (advance parser)
-   @{:type :pkg :data data :token origin :name name})
+   {:type :pkg :data data :token origin :name name})
   ([err] err)))
 
 (defn- ns [parser]
@@ -866,7 +859,7 @@
    (expect parser :ns) (advance parser)
    (def name (-> parser pkg-name (get :data)))
    (def body (block parser))
-   @{:type :ns :data body :name name :token origin})
+   {:type :ns :data body :name name :token origin})
   ([err] err)))
 
 (defn- importt [parser]
@@ -897,7 +890,7 @@
   :lparen (fn-simple parser)
   :lbrace (fn-clauses parser)
  ))
- @{:type :loop :data [args clauses] :token origin})
+ {:type :loop :data [args clauses] :token origin})
 
 (defn- recur [parser]
  (def origin (current parser))
@@ -1093,15 +1086,14 @@
 (do
 #(comment
 (def source `
-loop (1, 2) with (x, y) -> :bar
+"foo {bar} baz"
 `)
 (def scanned (s/scan source))
 (print "\n***NEW PARSE***\n")
 (def a-parser (new-parser scanned))
-(def parsed (toplevel a-parser))
+(def parsed (script a-parser))
 
 # (print (pp-ast parsed))
-(pp scanned)
 (pp parsed)
 )
 

janet/scanner.janet

@@ -14,7 +14,6 @@
    "nil" :nil ## impl -> literal word
    "ns" :ns ## impl
    "panic!" :panic ## impl (should _not_ be a function)
-   "pkg" :pkg
    "recur" :recur ## impl
    "ref" :ref ## impl
    "then" :then ## impl
@@ -296,9 +295,8 @@
       "&" (add-comment char scanner)
 
       ## keywords
-      # XXX: make sure we want only lower-only keywords
       ":" (cond
-           (lower? next) (add-keyword scanner)
+           (alpha? next) (add-keyword scanner)
            :else (add-error scanner (string "Expected keyword. Got " char next)))
 
       ## splats

janet/validate.janet

@@ -7,12 +7,12 @@ Tracking here, before I start writing this code, the kinds of validation we're h
 * [x] splats come at the end of list, tuple, and dict patterns
 * [x] no unbound names
 * [x] no re-bound names
-* [x] no unbound names with `use` forms
+* [ ] no unbound names with `use` forms
 * [ ] first-level property access with pkg, e.g. `Foo :bar`--bar must be on Foo
-* [x] recur in tail position in `loop` forms
-* [x] recur not called outside of `loop` forms
-* [x] `loop` form arity checking
-* [x] arity checking of explicit named function calls
+* [ ] recur in tail position in `loop` forms
+* [ ] recur not called outside of `loop` forms
+* [ ] `loop` form arity checking
+* [ ] arity checking of explicit named function calls
 * [ ] flag tail calls
 
 Imports are for a later iteration of Ludus:
@@ -35,9 +35,9 @@ Imports are for a later iteration of Ludus:
 
 (var validate nil)
 
-(def terminals [:number :keyword :string :bool :nil :placeholder])
+(def terminals [:number :keyword :string :bool :nil])
 
-(def simple-colls [:list :tuple :set :args])
+(def simple-colls [:list :tuple :set])
 
 (defn- simple-coll [validator]
  (def ast (validator :ast))
@@ -70,17 +70,12 @@ Imports are for a later iteration of Ludus:
  (def data (ast :data))
  (def status (validator :status))
  (set (status :toplevel) nil)
- (def tail? (status :tail))
- (set (status :tail) false)
  (def parent (validator :ctx))
  (def ctx @{:^parent parent})
  (set (validator :ctx) ctx)
- (for i 0 (-> data length dec)
-  (set (validator :ast) (data i))
+ (each node data
+  (set (validator :ast) node)
   (validate validator))
- (set (status :tail) tail?)
- (set (validator :ast) (last data))
- (validate validator)
  (set (validator :ctx) parent)
  validator)
 
@@ -105,12 +100,15 @@ Imports are for a later iteration of Ludus:
 
 (defn- lett [validator]
  (def ast (validator :ast))
- (def [lhs rhs] (ast :data))
+ (def data (ast :data))
+ (def status (validator :status))
+ (def pattern (first data))
+ (def expr (get data 1))
  # evaluate the expression first
  # otherwise lhs names will appear bound
- (set (validator :ast) rhs)
+ (set (validator :ast) expr)
  (validate validator)
- (set (validator :ast) lhs)
+ (set (validator :ast) pattern)
  (pattern validator)
  validator)
 
@@ -153,14 +151,13 @@ Imports are for a later iteration of Ludus:
    {:node ast :msg (string "name is already bound on line "
     line " of " input)}))
  (set (ctx name) ast)
- (pp ctx)
  validator)
 
 (def types [
  :nil
- :bool
  :number
  :keyword
+ :bool
  :string
  :set
  :tuple
@@ -169,20 +166,11 @@ Imports are for a later iteration of Ludus:
  :fn
  :ref
  :pkg
+ :ns
+ :
 ])
 
-(defn typed [validator]
- (def ast (validator :ast))
- (def [kw-type word] (ast :data))
- (def type (kw-type :data))
- (when (not (has-value? types type))
-  (array/push (validator :errors)
-   {:node kw-type :msg "unknown type"}))
- (set (validator :ast) word)
- (pattern word))
-
 (defn- pattern* [validator]
- (print "PATTERN*")
  (def ast (validator :ast))
  (def type (ast :type))
  (print "validating pattern " type)
@@ -195,15 +183,7 @@ Imports are for a later iteration of Ludus:
    :word (word-pattern validator)
    :list (simple-coll-pattern validator)
    :tuple (simple-coll-pattern validator)
-   :splat (splattern validator)
-   :typed (typed validator)
-   )))
-
-(set pattern pattern*)
-
-# XXX: ensure guard includes only allowable names
-# XXX: what to include here? (cf Elixir)
-(defn- guard [validator])
+   :splat (splattern validator))))
 
 (defn- match-clauses [validator clauses]
  (each clause clauses
@@ -230,10 +210,6 @@ Imports are for a later iteration of Ludus:
 (defn- fnn [validator]
  (def ast (validator :ast))
  (def name (ast :name))
- (print "function name: " name)
- (def status (validator :status))
- (def tail? (status :tail))
- (set (status :tail) true)
  (when name 
   (def ctx (validator :ctx))
   (def resolved (resolve-name ctx name))
@@ -243,23 +219,6 @@ Imports are for a later iteration of Ludus:
     {:node ast :msg (string "name is already bound on line " line " of " input)}))
   (set (ctx name) ast))
  (match-clauses validator (ast :data))
- (set (status :tail) tail?)
- (def clauses (ast :data))
- (def rest-arities @{})
- (def arities @{:rest rest-arities})
-  (each clause clauses
-  (print "CLAUSE:")
-  (pp clause)
-  (def patt (first clause))
-  (def params (patt :data))
-  (def arity (length params))
-  (print "checking clause with arity " arity)
-  (def rest-param? (and (> arity 0) (= :splat ((last params) :type))))
-  (if rest-param?
-   (set (rest-arities arity) true)
-   (set (arities arity) true)))
- (pp arities)
- (set (ast :arities) arities)
  validator)
 
 (defn- ref [validator]
@@ -286,260 +245,40 @@ Imports are for a later iteration of Ludus:
    (validate validator))))
 
 ### TODO:
-# * [ ] ensure properties are on pkgs (if *only* pkgs from root)
-(defn- pkg-root [validator])
-
-# * [ ] flag tail calls (where last term is not-partial args)
-(defn- tail-call [validator])
-
 # * [ ] arity checking if first term is name that resolves to a function and args aren't partial
-# XXX: now just check number of args against arity map
-(defn- check-arity [validator]
- (def ast (validator :ast))
- (when (ast :partial) (break validator))
- (def ctx (validator :ctx))
- (def data (ast :data))
- (def fn-word (first data))
- (def the-fn (resolve-name ctx (fn-word :data)))
- (print "fn name: " (the-fn :name))
- (def arities (the-fn :arities))
- (print "arities: ")
- (pp arities)
- (def args (get data 1))
- (def num-args (length (args :data)))
- (print "called with #args " num-args)
- (when (has-key? arities num-args) (break validator))
- (def rest-arities (keys (arities :rest)))
- (when (empty? rest-arities)
-  (array/push (validator :errors)
-   {:node ast :msg "mismatched arity"})
-  (break validator))
- (def rest-min (min ;rest-arities))
- (when (< num-args rest-min)
-  (array/push (validator :errors)
-   {:node ast :msg "mismatched arity"}))
- validator)
-
+# * [ ] ensure properties are on pkgs (if *only* pkgs from root)
+# * [ ] flag tail calls (where last term is not-partial args)
 (defn- synthetic [validator]
  (def ast (validator :ast))
  (def data (ast :data))
  (each node data
   (set (validator :ast) node)
-  (validate validator))
- (set (validator :ast) ast)
- (def ftype ((first data) :type))
- (def stype ((get data 1) :type))
- (def ltype ((last data) :type))
- (print "ftype " ftype)
- (print "stype " stype)
- (print "ltype " ltype)
- (when (= ftype :pkg-name) (pkg-root validator))
- (when (= ltype :args) (tail-call validator)) 
- (when (and (= ftype :word) (= stype :args))
-  (check-arity validator))
- validator)
+  (validate validator)))
 
 ### XXX: todos from parser
-(defn- pair [validator]
- (def ast (validator :ast))
- (def [k v] (ast :data))
- (set (validator :ast) k)
- (validate validator)
- (set (validator :ast) v)
- (validate validator))
+(defn- dict [validator])
 
-(defn- splat [validator]
- (def ast (validator :ast))
- (when (get-in validator [:status :pkg])
-  (array/push (validator :errors)
-   {:node ast :msg "splats are not allowed in pkgs"})
-  (break validator))
- (def data (ast :data))
- (when data
-  (set (validator :ast) data)
-  (validate validator))
- validator)
-
-(defn- dict [validator]
- (def ast (validator :ast))
- (def data (ast :data))
- (each node data
-  (set (validator :ast) node)
-  (validate validator))
- validator)
-
-(defn- whenn [validator]
- (def ast (validator :ast))
- (def data (ast :data))
- (each node data
-  (def [lhs rhs] node)
-  (set (validator :ast) lhs)
-  (validate validator)
-  (set (validator :ast) rhs)
-  (validate validator))
- validator)
+(defn- whenn [validator])
 
 (defn- withh [validator])
 
-# XXX: tail calls in last position
-(defn- doo [validator]
- (def ast (validator :ast))
- (def data (ast :data))
- (each node data
-  (set (validator :ast) node)
-  (validate validator))
- validator)
+(defn- doo [validator])
 
-(defn- usee [validator]
- (def ast (validator :ast))
- (def data (ast :data))
- (set (validator :ast) data)
- (validate validator)
- (def name (data :data))
- (def ctx (validator :ctx))
- (def pkg (get-in ctx [name :pkg] @{}))
- (loop [[k v] :pairs pkg]
-  (set (ctx (string k)) v))
- validator)
+(defn- usee [validator])
 
-(defn- pkg-entry [validator pkg]
- (def ast (validator :ast))
- (def [key value] (ast :data))
- (print "PKG ENTRY***")
- (pp key)
- (pp value)
- (set (validator :ast) key)
- (validate validator)
- (set (validator :ast) value)
- (validate validator)
- (def kw (key :data))
- (pp kw)
- (set (pkg kw) value)
- (pp pkg)
- validator)
+(defn- pkg [validator])
 
-(defn- pkg [validator]
- (def ast (validator :ast))
- (def data (ast :data))
- (def name (ast :name))
- (def pkg @{})
- (each node data
-  (set (validator :ast) node)
-  (pkg-entry validator pkg))
- (set (ast :pkg) pkg)
- (print "THE PACKAGE")
- (pp pkg)
- (def ctx (validator :ctx))
- (set (ctx name) ast)
- validator)
+(defn- ns [validator])
 
-(defn- ns [validator]
- (def ast (validator :ast))
- (def data (ast :data))
- (def name (ast :name))
- (def parent (validator :ctx))
- (def ctx @{:^parent parent})
- (def block (data :data))
- (each node block
-  (set (validator :ast) node)
-  (validate validator))
- (set (ast :pkg) ctx)
- (set (parent name) ast)
- validator)
+(defn- loop [validator])
 
-(defn- loopp [validator]
- (def ast (validator :ast))
- (def status (validator :status))
- (def data (ast :data))
- (def input (first data))
- (print "LOOP INPUT")
- (pp input)
- (def clauses (get data 1))
- (def input-arity (length (input :data)))
- (set (ast :arity) input-arity)
- (print "input arity to loop " input-arity)
- (set (validator :ast) input)
- (validate validator)
- # harmonize arities
- (def rest-arities @{})
- (each clause clauses
-  (print "CLAUSE:")
-  (pp clause)
-  (def patt (first clause))
-  (def params (patt :data))
-  (def clause-arity (length params))
-  (print "checking clause with arity " clause-arity)
-  (def rest-param? (= :splat (get (last params) :type)))
-  (when (and 
-   (not rest-param?) (not= clause-arity input-arity))
-    (array/push (validator :errors)
-     {:node patt :msg "arity mismatch"}))
-  (when rest-param?
-    (set (rest-arities clause-arity) patt)))
-  (pp rest-arities)
-  (loop [[arity patt] :pairs rest-arities]
-   (when (< input-arity arity)
-    (array/push (validator :errors)
-     {:node patt :msg "arity mismatch"})))
- (def loop? (status :loop))
- (set (status :loop) input-arity)
- (def tail? (status :tail))
- (set (status :tail) true)
- (match-clauses validator clauses)
- (set (status :loop) loop?)
- (set (status :tail) tail?)
- validator)
+(defn- recur [validator])
 
-(defn- recur [validator]
- (def ast (validator :ast))
- (def status (validator :status))
- (def loop-arity (status :loop))
- (when (not loop-arity)
-  (array/push (validator :errors)
-   {:node ast :msg "recur may only be used inside a loop"})
-  (break validator))
- (def called-with (get-in ast [:data :data]))
- (def recur-arity (length called-with))
- (print "loop arity " loop-arity)
- (print "recur arity" recur-arity)
- (when (not= recur-arity loop-arity)
-  (array/push (validator :errors)
-   {:node ast :msg "recur must have the same number of args as its loop"}))
- (when (not (status :tail))
-  (array/push (validator :errors)
-   {:node ast :msg "recur must be in tail position"}))
- (set (validator :ast) (ast :data))
- (validate validator))
+(defn- repeat [validator])
 
-(defn- repeatt [validator]
- (def ast (validator :ast))
- (def [times body] (ast :data))
- (set (validator :ast) times)
- (validate validator)
- (set (validator :ast) body)
- (validate validator))
+(defn- panic [validator])
 
-(defn- panic [validator]
- (def ast (validator :ast))
- (def data (ast :data))
- (set (validator :ast) data)
- (validate validator))
-
-(defn- testt [validator]
- (def ast (validator :ast))
- (def [_ body] (ast :data))
- (set (validator :ast) body)
- (validate validator))
-
-(defn- pkg-name [validator]
- (def ast (validator :ast))
- (def name (ast :data))
- (def ctx (validator :ctx))
- (def pkg (resolve-name ctx name))
- (when (not pkg)
-  (array/push (validator :errors)
-   {:node ast :msg "unbound name"}))
- validator)
+(defn- testt [validator])
 
 (defn- validate* [validator]
  (def ast (validator :ast))
@@ -558,37 +297,19 @@ Imports are for a later iteration of Ludus:
    :match (matchh validator)
    :interpolated (interpolated validator)
    :synthetic (synthetic validator)
-   :do (doo validator)
-   :dict (dict validator)
-   :test (testt validator)
-   :panic (panic validator)
-   :repeat (repeatt validator)
-   :when (whenn validator)
-   :splat (splat validator)
-   :pair (pair validator)
-   :ns (ns validator)
-   :pkg (pkg validator)
-   :pkg-name (pkg-name validator)
-   :use (usee validator)
-   :loop (loopp validator)
-   :recur (recur validator)
    (error (string "unknown node type " type)))))
 
 (set validate validate*)
+(set pattern pattern*)
 
 (do
 #(comment
 (def source `
-fn foo {
- () -> :bar
- (x) -> :foo
- (x, y, ...z) -> :baz
-}
-foo (4)
+"foo {bar} baz"
 `)
 (def scanned (s/scan source))
 (def parsed (p/parse scanned))
 (def validator (new-validator parsed))
 (pp validator)
-((validate validator) :errors)
+(validate validator)
 )