janet/interpreter.janet

@@ -1,15 +1,23 @@
 # A tree walk interpreter for ludus
 
-# for repl imports
-(try (os/cd "janet") ([_] nil))
-
-(import ./base :as b)
-
 (var interpret nil)
+(var stringify nil)
 (var match-pattern nil)
 
 (defn- todo [msg] (error (string "not yet implemented: " msg)))
 
+(defn- ltype [value]
+  (def typed? (when (dictionary? value) (value :^type)))
+  (def the-type (if typed? typed? (type value)))
+  (case the-type
+    :boolean :bool
+    :array :list
+    :table :dict
+    the-type))
+
+(defn- bool [value]
+  (if (= value :^nil nil) value))
+
 (defn- resolve-name [name ctx]
   (print "resolving " name " in:")
   (pp ctx)
@@ -20,14 +28,14 @@
 
 (defn- match-word [word value ctx]
   (def name (word :data))
-  (print "matched " (b/show value) " to " name)
+  (print "matched " (stringify value) " to " name)
   (set (ctx name) value)
   {:success true :ctx ctx})
 
 (defn- typed [pattern value ctx]
   (def [type-ast word] (pattern :data))
   (def type (type-ast :data))
-  (if (= type (b/ludus/type value))
+  (if (= type (ltype value))
     (match-word word value ctx)
     {:success false :miss [pattern value]}))
 
@@ -183,7 +191,7 @@
       (break (match-fn (inc i) value ctx)))
     (def body-ctx (match? :ctx))
     (def guard? (if guard
-      (b/bool (interpret guard body-ctx)) true))
+      (bool (interpret guard body-ctx)) true))
     (when (not guard?) 
       (break (match-fn (inc i) value ctx)))
     (interpret expr body-ctx))
@@ -205,8 +213,46 @@
     (interpret (lines i) ctx))
   (interpret last-line ctx))
 
+(defn- dict-str [dict]
+  (string/join 
+    (map 
+      (fn [[k v]] (string (stringify k) " " (stringify v))) 
+      (pairs dict))
+    ", "))
+
+(defn- stringify* [value]
+  (print "stringifying " (string value))
+  (def typed? (when (dictionary? value) 
+    (print "value is a dictionary")
+    (value :^type)))
+  (def type (if typed? typed? (type value)))
+  (print "value of type " type)
+  (case type
+    :nil ""
+    :number (string value)
+    :boolean (string value)
+    :keyword (string ":" value)
+    :string value
+    :tuple 
+      (string/join (map stringify value) ", ")
+    :array
+      (string/join (map stringify value) ", ")
+    :table (dict-str value)
+    :set
+      (string/join (map stringify (keys value)) ", ")
+    :ref (stringify (value :^value))
+    :fn (string "fn " (value :name))
+    :function (string "builtin " (string value))
+    :cfunction (string "builtin " (string value))
+    # XXX: pkg, fn 
+  ))
+
+(set stringify stringify*)
+
+(defn- stringish? [x] (or (string? x) (buffer? x)))
+
 (defn- to_string [ctx] (fn [x] 
-  (b/stringify (interpret x ctx))))
+  (if (stringish? x) x (stringify (interpret x ctx)))))
 
 (defn- interpolated [ast ctx]
   (def terms (ast :data))
@@ -215,7 +261,7 @@
 
 (defn- iff [ast ctx]
   (def [condition then else] (ast :data))
-  (if (b/bool (interpret condition ctx))
+  (if (bool (interpret condition ctx))
     (interpret then ctx)
     (interpret else ctx)))
 
@@ -225,7 +271,7 @@
   (var result :^nothing)
   (each clause clauses
     (def [lhs rhs] clause)
-    (when (b/bool (interpret lhs ctx))
+    (when (bool (interpret lhs ctx))
       (set result (interpret rhs ctx))
       (break)))
   (when (= result :^nothing)
@@ -341,7 +387,7 @@
     (print "matched!")
     (def body-ctx (match? :ctx))
     (def guard? (if guard
-      (b/bool (interpret guard body-ctx)) true))
+      (bool (interpret guard body-ctx)) true))
     (print "passed guard")
     (when (not guard?) 
       (break (match-fn (inc i) args)))
@@ -354,7 +400,7 @@
   (pp curr)
   (print "to")
   (pp prev)
-  (def types [(b/ludus/type prev) (b/ludus/type curr)])
+  (def types [(ltype prev) (ltype curr)])
   (print "typle:")
   (pp types)
   (match types
@@ -457,6 +503,7 @@
 (set interpret interpret*)
 
 # repl
+(try (os/cd "janet") ([_] nil))
 (import ./scanner :as s)
 (import ./parser :as p)
 (import ./validate :as v) 
@@ -465,16 +512,24 @@
 
 (defn- has-errors? [{:errors errors}] (and errors (not (empty? errors))))
 
+(def base {
+  "ludus-type" ltype
+  "print" print
+  "add" +
+  "sub" -
+  "stringify" stringify
+})
+
 (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 b/ctx))
+  (def validated (v/valid parsed base))
   (when (has-errors? validated) (break (validated :errors)))
   # (def cleaned (get-in parsed [:ast :data 1]))
   # (pp cleaned)
-  (interpret (parsed :ast) @{:^parent b/ctx})
+  (interpret (parsed :ast) @{:^parent base})
   # (try (interpret (parsed :ast) @{})
   #   ([e] (print "Ludus panicked!: " 
   #     (if (struct? e) (error (e :msg)) (error e)))))
@@ -482,9 +537,11 @@
 
 (do 
 (set source `
-
+print
 `)
 (def result (run))
-(b/show result)
+(stringify result)
 )
 
+(string print)
+

janet/validate.janet

@@ -345,7 +345,6 @@ Deferred until a later iteration of Ludus:
  (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))
  (print "fn name: " (the-fn :name))
  (def arities (the-fn :arities))
  (print "arities: ")
@@ -626,7 +625,7 @@ Deferred until a later iteration of Ludus:
  (default ctx @{})
  (def validator (new-validator ast))
  (def base-ctx @{:^parent ctx})
- (set (validator :ctx) base-ctx)
+ (set (validator :ctx) ctx)
  (validate validator))
 
 (defn foo [] :foo)