{stringify, ltype} -> imports from base

janet/interpreter.janet

@@ -1,23 +1,15 @@
 # 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)
@@ -28,14 +20,14 @@
 
 (defn- match-word [word value ctx]
   (def name (word :data))
-  (print "matched " (stringify value) " to " name)
+  (print "matched " (b/show 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 (ltype value))
+  (if (= type (b/ludus/type value))
     (match-word word value ctx)
     {:success false :miss [pattern value]}))
 
@@ -191,7 +183,7 @@
       (break (match-fn (inc i) value ctx)))
     (def body-ctx (match? :ctx))
     (def guard? (if guard
-      (bool (interpret guard body-ctx)) true))
+      (b/bool (interpret guard body-ctx)) true))
     (when (not guard?) 
       (break (match-fn (inc i) value ctx)))
     (interpret expr body-ctx))
@@ -213,46 +205,8 @@
     (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] 
-  (if (stringish? x) x (stringify (interpret x ctx)))))
+  (b/stringify (interpret x ctx))))
 
 (defn- interpolated [ast ctx]
   (def terms (ast :data))
@@ -261,7 +215,7 @@
 
 (defn- iff [ast ctx]
   (def [condition then else] (ast :data))
-  (if (bool (interpret condition ctx))
+  (if (b/bool (interpret condition ctx))
     (interpret then ctx)
     (interpret else ctx)))
 
@@ -271,7 +225,7 @@
   (var result :^nothing)
   (each clause clauses
     (def [lhs rhs] clause)
-    (when (bool (interpret lhs ctx))
+    (when (b/bool (interpret lhs ctx))
       (set result (interpret rhs ctx))
       (break)))
   (when (= result :^nothing)
@@ -387,7 +341,7 @@
     (print "matched!")
     (def body-ctx (match? :ctx))
     (def guard? (if guard
-      (bool (interpret guard body-ctx)) true))
+      (b/bool (interpret guard body-ctx)) true))
     (print "passed guard")
     (when (not guard?) 
       (break (match-fn (inc i) args)))
@@ -400,7 +354,7 @@
   (pp curr)
   (print "to")
   (pp prev)
-  (def types [(ltype prev) (ltype curr)])
+  (def types [(b/ludus/type prev) (b/ludus/type curr)])
   (print "typle:")
   (pp types)
   (match types
@@ -503,7 +457,6 @@
 (set interpret interpret*)
 
 # repl
-(try (os/cd "janet") ([_] nil))
 (import ./scanner :as s)
 (import ./parser :as p)
 (import ./validate :as v) 
@@ -512,24 +465,16 @@
 
 (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 base))
+  (def validated (v/valid parsed b/ctx))
   (when (has-errors? validated) (break (validated :errors)))
   # (def cleaned (get-in parsed [:ast :data 1]))
   # (pp cleaned)
-  (interpret (parsed :ast) @{:^parent base})
+  (interpret (parsed :ast) @{:^parent b/ctx})
   # (try (interpret (parsed :ast) @{})
   #   ([e] (print "Ludus panicked!: " 
   #     (if (struct? e) (error (e :msg)) (error e)))))
@@ -537,11 +482,9 @@
 
 (do 
 (set source `
-print
+
 `)
 (def result (run))
-(stringify result)
+(b/show result)
 )
 
-(string print)
-

janet/validate.janet

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