diff --git a/janet/base.janet b/janet/base.janet index b2868bd..82c83f5 100644 --- a/janet/base.janet +++ b/janet/base.janet @@ -46,7 +46,6 @@ (string/join (map stringify (keys value)) ", ") :box (stringify (value :^value)) :fn (string "fn " (value :name)) - :applied (string "fn " (value :name)) :function (string "builtin " (string value)) :pkg (dict-str value) )) @@ -72,7 +71,7 @@ :pkg (show-pkg x) (stringify x))) -(defn- show-patt [x] +(defn show-patt [x] (case (x :type) :nil "nil" :bool (string (x :data)) @@ -87,6 +86,7 @@ :typed (string (show-patt (get-in x [:data 1])) " as " (show-patt (get-in x [:data 0]))) :interpolated (get-in x [:token :lexeme]) :string (get-in x [:token :lexeme]) + :splat (string "..." (when (x :splatted) (show-patt (x :splatted)))) (error (string "cannot show pattern of unknown type " (x :type))))) (defn pretty-patterns [fnn] @@ -165,7 +165,7 @@ :set (-> x (dissoc :^type) keys) @[x])) -(defn print! [& args] +(defn print! [args] (print ;(map show args))) (defn prn [x] @@ -178,9 +178,9 @@ :list (array/concat @[] x y ;zs) :set (merge x y ;zs))) -(defn unbox [x] (get x :^value)) +(defn unbox [b] (get b :^value)) -(defn store! [x] (set (x :^value) x)) +(defn store! [b x] (set (b :^value) x)) (def ctx { "print!" print! diff --git a/janet/errors.janet b/janet/errors.janet index bf6c2c0..d697a72 100644 --- a/janet/errors.janet +++ b/janet/errors.janet @@ -47,8 +47,20 @@ (print "with " (b/show value)) (print "expecting to match one of") (print (b/pretty-patterns called)) + (print source-line) ) +(defn- let-no-match [e] + (print "Ludus panicked! no match") + (def line-num (get-in e [:node :token :line])) + (def source (get-in e [:node :token :source])) + (def source-line (get-line source line-num)) + (print "on line " line-num) + (print "binding " (b/show (e :value))) + (def pattern (get-in e [:node :data 0])) + (print "to " (b/show-patt pattern)) + (print source-line)) + (defn- generic-panic [e] (def msg (e :msg)) (def line-num (get-in e [:node :token :line])) @@ -59,10 +71,20 @@ (print source-line) ) +(defn- unbound-name [e] + (def {:line line-num :source source :lexeme name} (get-in e [:node :token])) + (def source-line (get-line source line-num)) + (print "Ludus panicked! unbound name " name) + (print "on line " line-num) + (print source-line) +) + (defn runtime-error [e] - (pp e) + (when (= :string (type e)) (print e) (break e)) (def msg (e :msg)) (case msg "no match: function call" (fn-no-match e) - (generic-panic e) + "no match: let binding" (let-no-match e) + "unbound name" (unbound-name e) + (generic-panic e)) e) diff --git a/janet/interpreter.janet b/janet/interpreter.janet index e00ad73..d74385c 100644 --- a/janet/interpreter.janet +++ b/janet/interpreter.janet @@ -370,7 +370,7 @@ (defn- fnn [ast ctx] (def {:name name :data clauses :doc doc} ast) # (print "defining fn " name) - (def closure (table/to-struct ctx)) + (def closure (merge ctx)) (def the-fn @{:name name :^type :fn :body clauses :ctx closure :doc doc}) (when (not= :^not-found (resolve-name name ctx)) # (print "fn "name" was forward declared") @@ -382,6 +382,7 @@ # (pp fwd) (break fwd)) # (pp the-fn) + (set (closure name) the-fn) (set (ctx name) the-fn) the-fn) @@ -389,10 +390,10 @@ (var call-fn nil) -(def name "foo") -(eval ~(fn ,(symbol name) [] :foo)) - -(defn- partial [the-fn partial-args] +(defn- partial [root-ast the-fn partial-args] + (when (the-fn :applied) + (error {:msg "cannot partially apply a partially applied function" + :node root-ast :called the-fn :args partial-args})) # (print "calling partially applied function") (def args (partial-args :args)) # (pp args) @@ -405,7 +406,7 @@ (set (full-args pos) missing) # (print "all args: " (b/show full-args)) (call-fn root-ast the-fn [;full-args])) - {:^type :applied :name name :body partial-fn}) + {:^type :fn :applied true :name name :body partial-fn}) (defn- call-fn* [root-ast the-fn args] # (print "on line " (get-in root-ast [:token :line])) @@ -456,9 +457,9 @@ # (pp types) (match types [:fn :tuple] (call-fn root-ast prev curr) - [:fn :partial] (partial prev curr) + [:fn :partial] (partial root-ast prev curr) [:function :tuple] (call-fn root-ast prev curr) - [:applied :tuple] (call-partial root-ast prev curr) + # [:applied :tuple] (call-partial root-ast prev curr) [:keyword :args] (get (first curr) prev :^nil) [:dict :keyword] (get prev curr :^nil) [:nil :keyword] :^nil @@ -643,11 +644,14 @@ (try (interpret (parsed :ast) @{:^parent b/ctx}) ([e] (if (struct? e) (error (e :msg)) (error e))))) -(do +# (do +(comment (set source ` -box foo = :bar +fn call_unary (f, arg) -> f (arg) +fn my_add (x, y) -> add (x, y) +let add5 = my_add (5, _) +call_unary (add5, 10) `) (def result (run)) -(b/show result) ) diff --git a/janet/load-prelude.janet b/janet/load-prelude.janet new file mode 100644 index 0000000..434d11e --- /dev/null +++ b/janet/load-prelude.janet @@ -0,0 +1,29 @@ +(try (os/cd "janet") ([_] nil)) +(import /base :as b) +(import /scanner :as s) +(import /parser :as p) +(import /validate :as v) +(import /interpreter :as i) +(import /errors :as e) + +(def pkg (do + (def prelude-ctx @{:^parent {"base" b/base}}) + (def prelude-src (slurp "prelude.ld")) + (def prelude-scanned (s/scan prelude-src)) + (def prelude-parsed (p/parse prelude-scanned)) + (def parse-errors (prelude-parsed :errors)) + (when (any? parse-errors) (each err parse-errors (e/parse-error err)) (break :error)) + (def prelude-validated (v/valid prelude-parsed prelude-ctx)) + (def validation-errors (prelude-validated :errors)) + (when (any? validation-errors) (each err validation-errors (e/validation-error err)) (break :error)) + (try + (i/interpret (prelude-parsed :ast) prelude-ctx) + ([err] (e/runtime-error err) :error)))) + +(def ctx (do + (def ctx @{}) + (each [k v] (pairs pkg) + (set (ctx (string k)) v)) + (set (ctx "^name") nil) + (set (ctx "^type") nil) + ctx)) diff --git a/janet/ludus.janet b/janet/ludus.janet index 656f6c8..2c612fd 100644 --- a/janet/ludus.janet +++ b/janet/ludus.janet @@ -6,6 +6,7 @@ (import /interpreter :as i) (import /errors :as e) (import /base :as b) +(import /load-prelude :as prelude) (import spork/json :as j) (comment @@ -19,30 +20,8 @@ This new scene will have to return a JSON POJSO: {:console "..." :result "..." :draw [...] :errors [...]} ) -(def prelude-ctx @{:^parent {"base" b/base}}) - -# (comment -# (do -(def prelude-ctx @{:^parent {"base" b/base}}) -(def prelude-src (slurp "prelude.ld")) -(def prelude-scanned (s/scan prelude-src)) -(def prelude-parsed (p/parse prelude-scanned)) -(def parse-errors (prelude-parsed :errors)) -(when (any? parse-errors) (each err parse-errors (e/parse-error err))) -(def prelude-validated (v/valid prelude-parsed prelude-ctx)) -(def validation-errors (prelude-validated :errors)) -(when (any? validation-errors) (each err validation-errors (e/validation-error err))) -(def prelude-pkg (try - (i/interpret (prelude-parsed :ast) prelude-ctx) - ([e] e))) - -(keys prelude-pkg) -(prelude-pkg :msg) -(e/runtime-error prelude-pkg) -# ) - - (defn run [source] + (def ctx @{:^parent prelude/ctx}) (def errors @[]) (def draw @[]) (var result @"") @@ -57,30 +36,24 @@ This new scene will have to return a JSON POJSO: (when (any? (parsed :errors)) (break (each err (parsed :errors) (e/parse-error err)))) - (def validated (v/valid parsed prelude-ctx)) + (def validated (v/valid parsed ctx)) (when (any? (validated :errors)) (break (each err (validated :errors) (e/validation-error err)))) (setdyn :out console) + (print "starting ludus run") (try - (set result (b/show (i/interpret (parsed :ast) prelude-ctx))) + (set result (b/show (i/interpret (parsed :ast) ctx))) ([err] (setdyn :out stdout) (e/runtime-error err))) (setdyn :out stdout) (set (out :result) result) - (j/encode out)) - -(defn test [source]) - -(defn run-script [filename] - (def source (slurp filename)) - (run source)) + result) +(do (def source ` -let pi = base :pi -pi +print! ("hello") `) -b/base - -(-> source run j/decode) +(-> source run) +) diff --git a/janet/parser.janet b/janet/parser.janet index a4f5056..5cb4405 100644 --- a/janet/parser.janet +++ b/janet/parser.janet @@ -1117,10 +1117,10 @@ # (do (comment -(def source `fn () -> 42 +(def source `... `) (def scanned (s/scan source)) # (print "\n***NEW PARSE***\n") (def a-parser (new-parser scanned)) -(def parsed (fnn a-parser)) +(def parsed (splat a-parser)) ) diff --git a/janet/prelude.janet b/janet/prelude.janet new file mode 100644 index 0000000..44f345a Binary files /dev/null and b/janet/prelude.janet differ diff --git a/janet/prelude.jimage b/janet/prelude.jimage new file mode 100644 index 0000000..5d18916 Binary files /dev/null and b/janet/prelude.jimage differ diff --git a/janet/prelude.ld b/janet/prelude.ld index 6925fcb..a17ce15 100644 --- a/janet/prelude.ld +++ b/janet/prelude.ld @@ -282,7 +282,11 @@ fn show { fn prn! { "Prints the underlying Clojure data structure of a Ludus value." - (x) -> base :prn (x) + (x) -> { + base :prn (x) + add_msg! (x) + :ok + } } fn report! { @@ -352,7 +356,10 @@ fn unbox { fn store! { "Stores a value in a box, replacing the value that was previously there. Returns the value." - (b as :box, value) -> base :set! (b, value) + (b as :box, value) -> { + base :store! (b, value) + value + } } fn update! { @@ -566,12 +573,12 @@ fn at { (xs as :list, n as :number) -> when { neg? (n) -> nil gte? (n, count (xs)) -> nil - true -> base :nth (xs, inc (n)) + true -> base :nth (n, xs) } (xs as :tuple, n as :number) -> when { neg? (n) -> nil gte? (n, count (xs)) -> nil - true -> base :nth (xs, inc (n)) + true -> base :nth (n, xs) } (_) -> nil } @@ -792,9 +799,6 @@ fn each! { let pi = base :pi -print! (base :pi) -print! (pi) - let tau = mult (2, pi) fn sin { @@ -1270,136 +1274,154 @@ fn penwidth { } pkg Prelude { - type - eq? - neq? - tuple? - fn? - empty? - any? - first - second - rest - at - last - butlast - slice - count - append - fold - map - filter - keep - list - set - set? - inc - dec - print! - flush! - console - show - prn! - report! - doc! - concat - box? - unbox - store! - update! - string - string? - join + abs add - sub - mult + and + angle + any? + append + assert! + assoc + assoc? + at + atan/2 + back! + background! + between? + bg! + bgcolor + bk! + bool + bool? + box? + butlast + ceil + clear! + coll? + colors + concat + console + cos + count + dec + deg/rad + deg/turn + dict + dict? + diff + dissoc + dist div div/0 div/safe - inv - inv/0 - angle - abs - neg - zero? - neg? - pos? - even? - odd? - gt? - gte? - lt? - lte? - min - max - between? - keyword? - nil? - some? - some - bool? - false? - bool - not - and - or - coll? - ordered? - assoc? - assoc - dissoc - update - get - dict - dict? - keys - values - diff + doc! each! - sin - cos - tan - turn/rad - rad/turn - turn/deg - deg/turn - rad/deg - deg/rad - atan/2 - mod - square - sum_of_squares - dist - random - random_int - pi - tau - floor - ceil - round - range - ok - ok? + empty? + eq? err err? + even? + false? + fd! + filter + first + floor + flush! + fn? + fold + forward! + get + goto! + gt? + gte? + heading + heading/vector + home! + inc + inv + inv/0 + join + keep + keys + keyword? + last + left! + list + lt! + lt? + lte? + map + max + min + mod + mult + neg + neg? + neq? + nil? + not + odd? + ok + ok? + or + ordered? + p5_calls + pc! + pd! + pencolor + pencolor! + pendown! + pendown? + penup! + penwidth + penwidth! + pi + pos? + position + print! + prn! + pu! + pw! + rad/deg + rad/turn + random + random_int + range + render_turtle! + report! + reset_turtle! + rest + right! + round + rt! + second + set + set? + show + sin + slice + some + some? + square + store! + string + string? + sub + sum_of_squares + tan + tau + tuple? + turn/deg + turn/rad + turtle_commands + turtle_state + turtle_states + type + unbox unwrap! unwrap_or - assert! - colors - forward!, fd! - back!, bk! - right!, rt! - left!, lt! - penup!, pu! - pendown!, pd! - pencolor!, pc! - background!, bg! - penwidth!, pw! - home!, clear!, goto!, - heading, position, pendown? - pencolor, penwidth - heading/vector - turtle_state - p5_calls, turtle_states, turtle_commands, bgcolor - render_turtle!, reset_turtle! + update + update! + values + zero? } diff --git a/janet/validate.janet b/janet/validate.janet index bbb94ea..44328e0 100644 --- a/janet/validate.janet +++ b/janet/validate.janet @@ -296,7 +296,7 @@ Deferred until a later iteration of Ludus: (defn- fnn [validator] (def ast (validator :ast)) (def name (ast :name)) - (print "function name: " name) + # (print "function name: " name) (def status (validator :status)) (def tail? (status :tail)) (set (status :tail) true)