{stringify, ltype} -> imports from base

This commit is contained in:
Scott Richmond 2024-05-19 18:24:11 -04:00
parent 2415f3d437
commit 822f5c0178

View File

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