Compare commits

..

2 Commits

Author SHA1 Message Date
Scott Richmond
24bbef74aa add janet functions 2024-05-19 16:18:52 -04:00
Scott Richmond
a06014270f validate with passed context; don't die on builtin functions 2024-05-19 16:17:34 -04:00
2 changed files with 56 additions and 13 deletions

View File

@ -226,6 +226,7 @@
(print "value is a dictionary") (print "value is a dictionary")
(value :^type))) (value :^type)))
(def type (if typed? typed? (type value))) (def type (if typed? typed? (type value)))
(print "value of type " type)
(case type (case type
:nil "" :nil ""
:number (string value) :number (string value)
@ -241,6 +242,8 @@
(string/join (map stringify (keys value)) ", ") (string/join (map stringify (keys value)) ", ")
:ref (stringify (value :^value)) :ref (stringify (value :^value))
:fn (string "fn " (value :name)) :fn (string "fn " (value :name))
:function (string "builtin " (string value))
:cfunction (string "builtin " (string value))
# XXX: pkg, fn # XXX: pkg, fn
)) ))
@ -403,6 +406,7 @@
(match types (match types
[:fn :tuple] (call-fn prev curr) [:fn :tuple] (call-fn prev curr)
[:fn :partial] (partial prev curr) [:fn :partial] (partial prev curr)
[:function :tuple] (prev ;curr)
[:keyword :args] (get (first curr) prev :^nil) [:keyword :args] (get (first curr) prev :^nil)
[:dict :keyword] (get prev curr :^nil) [:dict :keyword] (get prev curr :^nil)
[:nil :keyword] :^nil [:nil :keyword] :^nil
@ -428,6 +432,18 @@
(defn- doo [ast ctx] (todo "do expressions")) (defn- doo [ast ctx] (todo "do expressions"))
(defn- pkg [ast ctx] (todo "pkgs"))
(defn- ns [ast ctx] (todo "nses"))
(defn- loopp [ast ctx] (todo "loops"))
(defn- recur [ast ctx] (todo "recur"))
(defn- repeatt [ast ctx] (todo "repeat"))
(defn - testt [ast ctx] (todo "test"))
(defn- interpret* [ast ctx] (defn- interpret* [ast ctx]
(print "interpreting node " (ast :type)) (print "interpreting node " (ast :type))
(case (ast :type) (case (ast :type)
@ -453,6 +469,11 @@
:script (script ast ctx) :script (script ast ctx)
:panic (panic ast ctx) :panic (panic ast ctx)
# looping forms
:loop (loopp ast ctx)
:recur (recur ast ctx)
:repeat (repeatt ast ctx)
# named/naming forms # named/naming forms
:word (word ast ctx) :word (word ast ctx)
:interpolated (interpolated ast ctx) :interpolated (interpolated ast ctx)
@ -463,7 +484,6 @@
# patterned forms # patterned forms
:let (lett ast ctx) :let (lett ast ctx)
:match (matchh ast ctx) :match (matchh ast ctx)
# :with (withh ast ctx)
# functions # functions
:fn (fnn ast ctx) :fn (fnn ast ctx)
@ -474,6 +494,10 @@
# do # do
:do (doo ast ctx) :do (doo ast ctx)
# deferred until after computer class
# :with (withh ast ctx)
# :import (importt ast ctx)
)) ))
(set interpret interpret*) (set interpret interpret*)
@ -488,16 +512,24 @@
(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)) (def validated (v/valid parsed base))
(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) @{}) (interpret (parsed :ast) @{:^parent base})
# (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)))))
@ -505,9 +537,11 @@
(do (do
(set source ` (set source `
#{:a 1, :b 2} print
`) `)
(def result (run)) (def result (run))
(stringify result) (stringify result)
) )
(string print)

View File

@ -5,7 +5,6 @@
Tracking here, before I start writing this code, the kinds of validation we're hoping to accomplish: Tracking here, before I start writing this code, the kinds of validation we're hoping to accomplish:
* [ ] ensure called keywords are only called w/ one arg * [ ] ensure called keywords are only called w/ one arg
* [ ] validate `with` forms
* [ ] first-level property access with pkg, e.g. `Foo :bar`--bar must be on Foo * [ ] first-level property access with pkg, e.g. `Foo :bar`--bar must be on Foo
- [ ] accept pkg-kws - [ ] accept pkg-kws
* [ ] validate dict patterns * [ ] validate dict patterns
@ -20,9 +19,10 @@ Tracking here, before I start writing this code, the kinds of validation we're h
* [x] recur not called outside of `loop` forms * [x] recur not called outside of `loop` forms
* [x] splats come at the end of list, tuple, and dict patterns * [x] splats come at the end of list, tuple, and dict patterns
Imports are for a later iteration of Ludus: Deferred until a later iteration of Ludus:
* [ ] no circular imports DEFERRED * [ ] no circular imports DEFERRED
* [ ] correct imports DEFERRED * [ ] correct imports DEFERRED
* [ ] validate `with` forms
) )
(try (os/cd "janet") ([_] nil)) (try (os/cd "janet") ([_] nil))
@ -344,6 +344,7 @@ Imports are for a later iteration of Ludus:
(def fn-word (first data)) (def fn-word (first data))
(def the-fn (resolve-name ctx (fn-word :data))) (def the-fn (resolve-name ctx (fn-word :data)))
(when (not the-fn) (break validator)) (when (not the-fn) (break validator))
(when (= :function (type the-fn)) (break validator))
(print "fn name: " (the-fn :name)) (print "fn name: " (the-fn :name))
(def arities (the-fn :arities)) (def arities (the-fn :arities))
(print "arities: ") (print "arities: ")
@ -620,16 +621,24 @@ Imports are for a later iteration of Ludus:
(set validate validate*) (set validate validate*)
(defn valid [ast] (defn valid [ast &opt ctx]
(default ctx @{})
(def validator (new-validator ast)) (def validator (new-validator ast))
(def base-ctx @{:^parent ctx})
(set (validator :ctx) ctx)
(validate validator)) (validate validator))
# (do (defn foo [] :foo)
(comment (def base {
"foo" foo
})
(do
# (comment
(def source ` (def source `
let "{foo}" = "bar" foo ()
`) `)
(def scanned (s/scan source)) (def scanned (s/scan source))
(def parsed (p/parse scanned)) (def parsed (p/parse scanned))
(valid parsed) (valid parsed base)
) )