diff --git a/foo.ld b/foo.ld new file mode 100644 index 0000000..0273a1b --- /dev/null +++ b/foo.ld @@ -0,0 +1 @@ +print ("foo, bar, and baz") \ No newline at end of file diff --git a/src/ludus/core.clj b/src/ludus/core.clj index e8ef191..f110698 100644 --- a/src/ludus/core.clj +++ b/src/ludus/core.clj @@ -1,33 +1,33 @@ (ns ludus.core "A tree-walk interpreter for the Ludus language." (:require - [ludus.scanner :as scanner])) - -(defn- report [line, where, message] - (println (str "[line " line "] Error" where ": " message))) - -(defn- error [line, message] - (report line "" message)) + [ludus.scanner :as scanner] + [ludus.parser :as parser] + [ludus.interpreter :as interpreter] + [clojure.pprint :as pp])) (defn- run [source] - (let [tokens (scanner/scan source)] - (run! println tokens))) - -(defn- run-file [path] - (let [source (slurp path)] - (run source))) - -(defn- run-prompt [] - (loop [_ ""] - (print "Ludus >> ") - (flush) - (when-let [line (read-line)] - (recur (run line))))) + (let [scanned (scanner/scan source)] + (if (not-empty (:errors scanned)) + (do + (println "I found some scanning errors!") + (pp/pprint (:errors scanned)) + (System/exit 65)) + (let [parsed (parser/parse scanned)] + (if (not-empty (:errors parsed)) + (do + (println "I found some parsing errors!") + (pp/pprint (:errors parsed)) + (System/exit 66)) + (let [interpreted (interpreter/interpret parsed)] + (println " *** *** ***") + (println "I ran your script; here's the output: ") + (pp/pprint interpreted) + (System/exit 0))))))) (defn -main [& args] (cond - (> (count args) 1) (do - (println "Usage: ludus [script]") - (System/exit 64)) - (= (count args) 1) (run-file (first args)) - :else (run-prompt))) \ No newline at end of file + (= (count args) 1) (run (slurp (first args))) + :else (do + (println "Usage: ludus [script]") + (System/exit 64)))) \ No newline at end of file diff --git a/src/ludus/interpreter.clj b/src/ludus/interpreter.clj index bffcaa5..05a5b0a 100644 --- a/src/ludus/interpreter.clj +++ b/src/ludus/interpreter.clj @@ -19,7 +19,7 @@ (recur word (::parent ctx)) (throw (ex-info (str "Unbound name: " word) {})))))) -(declare interpret match) +(declare interpret-ast match) (defn- match-tuple [pattern value ctx-atom] (cond @@ -72,7 +72,7 @@ (defn- interpret-let [ast ctx] (let [pattern (:pattern ast) expr (:expr ast) - value (interpret expr ctx) + value (interpret-ast expr ctx) match (match pattern value ctx) success (:success match)] (if success @@ -84,14 +84,14 @@ (let [if-expr (:if ast) then-expr (:then ast) else-expr (:else ast) - if-value (interpret if-expr ctx)] + if-value (interpret-ast if-expr ctx)] (if if-value - (interpret then-expr ctx) - (interpret else-expr ctx)))) + (interpret-ast then-expr ctx) + (interpret-ast else-expr ctx)))) (defn- interpret-match [ast ctx] (let [match-expr (:expr ast) - expr (interpret match-expr ctx) + expr (interpret-ast match-expr ctx) clauses (:clauses ast)] (loop [clause (first clauses) clauses (rest clauses)] @@ -105,7 +105,7 @@ (if success (do (swap! new-ctx #(merge % clause-ctx)) - (interpret body new-ctx)) + (interpret-ast body new-ctx)) (recur (first clauses) (rest clauses)))) (throw (ex-info "Match Error: No match found" {})))))) @@ -113,8 +113,8 @@ ;; TODO: check this statically (if (not (= 1 (:length tuple))) (throw (ex-info "Called keywords must be unary" {})) - (let [kw (interpret kw ctx) - map (second (interpret tuple ctx))] + (let [kw (interpret-ast kw ctx) + map (second (interpret-ast tuple ctx))] (if (::data/struct map) (if (contains? map kw) (kw map) @@ -123,7 +123,7 @@ ))) (defn- call-fn [fn tuple ctx] - (let [passed (interpret tuple ctx)] + (let [passed (interpret-ast tuple ctx)] (case (::data/type fn) ::data/clj (apply (:body fn) (next passed)) @@ -141,7 +141,7 @@ (if success (do (swap! new-ctx #(merge % clause-ctx)) - (interpret body new-ctx)) + (interpret-ast body new-ctx)) (recur (first clauses) (rest clauses)))) (throw (ex-info "Match Error: No match found" {:fn-name (:name fn)}))))) @@ -166,7 +166,8 @@ (if (::data/struct prev-value) (if (contains? prev-value (:value curr)) (get prev-value (:value curr)) - (throw (ex-info (str "Struct error: no member " (:value curr)) {})))) + (throw (ex-info (str "Struct error: no member " (:value curr)) {}))) + (get prev-value (:value curr))) (call-fn prev-value curr ctx)))) (defn- interpret-synthetic [ast ctx] @@ -177,7 +178,7 @@ first-term-type (::ast/type first) first-val (if (= first-term-type ::ast/atom) (interpret-called-kw first second ctx) - (interpret-synthetic-term (interpret first ctx) second ctx))] + (interpret-synthetic-term (interpret-ast first ctx) second ctx))] (reduce #(interpret-synthetic-term %1 %2 ctx) first-val rest))) (defn- interpret-fn [ast ctx] @@ -201,7 +202,7 @@ (let [[k v] kv] [k (f v)])))) -(defn interpret [ast ctx] +(defn interpret-ast [ast ctx] (case (::ast/type ast) ::ast/atom (:value ast) @@ -223,43 +224,46 @@ inner (pop exprs) last (peek exprs) ctx (atom {::parent ctx})] - (run! #(interpret % ctx) inner) - (interpret last ctx)) + (run! #(interpret-ast % ctx) inner) + (interpret-ast last ctx)) ::ast/script (let [exprs (:exprs ast) inner (pop exprs) last (peek exprs) ctx (atom prelude/prelude)] - (run! #(interpret % ctx) inner) - (interpret last ctx)) + (run! #(interpret-ast % ctx) inner) + (interpret-ast last ctx)) ;; note that, excepting tuples and structs, ;; runtime representations are bare ;; tuples are vectors with a special first member ::ast/tuple (let [members (:members ast)] - (into [::data/tuple] (map #(interpret % ctx)) members)) + (into [::data/tuple] (map #(interpret-ast % ctx)) members)) ::ast/list (let [members (:members ast)] - (into [] (map #(interpret % ctx)) members)) + (into [] (map #(interpret-ast % ctx)) members)) ::ast/set (let [members (:members ast)] - (into #{} (map #(interpret % ctx)) members)) + (into #{} (map #(interpret-ast % ctx)) members)) ::ast/hash (let [members (:members ast)] - (into {} (map-values #(interpret % ctx)) members)) + (into {} (map-values #(interpret-ast % ctx)) members)) ::ast/struct (let [members (:members ast)] - (into {::data/struct true} (map-values #(interpret % ctx)) members)) + (into {::data/struct true} (map-values #(interpret-ast % ctx)) members)) (throw (ex-info "Unknown AST node type" {:node ast})))) -(do +(defn interpret [parsed] + (interpret-ast (::parser/ast parsed) {})) + +(comment (def source " @@ -267,6 +271,11 @@ call (:foo, #{:foo 23}) + let my_map = #{:foo 42, :bar 23, :baz \"frobulate\"} + + my_map :foo + + ") (println "") @@ -277,8 +286,7 @@ (-> source (scanner/scan) (parser/parse) - (::parser/ast) - (interpret {}) + (interpret) (pp/pprint))) (comment " diff --git a/src/ludus/parser.clj b/src/ludus/parser.clj index d46ee94..e8e79be 100644 --- a/src/ludus/parser.clj +++ b/src/ludus/parser.clj @@ -604,7 +604,7 @@ (parser) (parse-script))) -(do +(comment (def pp pp/pprint) (def source " diff --git a/src/ludus/scanner.clj b/src/ludus/scanner.clj index bd8b391..35da997 100644 --- a/src/ludus/scanner.clj +++ b/src/ludus/scanner.clj @@ -312,7 +312,7 @@ :errors (::errors scanner)}) (recur (-> scanner (scan-token) (next-token)))))) -(do +(comment (def source "@{") (pp/pprint (scan source)))