twc/ludus
4
0
Fork 0
Code Issues 32 Pull Requests Packages Projects 8 Releases Wiki Activity

cljfmt

Browse Source
This commit is contained in:
Scott Richmond 2022-05-27 19:18:00 -04:00
parent 874dacf791
commit 173f5756a7
9 changed files with 338 additions and 376 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
src/ludus/interpreter.clj
View File

@ -87,10 +87,8 @@
(let [match? (match (kw members) (kw value) ctx-vol)]
(if (:success match?)
(recur (dec i) (merge ctx (:ctx match?)))
{:success false :reason (str "Could not match " pattern " with " value " at key " kw)}
))
{:success false :reason (str "Could not match " pattern " with " value " at key " kw)}
)))))))
{:success false :reason (str "Could not match " pattern " with " value " at key " kw)}))
{:success false :reason (str "Could not match " pattern " with " value " at key " kw)})))))))
(defn- match-struct [pattern value ctx-vol]
(cond
@ -111,10 +109,8 @@
(let [match? (match (kw members) (kw value) ctx-vol)]
(if (:success match?)
(recur (dec i) (merge ctx (:ctx match?)))
{:success false :reason (str "Could not match " pattern " with " value " at key " kw)}
))
{:success false :reason (str "Could not match " pattern " with " value " at key " kw)}
)))))))
{:success false :reason (str "Could not match " pattern " with " value " at key " kw)}))
{:success false :reason (str "Could not match " pattern " with " value " at key " kw)})))))))
(defn- match [pattern value ctx-vol]
(let [ctx @ctx-vol]
@ -200,11 +196,7 @@
truthy? (boolean (interpret-ast test-expr ctx))]
(if truthy?
(interpret-ast body ctx)
(recur (first clauses) (rest clauses))
)
)
)
)))
(recur (first clauses) (rest clauses))))))))
(defn- interpret-called-kw [kw tuple ctx]
;; TODO: check this statically
@ -218,8 +210,7 @@
(if (= (::data/type map) ::data/ns)
(throw (ex-info (str "Namespace error: no member " kw " in ns " (::data/name map)) {:ast kw}))
(throw (ex-info (str "Struct error: no member at " kw) {:ast kw}))))
(get map kw))
)))
(get map kw)))))
(defn- call-fn [lfn tuple ctx]
(cond
@ -262,9 +253,8 @@
(kw target)
(if (= (::data/type target) ::data/ns)
(throw (ex-info (str "Namespace error: no member " kw " in ns" (::data/name target)) {:ast kw}))
(throw (ex-info (str "Struct error: no member at " kw) {:ast kw}))
)
)
(throw (ex-info (str "Struct error: no member at " kw) {:ast kw}))))
(kw target)))
(throw (ex-info "Called keywords take a single argument" {:ast lfn})))
@ -383,10 +373,7 @@
(throw (ex-info (str "Match Error: No match found in loop for " input) {:ast ast}))))]
(if (::data/recur output)
(recur (:tuple output))
output
))
))
)
output)))))
(defn- panic [ast ctx]
(throw (ex-info (show/show (interpret-ast (:expr ast) ctx)) {:ast ast})))
@ -436,9 +423,7 @@
(defn- interpret-dict [ast ctx]
(let [members (:members ast)]
(assoc (reduce (dict-term ctx) {} members) ::data/dict true)
)
)
(assoc (reduce (dict-term ctx) {} members) ::data/dict true)))
(defn interpret-ast [ast ctx]
(case (::ast/type ast)

29
src/ludus/parser.clj
View File

@ -659,8 +659,7 @@
success (:success assignment)]
(if success
(parse-ref-expr (:parser assignment) name)
(panic parser "Expected assignment")))
)
(panic parser "Expected assignment"))))
(defn- parse-ref [parser]
(let [name (advance parser)]
@ -794,8 +793,7 @@
:clauses [(::ast clause)]}))))
(panic parser "Expected with after loop expression")))
(panic parser "Expected tuple as loop expression")
)))
(panic parser "Expected tuple as loop expression"))))
(defn- parse-recur [parser]
(let [next (advance parser)]
@ -803,12 +801,8 @@
(let [tuple (parse-tuple next)]
(assoc tuple ::ast {::ast/type ::ast/recur
:token (current parser)
:tuple (::ast tuple)})
)
(panic parser "Expected tuple after recur")
)
)
)
:tuple (::ast tuple)}))
(panic parser "Expected tuple after recur"))))
(defn- parse-cond-clause [parser]
(let [expr (if
@ -837,7 +831,6 @@
(assoc (advance parser) ::ast {::ast/type ::ast/clauses :token (current parser) :clauses clauses})
(panic parser "Expected one or more clauses" #{::rbrace}))
::token/newline
(recur (accept-many #{::token/newline} parser) clauses)
@ -851,12 +844,8 @@
(let [clauses (parse-cond-clauses (:parser header))]
(assoc clauses ::ast {::ast/type ::ast/cond
:token (current parser)
:clauses (get-in clauses [::ast :clauses])})
)
(panic parser "Expected { after cond")
)
)
)
:clauses (get-in clauses [::ast :clauses])}))
(panic parser "Expected { after cond"))))
(defn- parse-fn-clause [parser]
(if (not (= ::token/lparen (token-type parser)))
@ -930,8 +919,7 @@
(recur (advance expr+newline) (conj exprs (::ast expr)))
(assoc expr ::ast {::ast/type ::ast/pipeline
:token (current parser)
:exprs (conj exprs (::ast expr))})
)))))
:exprs (conj exprs (::ast expr))}))))))
(defn- parse-import [parser]
(let [path (parse-atom (advance parser))
@ -941,8 +929,7 @@
nil)
name (if (:success named?)
(parse-word (:parser as))
nil
)]
nil)]
(cond
(not= ::token/string (token-type (advance parser)))
(panic parser "Expected path after import" #{::token/newline})

9
src/ludus/prelude.clj
View File

@ -62,16 +62,14 @@
:body (fn [ref]
(if (::data/ref ref)
(deref (::data/value ref))
(throw (ex-info "Cannot deref something that is not a ref" {}))
))})
(throw (ex-info "Cannot deref something that is not a ref" {}))))})
(def set!- {:name "set!"
::data/type ::data/clj
:body (fn [ref value]
(if (::data/ref ref)
(reset! (::data/value ref) value)
(throw (ex-info "Cannot set! something that is not a ref" {}))
))})
(throw (ex-info "Cannot set! something that is not a ref" {}))))})
(def show {:name "show"
::data/type ::data/clj
@ -91,5 +89,4 @@
"deref" deref-
"set!" set!-
"and" and-
"or" or-
})
"or" or-})

13
src/ludus/repl.clj
View File

@ -18,8 +18,7 @@
(def base-ctx (merge prelude/prelude
{::repl true
"repl"
{
::data/struct true
{::data/struct true
::data/type ::data/ns
::data/name "repl"
@ -39,8 +38,8 @@
(reset! current-session session)
:ok))}
:swap
{:name "swap"
:switch
{:name "switch"
::data/type ::data/clj
:body (fn [name]
(if-let [session (get @sessions name)]
@ -49,12 +48,10 @@
:ok)
(do
(println "No session named" name)
:error)))}
}}))
:error)))}}}))
(defn- new-session [name]
(let [session (atom {
:name name
(let [session (atom {:name name
:ctx (volatile! base-ctx)
:history []})]
(swap! sessions #(assoc % name session))

6
src/ludus/scanner.clj
View File

@ -7,8 +7,7 @@
(def reserved-words
"List of Ludus reserved words."
;; see ludus-spec repo for more info
{
"as" ::token/as ;; impl for `import`; not yet for patterns
{"as" ::token/as ;; impl for `import`; not yet for patterns
"cond" ::token/cond ;; impl
"do" ::token/do ;; impl
"else" ::token/else ;; impl
@ -51,8 +50,7 @@
"wait" ::token/wait
;; vars
"mut" ::token/mut
"var" ::token/var
})
"var" ::token/var})
(defn- new-scanner
"Creates a new scanner."

6
src/ludus/show.clj
View File

@ -25,15 +25,13 @@
(str "@{" (apply str (into [] show-keyed (dissoc v ::data/struct))) "}")
(::data/ref v) ;; TODO: reconsider this
(str "ref:" (::data/name v) " <" (deref (::data/value v))">")
(str "ref:" (::data/name v) " <" (deref (::data/value v)) ">")
(::data/hashmap v)
(str "#{" (apply str (into [] show-keyed (dissoc v ::data/hashmap))) "}")
:else
(pp/pprint v)
))
(pp/pprint v)))
(defn- show-set [v]
(str "${" (apply str (into [] show-linear v)) "}"))