janet/interpreter.janet

@@ -13,9 +13,6 @@
     :table :dict
     the-type))
 
-(defn- bool [value]
-  (if (= value :^nil nil) value))
-
 (defn- resolve-name [name ctx]
   (print "resolving " name " in:")
   (pp ctx)
@@ -75,45 +72,6 @@
     {:success true :ctx ctx}
     {:success false :miss [pattern value]}))
 
-
-(defn- match-list [pattern value ctx]
-  (when (not (array? value))
-    (break {:success false :miss [pattern value]}))
-  (def val-len (length value))
-  (var members (pattern :data))
-  (def patt-len (length members))
-  (var splat nil)
-  (def splat? (= :splat ((last members) :type)))
-  (when splat?
-    (when (< val-len patt-len)
-      (print "mismatched splatted tuple lenghts")
-      (break {:success false :miss [pattern value]}))
-    (print "splat!")
-    (set splat (last members))
-    (set members (slice members 0 (dec patt-len))))
-  (when (and (not splat?) (not= val-len patt-len))
-    (print "mismatched tuple lengths")
-    (break {:success false :miss [pattern value]}))
-  (var curr-mem :^nothing)
-  (var curr-val :^nothing)
-  (var success true)
-  (for i 0 (length members)
-    (set curr-mem (get members i))
-    (set curr-val (get value i))
-    (print "in tuple, matching " curr-val " with ")
-    (pp curr-mem)
-    (def match? (match-pattern curr-mem curr-val ctx))
-    (pp match?)
-    (when (not (match? :success))
-      (set success false)
-      (break)))
-  (when (and splat? (splat :data))
-    (def rest (array/slice value (length members)))
-    (match-word (splat :data) rest ctx))
-  (if success
-    {:success true :ctx ctx}
-    {:success false :miss [pattern value]}))
-
 (defn- match-pattern* [pattern value &opt ctx]
   (print "in match-pattern, matching " value " with:")
   (pp pattern)
@@ -134,9 +92,8 @@
 
     # TODO: lists, dicts
     :tuple (match-tuple pattern value ctx)
-    :list (match-list pattern value ctx)
     # TODO: string-patterns
-
+    # TODO: typed
     :typed (typed pattern value ctx)
   ))
 
@@ -156,26 +113,6 @@
     (error {:node ast 
       :msg (string "could not match " (stringify value))})))
 
-(defn- matchh [ast ctx]
-  (def [to-match clauses] (ast :data))
-  (def value (interpret to-match ctx))
-  (var result :^nothing)
-  (each clause clauses
-    (def [patt guard expr] clause)
-    (print "matching ")
-    (pp patt)
-    (def match? (match-pattern patt value))
-    (when (match? :success)
-      (def inner-ctx (match? :ctx))
-      (def guard? (if (bool guard)
-        (interpret guard inner-ctx) true))
-      (when guard?
-        (set result (interpret expr inner-ctx))
-        (break))))
-  (if (= result :^nothing)
-    (error {:node ast :value value :msg "no match"})
-    result))
-
 (defn- script [ast ctx]
   (def lines (ast :data))
   (var result nil)
@@ -191,6 +128,7 @@
     (set result (interpret line ctx)))
   result)
 
+
 (defn- dict-str [dict]
   (string/join 
     (map 
@@ -216,7 +154,7 @@
     :set
       (string/join (map stringify (keys value)) ", ")
     :ref (stringify (value :^value))
-    # XXX: pkg, fn 
+    # XXX: pkg, fn, 
   ))
 
 (set stringify stringify*)
@@ -229,10 +167,9 @@
       terms))
   (string/join interpolations))
 
-
 (defn- iff [ast ctx]
   (def [condition then else] (ast :data))
-  (if (bool (interpret condition ctx))
+  (if (interpret condition ctx)
     (interpret then ctx)
     (interpret else ctx)))
 
@@ -241,7 +178,7 @@
   (var result :^nothing)
   (each clause clauses
     (def [lhs rhs] clause)
-    (when (bool (interpret lhs ctx))
+    (when (interpret lhs ctx)
       (set result (interpret rhs ctx))
       (break)))
   (when (= result :^nothing)
@@ -320,7 +257,7 @@
   (print "interpreting node " (ast :type))
   (case (ast :type)
     # literals
-    :nil :^nil
+    :nil nil
     :number (ast :data)
     :bool (ast :data)
     :string (ast :data)
@@ -343,19 +280,9 @@
     :word (word ast ctx)
     :interpolated (interpolated ast ctx)
     :ref (ref ast ctx)
-    # :ns (ns ast ctx)
-    # :pkg (pkg ast ctx)
 
     # patterned forms
     :let (lett ast ctx)
-    :match (matchh ast ctx)
-    # :with (withh ast ctx)
-
-    # functions
-    # :fn (fnn ast ctx)
-
-    # synthetic
-    # :synthetic (synthetic ast ctx)
 
     ))
 
@@ -369,15 +296,10 @@
 
 (var source nil)
 
-(defn- has-errors? [{:errors errors}] (and errors (not (empty? errors))))
-
 (defn run []
   (def scanned (s/scan source))
-  (when (has-errors? scanned) (break (scanned :errors)))
   (def parsed (p/parse scanned))
-  (when (has-errors? parsed) (break (parsed :errors)))
   (def validated (v/valid parsed))
-  (when (has-errors? validated) (break (validated :errors)))
   # (interpret (parsed :ast) @{})
   (try (interpret (parsed :ast) @{})
     ([e] (print "Ludus panicked!: " 
@@ -386,10 +308,7 @@
 
 (do 
 (set source `
-match "foo" with {
+
-  "f{ooo}o" -> ooo
-  _ -> :nope
-}
 `)
 (run)
 )

janet/parser.janet

@@ -228,7 +228,7 @@
    (array/push data curr)
    (def interpolated (map scan-interpolations data))
    (advance parser)
-   (def ast @{:type :interpolated :data interpolated :token origin})
+   (def ast {:type :interpolated :data interpolated :token origin})
    (if (some is-error? interpolated) 
     (do 
      (def err {:type :error :msg "bad interpolated string" :data ast :token origin})
@@ -620,23 +620,19 @@
 (defn- matchh [parser]
  (def origin (current parser))
  (def ast {:type :match :data @[] :token origin})
- (var to-match nil)
- (def clauses @[])
  (expect parser :match)
  (advance parser)
  (try
   (do
-   (set to-match (simple parser))
+   (simple parser)
    (expect parser :with) (advance parser)
-   (def open-brace (current parser))
    (expect parser :lbrace) (advance parser)
    (accept-many parser :newline)
    (while (not (check parser :rbrace))
-    (when (check parser :eof) 
+    (when (check parser :eof) (error {:type :error :token origin :data ast :msg "unclosed brace"}))
-     (error {:type :error :token open-brace :msg "unclosed brace"}))
+    (array/push (ast :data) (match-clause parser)))
-    (array/push clauses (match-clause parser)))
    (advance parser)
-   {:type :match :data [to-match clauses] :token origin})
+   ast)
   ([err] err)))
 
 # {pattern} = {nonbinding} {terminators}
@@ -1094,15 +1090,15 @@
 )
 
 
-(do
+# (do
-# (comment
+(comment
 (def source `
-"{bar}{quux}"
+loop (1, 2) with (x, y) -> :bar
 `)
 (def scanned (s/scan source))
 (print "\n***NEW PARSE***\n")
 (def a-parser (new-parser scanned))
-(def parsed (interpolated a-parser))
+(def parsed (toplevel a-parser))
 
 # (print (pp-ast parsed))
 (pp scanned)

janet/scanner.janet

@@ -327,7 +327,7 @@
     (if (at-end? scanner)
       (let [scanner (add-token (add-token scanner :break) :eof)]
         {:tokens (get scanner :tokens)
-         :errors (get scanner :errors [])})
+         :errors (get scanner :errors)})
       (recur (-> scanner (scan-token) (next-token)))))
   (recur (new-scanner source input)))
 

janet/validate.janet

@@ -7,8 +7,6 @@ Tracking here, before I start writing this code, the kinds of validation we're h
 * [ ] validate `with` forms
 * [ ] first-level property access with pkg, e.g. `Foo :bar`--bar must be on Foo
  - [ ] accept pkg-kws
-* [x] compile string-patterns
-* [ ] validate dict patterns
 * [x] `loop` form arity checking
 * [x] arity checking of explicit named function calls
 * [x] flag tail calls
@@ -184,31 +182,6 @@ Imports are for a later iteration of Ludus:
  (set (validator :ast) word)
  (pattern validator))
 
-(defn- str-pattern [validator]
- (def ast (validator :ast))
- (def data (ast :data))
- (array/pop data)
- (def grammar @{})
- (def bindings @[])
- (var current 0)
- (each node data
-  (when (not (buffer? node))
-   (set (validator :ast) node)
-   (pattern validator))
-  (if (buffer? node)
-   (set (grammar (keyword current)) (string node)) 
-   (do
-    (set (grammar (keyword current))
-     ~(<- (to ,(keyword (inc current)))))
-    (array/push bindings (node :data))))
-  (set current (inc current)))
- (def rules (map keyword (range (length grammar))))
- (set (grammar (keyword current)) -1)
- (set (grammar :main) ~(sequence ,;rules))
- (set (ast :grammar) grammar)
- (set (ast :compiled) (peg/compile grammar))
- (set (ast :bindings) bindings))
-
 (defn- pattern* [validator]
  (print "PATTERN*")
  (def ast (validator :ast))
@@ -225,7 +198,6 @@ Imports are for a later iteration of Ludus:
    :tuple (simple-coll-pattern validator)
    :splat (splattern validator)
    :typed (typed validator)
-   :interpolated (str-pattern validator)
    )))
 
 (set pattern pattern*)
@@ -235,7 +207,6 @@ Imports are for a later iteration of Ludus:
 (defn- guard [validator])
 
 (defn- match-clauses [validator clauses]
- (print "validating clauses in match-clauses")
  (each clause clauses
   (def parent (validator :ctx))
   (def ctx @{:^parent parent})
@@ -253,15 +224,8 @@ Imports are for a later iteration of Ludus:
   (set (validator :ctx) parent)))
 
 (defn- matchh [validator]
- (print "validating in matchh")
  (def ast (validator :ast))
- (def [to-match clauses] (ast :data))
+ (match-clauses validator (ast :data))
- (print "validating expression:")
- (pp to-match)
- (set (validator :ast) to-match)
- (validate validator)
- (print "validating clauses")
- (match-clauses validator clauses)
  validator)
 
 (defn- fnn [validator]
@@ -326,6 +290,7 @@ Imports are for a later iteration of Ludus:
 # * [ ] 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]
  (def ast (validator :ast))
  (when (ast :partial) (break validator))
@@ -335,6 +300,8 @@ Imports are for a later iteration of Ludus:
  (def args (last data))
  (set (args :tail-call) true))
 
+# * [ ] 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))
@@ -381,6 +348,7 @@ Imports are for a later iteration of Ludus:
   (check-arity validator))
  validator)
 
+### XXX: todos from parser
 (defn- pair [validator]
  (def ast (validator :ast))
  (def [k v] (ast :data))
@@ -420,7 +388,6 @@ Imports are for a later iteration of Ludus:
   (validate validator))
  validator)
 
-# XXX: do this!
 (defn- withh [validator])
 
 # XXX: tail calls in last position
@@ -625,30 +592,8 @@ Imports are for a later iteration of Ludus:
 (do
 # (comment
 (def source `
-let "{foo}" = "bar"
+
 `)
 (def scanned (s/scan source))
 (def parsed (p/parse scanned))
-(valid parsed)
+(valid parsed))
-(print "VALIDATED!!")
-(def grammar (get-in parsed [:ast :data 0 :data 0 :grammar]))
-(pp grammar)
-(peg/match grammar "foo"))
-
-(def bar @{
- :0 "" 
- :1 '(<- (to :2)) 
- :2 "" 
- :main '(sequence :0 :1 :2 -1)
- })
-
-(peg/match bar "foo")
-
-(def foo @{
- :0 ""
- :1 '(<- (to :2))
- :2 -1
- :main '(sequence :0 :1 :2)
-})
-
-(peg/match foo "foooooooobar")