janet/interpreter.janet

@@ -11,8 +11,8 @@
 (defn- todo [msg] (error (string "not yet implemented: " msg)))
 
 (defn- resolve-name [name ctx]
-  # (print "resolving " name " in:")
+  (print "resolving " name " in:")
-  # (pp ctx)
+  (pp ctx)
   (when (not ctx) (break :^not-found))
   (if (has-key? ctx name)
     (ctx name)
@@ -20,7 +20,7 @@
 
 (defn- match-word [word value ctx]
   (def name (word :data))
-  # (print "matched " (b/show value) " to " name)
+  (print "matched " (b/show value) " to " name)
   (set (ctx name) value)
   {:success true :ctx ctx})
 
@@ -126,49 +126,7 @@
     (set (ctx (bindings i)) (matches i)))
   {:success true :ctx ctx})
 
-(defn- match-dict [pattern value ctx]
+(defn- match-dict [pattern value ctx] (todo "dict pattern"))
-  (when (not (table? value))
-    (break {:success false :miss [pattern value]}))
-  (def val-size (length value))
-  (var members (pattern :data))
-  (def patt-len (length members))
-  (when (empty? members)
-    (break (if (empty? value)
-      {:success true :ctx ctx}
-      {:success false :miss [pattern value]})))
-  (var splat nil)
-  (def splat? (= :splat ((last members) :type)))
-  (when splat?
-    (when (< val-size patt-len)
-      (print "mismatched splatted dict lengths")
-      (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-size patt-len))
-    (print "mismatched dict lengths")
-    (break {:success false :miss [pattern value]}))
-  (var success true)
-  (def matched-keys @[])
-  (for i 0 (length members)
-    (def curr-pair (get members i))
-    (def [curr-key curr-patt] (curr-pair :data))
-    (def key (interpret curr-key ctx))
-    (def curr-val (value key))
-    (def match? (match-pattern curr-patt curr-val ctx))
-    (array/push matched-keys key)
-    (when (not (match? :success))
-      (set success false)
-      (break)))
-  (when (and splat? (splat :data) success)
-    (def rest (merge value))
-    (each key matched-keys
-      (set (rest key) nil))
-    (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:")
@@ -363,30 +321,14 @@
   (set (ctx name) the-fn))
 
 # TODO
-(defn- is_placeholder [x] (= x :_))
+(defn- partial [the-fn args] (todo "partially applied functions"))
 
-(var call-fn nil)
+(defn- call-fn [the-fn args]
-
-(defn- partial [the-fn partial-args] 
-  (print "calling partially applied function")
-  (def args (partial-args :args))
-  (def pos (find-index is_placeholder args))
-  (def name (string (the-fn :name) "<partial>"))
-  (fn [missing]
-    (print "calling function with arg " (b/show missing))
-    (pp partial-args)
-    (def full-args (array/slice args))
-    (set (full-args pos) missing)
-    (print "all args: " (b/show full-args))
-    (call-fn the-fn [;full-args])))
-
-(defn- call-fn* [the-fn args]
   (print "calling " (b/show the-fn))
   (print "with args " (b/show args))
   (when (or 
     (= :function (type the-fn)) 
     (= :cfunction (type the-fn))) 
-      (print "Janet function")
       (break (the-fn ;args)))
   (def clauses (the-fn :body))
   (def len (length clauses))
@@ -411,11 +353,11 @@
   (set (the-fn :match) match-fn)
   (match-fn 0 args))
 
-(set call-fn call-fn*)
-
 (defn- apply-synth-term [prev curr]
-  (print "applying " (b/show prev))
+  (print "applying")
-  (print "to" (b/show curr))
+  (pp curr)
+  (print "to")
+  (pp prev)
   (def types [(b/ludus/type prev) (b/ludus/type curr)])
   (print "typle:")
   (pp types)
@@ -464,6 +406,8 @@
 
 (defn- recur [ast ctx] (todo "recur"))
 
+(defn- repeatt [ast ctx] (todo "repeat"))
+
 (defn - testt [ast ctx] (todo "test"))
 
 (defn- interpret* [ast ctx]
@@ -539,7 +483,7 @@
   (def parsed (p/parse scanned))
   (when (has-errors? parsed) (break (parsed :errors)))
   (def validated (v/valid parsed b/ctx))
-  # (when (has-errors? validated) (break (validated :errors)))
+  (when (has-errors? validated) (break (validated :errors)))
   # (def cleaned (get-in parsed [:ast :data 1]))
   # (pp cleaned)
   (interpret (parsed :ast) @{:^parent b/ctx})
@@ -550,9 +494,9 @@
 
 (do 
 (set source `
-let #{:a ay, :b (:ok, bee), ...c} = #{:a 1, :b (:ok, 42), :c 3}
+
 `)
 (def result (run))
-# (b/show result)
+(b/show result)
 )
 

janet/parser.janet

@@ -411,7 +411,7 @@
      :token origin})
     {:type :pair :data [key value] :token origin})
    :keyword (do
-    (def key (capture kw-only parser))
+    (def key (capture kw parser))
     (def value (capture nonbinding parser))
     {:type :pair :data [key value] :token origin})
    (try (panic parser (string "expected dict term, got " (type origin))) ([e] e))
@@ -507,7 +507,7 @@
     (def key {:type :keyword :data (keyword name) :token origin})
     {:type :pair :data [key word] :token origin})
    :keyword (do
-    (def key (capture kw-only parser))
+    (def key (capture kw parser))
     (def value (capture pattern parser))
     {:type :pair :data [key value] :token origin})
    (try (panic parser (string "expected dict term, got " (type origin))) ([e] e))
@@ -1104,8 +1104,8 @@
 )
 
 
-# (do
+(do
-(comment
+# (comment
 (def source `a :b :c
 `)
 (def scanned (s/scan source))

janet/validate.janet

@@ -144,6 +144,9 @@ Deferred until a later iteration of Ludus:
  (set (status :last) nil)
  validator)
 
+### XXX: to do
+(defn- dict-pattern [validator])
+
 (defn- word-pattern [validator]
  (def ast (validator :ast))
  (def name (ast :data))
@@ -207,12 +210,6 @@ Deferred until a later iteration of Ludus:
  (set (ast :compiled) (peg/compile grammar))
  (set (ast :bindings) bindings))
 
-(defn- pair [validator]
- (def ast (validator :ast))
- (def [_ patt] (ast :data))
- (set (validator :ast) patt)
- (pattern validator))
-
 (defn- pattern* [validator]
  (print "PATTERN*")
  (def ast (validator :ast))
@@ -227,11 +224,9 @@ Deferred until a later iteration of Ludus:
    :word (word-pattern validator)
    :list (simple-coll-pattern validator)
    :tuple (simple-coll-pattern validator)
-   :dict (simple-coll-pattern validator)
    :splat (splattern validator)
    :typed (typed validator)
    :interpolated (str-pattern validator)
-   :pair (pair validator)
    )))
 
 (set pattern pattern*)
@@ -343,15 +338,14 @@ Deferred until a later iteration of Ludus:
 
 (defn- check-arity [validator]
  (def ast (validator :ast))
- # (when (ast :partial) (break validator))
+ (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)))
  (when (not the-fn) (break validator))
  (when (= :function (type the-fn)) (break validator))
- (when (= :cfunction (type the-fn) (break validator)))
+ (when (= :cfunction (type the-fn)) (break validator))
- (when (not= :fn (the-fn :type)) (break validator))
  (print "fn name: " (the-fn :name))
  (def arities (the-fn :arities))
  (print "arities: ")
@@ -359,7 +353,6 @@ Deferred until a later iteration of Ludus:
  (def args (get data 1))
  (def num-args (length (args :data)))
  (print "called with #args " num-args)
- (pp (get (validator :ctx) "bar"))
  (when (has-key? arities num-args) (break validator))
  (def rest-arities (keys (arities :rest)))
  (when (empty? rest-arities)
@@ -636,15 +629,17 @@ Deferred until a later iteration of Ludus:
  (set (validator :ctx) base-ctx)
  (validate validator))
 
-(import ./base :as b)
+(defn foo [] :foo)
+(def base {
+ "foo" foo
+})
 
 (do
 # (comment
 (def source `
-let #{a, b} = #{:a 1}
+foo ()
-b
 `)
 (def scanned (s/scan source))
 (def parsed (p/parse scanned))
-(valid parsed b/ctx)
+(valid parsed base)
 )