diff --git a/janet/interpreter.janet b/janet/interpreter.janet index 3e94d15..6d0950a 100644 --- a/janet/interpreter.janet +++ b/janet/interpreter.janet @@ -1,7 +1,7 @@ # A tree walk interpreter for ludus # for repl imports -(try (os/cd "janet") ([_] nil)) +# (try (os/cd "janet") ([_] nil)) (import ./base :as b) @@ -11,8 +11,8 @@ (defn- todo [msg] (error (string "not yet implemented: " msg))) (defn- resolve-name [name ctx] - # (print "resolving " name " in:") - # (pp ctx) + # # (print "resolving " name " in:") + # # (pp ctx) (when (not ctx) (break :^not-found)) (if (has-key? ctx name) (ctx name) @@ -20,7 +20,7 @@ (defn- match-word [word value ctx] (def name (word :data)) - # (print "matched " (b/show value) " to " name) + # # (print "matched " (b/show value) " to " name) (set (ctx name) value) {:success true :ctx ctx}) @@ -45,13 +45,13 @@ (def splat? (= :splat ((last members) :type))) (when splat? (when (< val-len patt-len) - (print "mismatched splatted tuple lengths") + # (print "mismatched splatted tuple lengths") (break {:success false :miss [pattern value]})) - (print "splat!") + # (print "splat!") (set splat (last members)) (set members (slice members 0 (dec patt-len)))) (when (and (not splat?) (not= val-len patt-len)) - (print "mismatched tuple lengths") + # (print "mismatched tuple lengths") (break {:success false :miss [pattern value]})) (var curr-mem :^nothing) (var curr-val :^nothing) @@ -59,10 +59,10 @@ (for i 0 (length members) (set curr-mem (get members i)) (set curr-val (get value i)) - (print "in tuple, matching " curr-val " with ") - (pp curr-mem) + # (print "in tuple, matching " curr-val " with ") + # (pp curr-mem) (def match? (match-pattern curr-mem curr-val ctx)) - (pp match?) + # (pp match?) (when (not (match? :success)) (set success false) (break))) @@ -83,13 +83,13 @@ (def splat? (= :splat ((last members) :type))) (when splat? (when (< val-len patt-len) - (print "mismatched splatted list lengths") + # (print "mismatched splatted list lengths") (break {:success false :miss [pattern value]})) - (print "splat!") + # (print "splat!") (set splat (last members)) (set members (slice members 0 (dec patt-len)))) (when (and (not splat?) (not= val-len patt-len)) - (print "mismatched list lengths") + # (print "mismatched list lengths") (break {:success false :miss [pattern value]})) (var curr-mem :^nothing) (var curr-val :^nothing) @@ -97,10 +97,10 @@ (for i 0 (length members) (set curr-mem (get members i)) (set curr-val (get value i)) - (print "in list, matching " curr-val " with ") - (pp curr-mem) + # (print "in list, matching " curr-val " with ") + # (pp curr-mem) (def match? (match-pattern curr-mem curr-val ctx)) - (pp match?) + # (pp match?) (when (not (match? :success)) (set success false) (break))) @@ -115,8 +115,8 @@ (when (not (string? value)) (break {:success false :miss [pattern value]})) (def {:compiled compiled :bindings bindings} pattern) - (print "matching " value " with") - (pp (pattern :grammar)) + # (print "matching " value " with") + # (pp (pattern :grammar)) (def matches (peg/match compiled value)) (when (not matches) (break {:success false :miss [pattern value]})) @@ -140,13 +140,13 @@ (def splat? (= :splat ((last members) :type))) (when splat? (when (< val-size patt-len) - (print "mismatched splatted dict lengths") + # (print "mismatched splatted dict lengths") (break {:success false :miss [pattern value]})) - (print "splat!") + # (print "splat!") (set splat (last members)) (set members (slice members 0 (dec patt-len)))) (when (and (not splat?) (not= val-size patt-len)) - (print "mismatched dict lengths") + # (print "mismatched dict lengths") (break {:success false :miss [pattern value]})) (var success true) (def matched-keys @[]) @@ -171,8 +171,8 @@ (defn- match-pattern* [pattern value &opt ctx] - (print "in match-pattern, matching " value " with:") - (pp pattern) + # (print "in match-pattern, matching " value " with:") + # (pp pattern) (default ctx @{}) (def data (pattern :data)) (case (pattern :type) @@ -328,10 +328,10 @@ (merge-into the-dict splatted)) (do (def [key-ast value-ast] (member :data)) - (print "dict key") - (pp key-ast) - (print "dict value") - (pp value-ast) + # (print "dict key") + # (pp key-ast) + # (print "dict value") + # (pp value-ast) (def key (interpret key-ast ctx)) (def value (interpret value-ast ctx)) (set (the-dict key) value)))) @@ -360,19 +360,19 @@ # For now, this should be enough to tall the thing (defn- fnn [ast ctx] (def {:name name :data clauses :doc doc} ast) - (print "defining fn " name) + # (print "defining fn " name) (def closure (table/to-struct 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") + # (print "fn "name" was forward declared") (def fwd (resolve-name name ctx)) (set (fwd :body) clauses) (set (fwd :ctx) closure) (set (fwd :doc) doc) - (print "fn " name " has been defined") - (pp fwd) + # (print "fn " name " has been defined") + # (pp fwd) (break fwd)) - (pp the-fn) + # (pp the-fn) (set (ctx name) the-fn) the-fn) @@ -384,27 +384,27 @@ (eval ~(fn ,(symbol name) [] :foo)) (defn- partial [the-fn partial-args] - (print "calling partially applied function") + # (print "calling partially applied function") (def args (partial-args :args)) - (pp args) + # (pp args) (def pos (find-index is_placeholder args)) (def name (string (the-fn :name) " *partial*")) (defn partial-fn [missing] - (print "calling function with arg " (b/show missing)) - (pp partial-args) + # (print "calling function with arg " (b/show missing)) + # (pp partial-args) (def full-args (array/slice args)) (set (full-args pos) missing) - (print "all args: " (b/show full-args)) + # (print "all args: " (b/show full-args)) (call-fn the-fn [;full-args])) {:^type :applied :name name :body partial-fn}) (defn- call-fn* [the-fn args] - (print "calling " (b/show the-fn)) - (print "with args " (b/show args)) + # (print "calling " (b/show the-fn)) + # (print "with args " (b/show args)) (when (or (= :function (type the-fn)) (= :cfunction (type the-fn))) - (print "Janet function") + # (print "Janet function") (break (the-fn ;args))) (def clauses (the-fn :body)) (when (= :nothing clauses) @@ -420,11 +420,11 @@ (match-pattern patt args @{:^parent (the-fn :ctx)})) (when (not (match? :success)) (break (match-fn (inc i) args))) - (print "matched!") + # (print "matched!") (def body-ctx (match? :ctx)) (def guard? (if guard (b/bool (interpret guard body-ctx)) true)) - (print "passed guard") + # (print "passed guard") (when (not guard?) (break (match-fn (inc i) args))) (interpret expr body-ctx)) @@ -436,11 +436,11 @@ (defn- call-partial [the-fn arg] ((the-fn :body) ;arg)) (defn- apply-synth-term [prev curr] - (print "applying " (b/show prev)) - (print "to" (b/show curr)) + # (print "applying " (b/show prev)) + # (print "to" (b/show curr)) (def types [(b/ludus/type prev) (b/ludus/type curr)]) - (print "typle:") - (pp types) + # (print "typle:") + # (pp types) (match types [:fn :tuple] (call-fn prev curr) [:fn :partial] (partial prev curr) @@ -454,19 +454,19 @@ (defn- synthetic [ast ctx] (def terms (ast :data)) - (print "interpreting synthetic") - (pp ast) - (pp terms) + # (print "interpreting synthetic") + # (pp ast) + # (pp terms) (def first-term (first terms)) (def last-term (last terms)) (var prev (interpret first-term ctx)) - (print "root term: ") - (pp prev) + # (print "root term: ") + # (pp prev) (for i 1 (-> terms length dec) (def curr (interpret (terms i) ctx)) - (print "term " i ": " curr) + # (print "term " i ": " curr) (set prev (apply-synth-term prev curr))) - (print "done with inner terms, applying last term") + # (print "done with inner terms, applying last term") (apply-synth-term prev (interpret last-term ctx))) (defn- doo [ast ctx] @@ -487,13 +487,13 @@ (def key (interpret key-ast ctx)) (def value (interpret value-ast ctx)) (set (the-pkg key) value)) - (pp the-pkg) + # (pp the-pkg) (def out (table/to-struct the-pkg)) (set (ctx (ast :name)) out) out) (defn- loopp [ast ctx] - (print "looping!") + # (print "looping!") (def data (ast :data)) (def args (interpret (data 0) ctx)) (when (ast :match) (break ((ast :match) 0 args))) @@ -501,8 +501,8 @@ (def len (length clauses)) (def loop-ctx @{:^parent ctx}) (defn match-fn [i args] - (print "calling inner loop fn") - (print "for the " i "th time") + # (print "calling inner loop fn") + # (print "for the " i "th time") (when (= len i) (error {:node ast :value args :msg "no match"})) (def clause (clauses i)) @@ -510,30 +510,30 @@ (def match? (match-pattern patt args loop-ctx)) (when (not (match? :success)) - (print "no match") + # (print "no match") (break (match-fn (inc i) args))) - (print "matched!") + # (print "matched!") (def body-ctx (match? :ctx)) (def guard? (if guard (b/bool (interpret guard body-ctx)) true)) - (print "passed guard") + # (print "passed guard") (when (not guard?) (break (match-fn (inc i) args))) (interpret expr body-ctx)) (set (ast :match) match-fn) (set (loop-ctx :^recur) match-fn) - (print "ATTACHED MATCH-FN") + # (print "ATTACHED MATCH-FN") (match-fn 0 args)) (defn- recur [ast ctx] - (print "recurring!") + # (print "recurring!") (def passed (ast :data)) (def args (interpret passed ctx)) (def match-fn (resolve-name :^recur ctx)) - (print "match fn in ctx:") - (pp (ctx :^recur)) - (pp match-fn) - (pp ctx) + # (print "match fn in ctx:") + # (pp (ctx :^recur)) + # (pp match-fn) + # (pp ctx) (match-fn 0 args)) # TODO for 0.1.0 @@ -548,7 +548,7 @@ (defn- usee [ast ctx] (todo "use")) (defn- interpret* [ast ctx] - (print "interpreting node " (ast :type)) + # (print "interpreting node " (ast :type)) (case (ast :type) # literals :nil :^nil @@ -625,12 +625,10 @@ (def validated (v/valid parsed b/ctx)) # (when (has-errors? validated) (break (validated :errors))) # (def cleaned (get-in parsed [:ast :data 1])) - # (pp cleaned) + # # (pp cleaned) # (interpret (parsed :ast) @{:^parent b/ctx}) (try (interpret (parsed :ast) @{:^parent b/ctx}) - ([e] (print "Ludus panicked!: " - (if (struct? e) (error (e :msg)) (error e))))) - ) + ([e] (if (struct? e) (error (e :msg)) (error e))))) (do (set source ` diff --git a/janet/ludus.janet b/janet/ludus.janet new file mode 100644 index 0000000..2d1da13 --- /dev/null +++ b/janet/ludus.janet @@ -0,0 +1,40 @@ +# an integrated Ludus interpreter +(try (os/cd "janet") ([_] nil)) # for REPL +(import ./scanner :as s) +(import ./parser :as p) +(import ./validate :as v) +(import ./interpreter :as i) + +# (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 b/ctx)) +# # (when (has-errors? validated) (break (validated :errors))) +# # (def cleaned (get-in parsed [:ast :data 1])) +# # # (pp cleaned) +# # (interpret (parsed :ast) @{:^parent b/ctx}) +# (try (interpret (parsed :ast) @{:^parent b/ctx}) +# ([e] (if (struct? e) (error (e :msg)) (error e))))) + +(defn main [source] + (def scanned (s/scan source)) + (when (any? (scanned :errors)) + (break (scanned :errors))) + (def parsed (p/parse scanned)) + (when (any? (parsed :errors)) + (break (parsed :errors))) + (def validated (v/valid parsed)) + (when (any? (validated :errors)) + (break (validated :errors))) + (try + (i/interpret (parsed :ast) @{}) + ([e] (if (struct? e) (error (e :msg)) (error e))))) + +(def source ` + fn foo () -> :foo + fool () +`) + +(main source) diff --git a/janet/parser.janet b/janet/parser.janet index 50ff491..ec8aa01 100644 --- a/janet/parser.janet +++ b/janet/parser.janet @@ -1,7 +1,7 @@ ### A recursive descent parser for Ludus ### We still need to scan some things -(try (os/cd "janet") ([_] nil)) # when in repl to do relative imports +# (try (os/cd "janet") ([_] nil)) # when in repl to do relative imports (import ./scanner :as s) (defmacro declare @@ -88,7 +88,7 @@ (defn- panic "Panics the parser: starts skipping tokens until a breaking token is encountered. Adds the error to the parser's errors array, and also errors out." [parser message] - (print "Panic in the parser: " message) +# (print "Panic in the parser: " message) (def origin (current parser)) (advance parser) (def skipped @[origin]) @@ -183,13 +183,13 @@ # interpolated strings, which are a whole other scene (defn- scan-interpolations [data] - (print "scanning interpolation: " data) +# (print "scanning interpolation: " data) (when (buffer? data) (break data)) - (pp data) + # (pp data) (def to-scan (data :to-scan)) (def {:tokens tokens :errors errors} (s/scan to-scan)) - (pp tokens) - (print "there are " (length tokens) " tokens") + # (pp tokens) +# (print "there are " (length tokens) " tokens") (def first-token (first tokens)) (cond (first errors) (first errors) @@ -301,12 +301,12 @@ (capture nonbinding parser))) (array/push (ast :data) term) (try (separators parser) - ([e] (pp e) (array/push (ast :data) e)))) + ([e] (array/push (ast :data) e)))) (advance parser) ast) (defn- synth-root [parser] - (print "parsing synth root") +# (print "parsing synth root") (def origin (current parser)) (advance parser) (case (type origin) @@ -318,7 +318,7 @@ ) (defrec synthetic [parser] - (print "parsing synthetic") +# (print "parsing synthetic") (def origin (current parser)) # (def ast {:type :synthetic :data @[(synth-root parser)] :token origin}) (def terms @[(synth-root parser)]) @@ -347,7 +347,7 @@ (def term (capture nonbinding parser)) (array/push (ast :data) term) (try (separators parser) - ([e] (pp e) (array/push (ast :data) e)))) + ([e] (array/push (ast :data) e)))) (advance parser) ast) @@ -468,7 +468,7 @@ (capture pattern parser))) (array/push (ast :data) term) (try (separators parser) - ([e] (pp e) (array/push (ast :data) e)))) + ([e] (array/push (ast :data) e)))) (advance parser) ast) @@ -711,20 +711,20 @@ ### function forms (defn- fn-simple [parser] - (print "parsing simple function body") +# (print "parsing simple function body") (try (do (def lhs (tup-pattern parser)) - (print "parsed lhs") +# (print "parsed lhs") (def guard (when (check parser :if) (advance parser) (simple parser))) - (print "parsed guard") +# (print "parsed guard") (expect parser :arrow) (advance parser) - (print "parsed arrow") +# (print "parsed arrow") (accept-many parser :newline) (def rhs (nonbinding parser)) - (print "parsed rhs") +# (print "parsed rhs") {:clauses [[lhs guard rhs]]} ) ([err] err) @@ -753,7 +753,7 @@ ) (defn- fn-clauses [parser] - (print "parsing fn clauses") +# (print "parsing fn clauses") (def origin (current parser)) (expect parser :lbrace) (advance parser) (accept-many parser ;terminators) @@ -779,15 +779,15 @@ (if (= :lparen (-> parser peek type)) (break (lambda parser))) (try (do - (print "parsing named function") +# (print "parsing named function") (def origin (current parser)) (expect parser :fn) (advance parser) - (print "consumed `fn`") - (print "next token: ") - (pp (current parser)) +# (print "consumed `fn`") +# (print "next token: ") + # (pp (current parser)) (def name (-> parser word-only (get :data))) - (print "function name: ") - (pp name) +# (print "function name: ") + # (pp name) (def {:clauses data :doc doc} (case (-> parser current type) :lbrace (fn-clauses parser) :lparen (fn-simple parser) @@ -819,8 +819,8 @@ (expect parser :do) (advance parser) (def data @[]) (array/push data (capture simple parser)) - (print "added first expression. current token:") - (pp (current parser)) +# (print "added first expression. current token:") + # (pp (current parser)) (while (check parser :pipeline) (advance parser) (accept-many parser :newline) @@ -1114,37 +1114,12 @@ (set (parser :ast) ast) parser) -(defn- indent-by [n] - (def indentation @"") - (repeat n (buffer/push indentation "..")) - indentation) - -(defn- pp-ast [ast &opt indent] - (default indent 0) - (def {:type t :name n :data d :msg m} ast) - (string (indent-by indent) t ": " n m - (if (indexed? d) - (string "\n" (string/join (map (fn [a] (pp-ast a (inc indent))) d))) - d - ) - "\n" - ) -) - - -(do -# (comment +# (do +(comment (def source `pkg Foo {} `) (def scanned (s/scan source)) -(print "\n***NEW PARSE***\n") +# (print "\n***NEW PARSE***\n") (def a-parser (new-parser scanned)) (def parsed (pkg a-parser)) ) - - -# FIXME: - -# TODO: -# DECIDE: -# - when to use a flat try/catch format, and when to use capture/expect-ret to get values instead of errors diff --git a/janet/scanner.janet b/janet/scanner.janet index a324fbf..3cfcd6a 100644 --- a/janet/scanner.janet +++ b/janet/scanner.janet @@ -341,9 +341,9 @@ (recur (-> scanner (scan-token) (next-token))))) (recur (new-scanner source input))) -(def source ` -a :b "c" -& thing -`) +# (def source ` +# a :b "c" +# & thing +# `) -(pp ((scan source) :tokens)) +# (pp ((scan source) :tokens)) diff --git a/janet/validate.janet b/janet/validate.janet index a157cd0..d6c8e6f 100644 --- a/janet/validate.janet +++ b/janet/validate.janet @@ -27,7 +27,7 @@ Deferred until a later iteration of Ludus: (def- package-registry @{}) -(try (os/cd "janet") ([_] nil)) +# (try (os/cd "janet") ([_] nil)) (import ./scanner :as s) (import ./parser :as p) @@ -159,7 +159,7 @@ Deferred until a later iteration of Ludus: {:node ast :msg (string "name is already bound on line " line " of " input)})) (set (ctx name) ast) - (pp ctx) + # (pp ctx) validator) (def types [ @@ -219,10 +219,10 @@ Deferred until a later iteration of Ludus: (pattern validator)) (defn- pattern* [validator] - (print "PATTERN*") + # (print "PATTERN*") (def ast (validator :ast)) (def type (ast :type)) - (print "validating pattern " type) + # (print "validating pattern " type) (cond (has-value? terminals type) validator (case type @@ -246,7 +246,7 @@ Deferred until a later iteration of Ludus: (defn- guard [validator]) (defn- match-clauses [validator clauses] - (print "validating clauses in match-clauses") + # (print "validating clauses in match-clauses") (each clause clauses (def parent (validator :ctx)) (def ctx @{:^parent parent}) @@ -254,8 +254,8 @@ Deferred until a later iteration of Ludus: (def [lhs guard rhs] clause) (set (validator :ast) lhs) (pattern validator) - (pp (validator :ctx)) - (pp (validator :ctx)) + # (pp (validator :ctx)) + # (pp (validator :ctx)) (when guard (set (validator :ast) guard) (validate validator)) @@ -264,14 +264,14 @@ Deferred until a later iteration of Ludus: (set (validator :ctx) parent))) (defn- matchh [validator] - (print "validating in matchh") + # (print "validating in matchh") (def ast (validator :ast)) (def [to-match clauses] (ast :data)) - (print "validating expression:") - (pp to-match) + # (print "validating expression:") + # (pp to-match) (set (validator :ast) to-match) (validate validator) - (print "validating clauses") + # (print "validating clauses") (match-clauses validator clauses) validator) @@ -280,8 +280,8 @@ Deferred until a later iteration of Ludus: (def declared (get status :declared @{})) (set (declared fnn) true) (set (status :declared) declared) - (print "declared function " (fnn :name)) - (pp declared) + # (print "declared function " (fnn :name)) + # (pp declared) validator) (defn- define [validator fnn] @@ -289,14 +289,14 @@ Deferred until a later iteration of Ludus: (def declared (get status :declared @{})) (set (declared fnn) nil) (set (status :declared) declared) - (print "defined function " (fnn :name)) - (pp declared) + # (print "defined function " (fnn :name)) + # (pp declared) validator) (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) @@ -318,17 +318,17 @@ Deferred until a later iteration of Ludus: (def rest-arities @{}) (def arities @{:rest rest-arities}) (each clause data - (print "CLAUSE:") - (pp clause) + # (print "CLAUSE:") + # (pp clause) (def patt (first clause)) (def params (patt :data)) (def arity (length params)) - (print "checking clause with arity " arity) + # (print "checking clause with arity " arity) (def rest-param? (and (> arity 0) (= :splat ((last params) :type)))) (if rest-param? (set (rest-arities arity) true) (set (arities arity) true))) - (pp arities) + # (pp arities) (set (ast :arities) arities) validator) @@ -359,7 +359,7 @@ Deferred until a later iteration of Ludus: # * [ ] ensure properties are on pkgs (if *only* pkgs from root) (defn- pkg-root [validator] - (print "validating pkg-root access") + # (print "validating pkg-root access") (def ast (validator :ast)) (def ctx (validator :ctx)) (def terms (ast :data)) @@ -378,7 +378,7 @@ Deferred until a later iteration of Ludus: {:node member :msg "cannot call a pkg"} (break validator))))) (when (not accessed) - (print "no member " (member :data) " on " pkg-name) + # (print "no member " (member :data) " on " pkg-name) (array/push (validator :errors) {:node member :msg "invalid pkg access"}) (break validator)) @@ -395,38 +395,38 @@ Deferred until a later iteration of Ludus: # (set (args :tail-call) true)) (defn- check-arity [validator] - (print "CHECKING ARITY") + # (print "CHECKING ARITY") (def ast (validator :ast)) # (when (ast :partial) (break validator)) (def ctx (validator :ctx)) (def data (ast :data)) (def fn-word (first data)) - (pp fn-word) + # (pp fn-word) (def the-fn (resolve-name ctx (fn-word :data))) - (print "the called function: " the-fn) - (pp the-fn) + # (print "the called function: " the-fn) + # (pp the-fn) (when (not the-fn) (break validator)) - (print "the function is not nil") - (print "the function type is " (type the-fn)) + # (print "the function is not nil") + # (print "the function type is " (type the-fn)) (when (= :function (type the-fn)) (break validator)) (when (= :cfunction (type the-fn)) (break validator)) - (print "the function is not a janet fn") - (print "fn type: " (the-fn :type)) + # (print "the function is not a janet fn") + # (print "fn type: " (the-fn :type)) (when (not= :fn (the-fn :type)) (break validator)) - (print "fn name: " (the-fn :name)) + # (print "fn name: " (the-fn :name)) (def arities (the-fn :arities)) # when there aren't arities yet, break, since that means we're making a recursive function call # TODO: enahnce this so that we can determine arities *before* all function bodies; this ensures arity-checking for self-recursive calls (when (not arities) (break validator)) - (print "arities: ") - (pp arities) + # (print "arities: ") + # (pp arities) (def args (get data 1)) (def num-args (length (args :data))) - (print "called with #args " num-args) - (pp (get (validator :ctx) "bar")) + # (print "called with #args " num-args) + # (pp (get (validator :ctx) "bar")) (when (has-key? arities num-args) (break validator)) - (print "arities: ") - (pp arities) + # (print "arities: ") + # (pp arities) (when (not arities) (break validator)) (def rest-arities (keys (arities :rest))) (when (empty? rest-arities) @@ -464,9 +464,9 @@ Deferred until a later iteration of Ludus: (set (validator :ast) node) (validate validator)) (set (validator :ast) ast) - (print "ftype " ftype) - (print "stype " stype) - (print "ltype " ltype) + # (print "ftype " ftype) + # (print "stype " stype) + # (print "ltype " ltype) (when (= ftype :pkg-name) (pkg-root validator)) (when (= ftype :keyword) (kw-root validator)) # (when (= ltype :args) (tail-call validator)) @@ -544,9 +544,9 @@ Deferred until a later iteration of Ludus: (set (status :pkg-access?) true)) (def data (ast :data)) (def [key value] (ast :data)) - (print "PKG ENTRY***") - (pp key) - (pp value) + # (print "PKG ENTRY***") + # (pp key) + # (pp value) (set (validator :ast) key) (validate validator) (set (validator :ast) value) @@ -554,13 +554,13 @@ Deferred until a later iteration of Ludus: (def entry (if (= :pkg-name (value :type)) (resolve-name (validator :ctx) (string (value :data))) value)) - (print "entry at " (key :data)) - (pp entry) + # (print "entry at " (key :data)) + # (pp entry) (set (status :pkg-access?) nil) (def kw (key :data)) - (pp kw) + # (pp kw) (set (pkg kw) entry) - (pp pkg) + # (pp pkg) validator) (defn- pkg [validator] @@ -572,8 +572,8 @@ Deferred until a later iteration of Ludus: (set (validator :ast) node) (pkg-entry validator pkg)) (set (ast :pkg) pkg) - (print "THE PACKAGE") - (pp pkg) + # (print "THE PACKAGE") + # (pp pkg) (def ctx (validator :ctx)) (set (ctx name) ast) validator) @@ -597,23 +597,23 @@ Deferred until a later iteration of Ludus: (def status (validator :status)) (def data (ast :data)) (def input (first data)) - (print "LOOP INPUT") - (pp input) + # (print "LOOP INPUT") + # (pp input) (def clauses (get data 1)) (def input-arity (length (input :data))) (set (ast :arity) input-arity) - (print "input arity to loop " input-arity) + # (print "input arity to loop " input-arity) (set (validator :ast) input) (validate validator) # harmonize arities (def rest-arities @{}) (each clause clauses - (print "CLAUSE:") - (pp clause) + # (print "CLAUSE:") + # (pp clause) (def patt (first clause)) (def params (patt :data)) (def clause-arity (length params)) - (print "checking clause with arity " clause-arity) + # (print "checking clause with arity " clause-arity) (def rest-param? (= :splat (get (last params) :type))) (when (and (not rest-param?) (not= clause-arity input-arity)) @@ -621,7 +621,7 @@ Deferred until a later iteration of Ludus: {:node patt :msg "arity mismatch"})) (when rest-param? (set (rest-arities clause-arity) patt))) - (pp rest-arities) + # (pp rest-arities) (loop [[arity patt] :pairs rest-arities] (when (< input-arity arity) (array/push (validator :errors) @@ -645,8 +645,8 @@ Deferred until a later iteration of Ludus: (break validator)) (def called-with (get-in ast [:data :data])) (def recur-arity (length called-with)) - (print "loop arity " loop-arity) - (print "recur arity" recur-arity) + # (print "loop arity " loop-arity) + # (print "recur arity" recur-arity) (when (not= recur-arity loop-arity) (array/push (validator :errors) {:node ast :msg "recur must have the same number of args as its loop"})) @@ -687,17 +687,17 @@ Deferred until a later iteration of Ludus: validator) (defn- pkg-kw [validator] - (print "validating pkg-kw") + # (print "validating pkg-kw") (def ast (validator :ast)) (def pkg-access? (get-in validator [:status :pkg-access?])) - (print "pkg-access? " pkg-access?) + # (print "pkg-access? " pkg-access?) (when (not pkg-access?) (array/push (validator :errors) {:node ast :msg "cannot use pkg-kw here"})) validator) (defn- pkg-pair [validator] - (print "validating pkg-pair") + # (print "validating pkg-pair") (def ast (validator :ast)) (def status (validator :status)) (def [_ pkg] (ast :data)) @@ -715,7 +715,7 @@ Deferred until a later iteration of Ludus: (defn- validate* [validator] (def ast (validator :ast)) (def type (ast :type)) - (print "validating node " type) + # (print "validating node " type) (cond (has-value? terminals type) validator (has-value? simple-colls type) (simple-coll validator)