Wire up CLI.

This commit is contained in:
Scott Richmond 2022-04-03 20:48:22 -04:00
parent 12487b390e
commit e0161372e3
5 changed files with 62 additions and 53 deletions

1
foo.ld Normal file
View File

@ -0,0 +1 @@
print ("foo, bar, and baz")

View File

@ -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)))
(println "Usage: ludus [script]") :else (do
(System/exit 64)) (println "Usage: ludus [script]")
(= (count args) 1) (run-file (first args)) (System/exit 64))))
:else (run-prompt)))

View File

@ -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 "

View File

@ -604,7 +604,7 @@
(parser) (parser)
(parse-script))) (parse-script)))
(do (comment
(def pp pp/pprint) (def pp pp/pprint)
(def source " (def source "

View File

@ -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)))