Compare commits

...

2 Commits

Author SHA1 Message Date
Scott Richmond
822f5c0178 {stringify, ltype} -> imports from base 2024-05-19 18:24:11 -04:00
Scott Richmond
2415f3d437 bugfixes 2024-05-19 18:23:34 -04:00
2 changed files with 19 additions and 75 deletions

View File

@ -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)

View File

@ -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)