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