Fix merge conflicts

This commit is contained in:
Scott Richmond 2023-06-02 16:10:40 -06:00
commit a23c779efa
17 changed files with 1802 additions and 564 deletions

49
TODO.xit Normal file
View File

@ -0,0 +1,49 @@
[x] Fix recursive definition problems in grammar.clj
TODOS for parser
[ ] Make parser errors pretty
[ ] Use synchronization to make parsing more robust
[ ] Decide on synchronization tokens: [then else ] ) } , ; \n]
TODOS from interpreter
[x] implement tuple splat patterns
[x] update match-list to use new AST representation
[x] fix length comparison when pattern includes splats
[x] update match-dict to use new AST representation
[x] update match-struct to use new AST representation
[ ] update interpret-receive to use new AST representation
[ ] Check interpret-fn-inner ctx for cycles/bugs
Re-add processes to the language
[ ] Write send as function
[ ] update interpret-spawn to use new AST representation
[ ] ---- Investigate weird timing issue in current send implementation
[ ] Investigate `with-bindings` and virtual threads
Finish interpreter
[ ] Wire up new interpreter to repl, script situation
[ ] Merge new interpreter
Write a compiler: desugaring
[~] `...` to `..._` in tuple & list patterns
[ ] placeholder partial application to anonymous lambda
[ ] word -> :[word] word in pairs (patterns & expressions)
Write a compiler: correctness
[ ] check for unbound names
[ ] check for re-binding names
[ ] check that recur is in tail position
[ ] check that recur is only called inside loop or fn forms
[ ] check ns accesses
[ ] prevent import cycles
[ ] splattern is last member in a pattern
[ ] -----List/Tuple
[ ] -----Dict/Struct/Set
Write a compiler: optimization
[ ] devise tail call optimization
Next steps
[ ] Get drawing working?
[ ] Add stack traces for panics

1
foo.ld Normal file
View File

@ -0,0 +1 @@
:foo

View File

@ -26,4 +26,54 @@ let baz = do 69 > default (12) > print (:baz, _)
let quux = do nil > default (12) > print (:quux, _) let quux = do nil > default (12) > print (:quux, _)
unwrap ((:err, "message")) & unwrap ((:err, "message"))
fn map {
(f) -> fn mapper (xs) -> map (f, xs)
(f, xs) -> {
let n = count (xs)
loop (0, []) with (i, ys) -> if eq (i, n)
then ys
else recur (inc (i), conj (ys, f (nth (i, xs))))
}
}
fn reduce {
(f) -> fn reducer {
(xs) -> reduce (f, xs)
(xs, init) -> reduce (f, xs, init)
}
(f, xs) -> {
let first_x = first (xs)
let more_xs = rest (xs)
reduce (f, more_xs, first_x)
}
(f, xs, init) -> {
let n = count (xs)
loop (0, init) with (i, acc) -> if eq (i, n)
then acc
else {
let curr = nth (i, xs)
let next = f (acc, curr)
recur (inc (i), next)
}
}
}
fn filter {
(f) -> fn filterer (xs) -> filter (f, xs)
(f, xs) -> {
let n = count (xs)
loop (0, []) with (i, ys) -> when {
eq (i, n) -> ys
f (nth (i, xs)) -> recur (inc (i), conj (ys, nth (i, xs)))
else -> recur (inc (i), ys)
}
}
}
let greater_than_two = gt (_, 2)
let xs = [1, 2, 3]
filter (greater_than_two ,xs)

35
src/ludus/compile.clj Normal file
View File

@ -0,0 +1,35 @@
(ns ludus.compile
(:require
[ludus.grammar :as g]
[ludus.parser-new :as p]
[ludus.scanner :as s]))
(def source
"1"
)
(def result (->> source s/scan :tokens (p/apply-parser g/script)))
(println result)
(comment "
What sorts of compiling and validation do we want to do? Be specific.
- check used names are bound (validation)
- check bound names are free (validation)
- check `recur` is only ever in `loop` (and in `fn` bodies?), in tail position (validation)
- separate function arities into different functions (optimization)
- desugar partially applied functions (?) (simplification)
- desugar keyword entry shorthand (?) (simplification)
- flag tail calls for optimization (optimization)
- direct tail calls
- through different expressions
- block
- if
- cond
- match
- let
- check ns access (validation)
- check constraints: only use specific fns (checked against a constraint-specific ctx) (validation)
")

View File

@ -2,7 +2,9 @@
"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] ;[ludus.parser :as parser]
[ludus.parser-new :as p]
[ludus.grammar :as g]
[ludus.interpreter :as interpreter] [ludus.interpreter :as interpreter]
[ludus.show :as show] [ludus.show :as show]
[clojure.pprint :as pp] [clojure.pprint :as pp]
@ -17,13 +19,13 @@
(println "I found some scanning errors!") (println "I found some scanning errors!")
(pp/pprint (:errors scanned)) (pp/pprint (:errors scanned))
(System/exit 65)) (System/exit 65))
(let [parsed (parser/parse scanned)] (let [parsed (p/apply-parser g/script (:tokens scanned))]
(if (not-empty (:errors parsed)) (if (p/fail? parsed)
(do (do
(println "I found some parsing errors!") (println "I found some parsing errors!")
(pp/pprint (:errors parsed)) (println (p/err-msg parsed))
(System/exit 66)) (System/exit 66))
(let [interpreted (interpreter/interpret parsed file)] (let [interpreted (interpreter/interpret source file parsed)]
(println (show/show interpreted)) (println (show/show interpreted))
(System/exit 0))))))) (System/exit 0)))))))

318
src/ludus/grammar.clj Normal file
View File

@ -0,0 +1,318 @@
(ns ludus.grammar
(:require [ludus.parser-new :refer :all]
[ludus.scanner :as scan]))
(declare expression pattern)
(defp separator choice [:comma :newline :break])
(defp separators quiet one+ separator)
(defp terminator choice [:newline :semicolon :break])
(defp terminators quiet one+ terminator)
(defp nls? quiet zero+ :newline)
(defp splat group order-1 [(quiet :splat) :word])
(defp patt-splat-able flat choice [:word :ignored :placeholder])
(defp splattern group order-1 [(quiet :splat) (maybe patt-splat-able)])
(defp literal flat choice [:nil :true :false :number :string])
(defp tuple-pattern-term flat choice [pattern splattern])
(defp tuple-pattern-entry weak-order [tuple-pattern-term separators])
(defp tuple-pattern group order-1 [(quiet :lparen)
(quiet (zero+ separator))
(zero+ tuple-pattern-entry)
(quiet :rparen)])
(defp list-pattern group order-1 [(quiet :lbracket)
(quiet (zero+ separator))
(zero+ tuple-pattern-entry)
(quiet :rbracket)])
(defp pair-pattern group weak-order [:keyword pattern])
(defp typed group weak-order [:word (quiet :as) :keyword])
(defp dict-pattern-term flat choice [pair-pattern typed :word splattern])
(defp dict-pattern-entry weak-order [dict-pattern-term separators])
(defp dict-pattern group order-1 [(quiet :startdict)
(quiet (zero+ separator))
(zero+ dict-pattern-entry)
(quiet :rbrace)
])
(defp struct-pattern group order-1 [(quiet :startstruct)
(quiet (zero+ separator))
(zero+ dict-pattern-entry)
(quiet :rbrace)
])
(defp guard order-0 [(quiet :if) expression])
(defp pattern flat choice [literal
:ignored
:placeholder
typed
:word
:keyword
:else
tuple-pattern
dict-pattern
struct-pattern
list-pattern])
(defp match-clause group weak-order [pattern (maybe guard) (quiet :rarrow) expression])
(defp match-entry weak-order [match-clause terminators])
(defp match-old group order-1 [(quiet :match) expression nls?
(quiet :with) (quiet :lbrace)
(quiet (zero+ terminator))
(one+ match-entry)
(quiet :rbrace)
])
(defp if-expr group order-1 [(quiet :if)
nls?
expression
nls?
(quiet :then)
expression
nls?
(quiet :else)
expression])
(defp cond-lhs flat choice [expression :placeholder :else])
(defp cond-clause group weak-order [cond-lhs (quiet :rarrow) expression])
(defp cond-entry weak-order [cond-clause terminators])
(defp cond-old group order-1 [(quiet :cond) (quiet :lbrace)
(quiet (zero+ terminator))
(one+ cond-entry)
(quiet :rbrace)])
(defp match group order-1 [expression nls?
(quiet :is) (quiet :lbrace)
(quiet (zero+ terminator))
(one+ match-entry)
(quiet :rbrace)])
(defp cond-expr group order-1 [(quiet :lbrace)
(quiet (zero+ terminator))
(one+ cond-entry)
(quiet :rbrace)])
(defp when-tail flat choice [match cond-expr])
(defp when-expr weak-order [(quiet :when) when-tail])
(defp let-expr group order-1 [(quiet :let)
pattern
(quiet :equals)
nls?
expression])
(defp tuple-entry weak-order [expression separators])
(defp tuple group order-1 [(quiet :lparen)
(quiet (zero+ separator))
(zero+ tuple-entry)
(quiet :rparen)])
(defp list-term flat choice [splat expression])
(defp list-entry order-1 [list-term separators])
(defp list-literal group order-1 [(quiet :lbracket)
(quiet (zero+ separator))
(zero+ list-entry)
(quiet :rbracket)])
(defp set-literal group order-1 [(quiet :startset)
(quiet (zero+ separator))
(zero+ list-entry)
(quiet :rbrace)])
(defp pair group order-0 [:keyword expression])
(defp struct-term flat choice [:word pair])
(defp struct-entry order-1 [struct-term separators])
(defp struct-literal group order-1 [(quiet :startstruct)
(quiet (zero+ separator))
(zero+ struct-entry)
(quiet :rbrace)])
(defp dict-term flat choice [splat :word pair])
(defp dict-entry order-1 [dict-term separators])
(defp dict group order-1 [(quiet :startdict)
(quiet (zero+ separator))
(zero+ dict-entry)
(quiet :rbrace)])
(defp arg-expr flat choice [:placeholder expression])
(defp arg-entry weak-order [arg-expr separators])
(defp args group order-1 [(quiet :lparen)
(quiet (zero+ separator))
(zero+ arg-entry)
(quiet :rparen)])
(defp recur-call group order-1 [(quiet :recur) tuple])
(defp synth-root flat choice [:keyword :word])
(defp synth-term flat choice [args :keyword])
(defp synthetic group order-1 [synth-root (zero+ synth-term)])
(defp fn-clause group order-1 [tuple-pattern (maybe guard) (quiet :rarrow) expression])
(defp fn-entry order-1 [fn-clause terminators])
(defp compound group order-1 [(quiet :lbrace)
nls?
(maybe :string)
(quiet (zero+ terminator))
(one+ fn-entry)
(quiet :rbrace)
])
(defp clauses flat choice [fn-clause compound])
(defp named group order-1 [:word clauses])
(defp body flat choice [fn-clause named])
(defp fn-expr group order-1 [(quiet :fn) body])
(defp block-line weak-order [expression terminators])
(defp block group order-1 [(quiet :lbrace)
(quiet (zero+ terminator))
(one+ block-line)
(quiet :rbrace)])
(defp pipeline quiet order-0 [nls? :pipeline])
(defp do-entry order-1 [pipeline expression])
(defp do-expr group order-1 [(quiet :do)
expression
(one+ do-entry)
])
(defp ref-expr group order-1 [(quiet :ref) :word (quiet :equals) expression])
(defp spawn group order-1 [(quiet :spawn) expression])
(defp receive group order-1 [(quiet :receive) (quiet :lbrace)
(quiet (zero+ terminator))
(one+ match-entry)
(quiet :rbrace)
])
(defp compound-loop group order-0 [(quiet :lbrace)
(quiet (zero+ terminator))
(one+ fn-entry)
(quiet :rbrace)])
(defp loop-expr group order-1 [(quiet :loop) tuple (quiet :with)
(flat (choice :loop-body [fn-clause compound-loop]))])
(defp expression flat choice [fn-expr
;match
loop-expr
let-expr
if-expr
;cond-expr
when-expr
spawn
receive
synthetic
recur-call
block
do-expr
ref-expr
struct-literal
dict
list-literal
set-literal
tuple
literal])
(defp test-expr group order-1 [(quiet :test) :string expression])
(defp import-expr group order-1 [(quiet :import) :string (quiet :as) :word])
(defp ns-expr group order-1 [(quiet :ns)
:word
(quiet :lbrace)
(quiet (zero+ separator))
(zero+ struct-entry)
(quiet :rbrace)])
(defp toplevel flat choice [import-expr
ns-expr
expression
test-expr])
(defp script-line weak-order [toplevel terminators])
(defp script order-0 [nls?
(one+ script-line)
(quiet :eof)])
;;; REPL
(comment
(def source
"if 1 then 2 else 3"
)
(def rule (literal))
(def tokens (-> source scan/scan :tokens))
(def result (apply-parser script tokens))
(defn report [node]
(when (fail? node) (err-msg node))
node)
(defn clean [node]
(if (map? node)
(-> node
(report)
(dissoc
;:status
:remaining
:token)
(update :data #(into [] (map clean) %)))
node))
(defn tap [x] (println "\n\n\n\n******NEW RUN\n\n:::=> " x "\n\n") x)
(def my-data (-> result
clean
tap
))
(println my-data))

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,38 @@
(ns ludus.interpreter-new
(:require
[ludus.grammar :as g]
[ludus.parser-new :as p]
[ludus.scanner :as s]))
(def source
"(1 2)
"
)
(def tokens (-> source s/scan :tokens))
(def result (p/apply-parser g/script tokens))
(-> result :data)
(defn report [node]
(when (p/fail? node) (p/err-msg node))
node)
(defn clean [node]
(if (map? node)
(-> node
(report)
(dissoc
;:status
:remaining
:token)
(update :data #(into [] (map clean) %)))
node))
(defn tap [x] (println "\n\n\n\n******NEW RUN\n\n:::=> " x "\n\n") x)
(def my-data (-> result
clean
tap
))

View File

@ -1224,7 +1224,9 @@
(parser) (parser)
(parse-script))) (parse-script)))
(comment (comment
(do
(def my-source " (def my-source "
data Foo {foo, bar} data Foo {foo, bar}
data Bar as { data Bar as {
@ -1234,7 +1236,7 @@ data Bar as {
") ")
(::ast (parse (scanner/scan my-source)))) (::ast (parse (scanner/scan my-source)))))
(comment " (comment "
Further thoughts/still to do: Further thoughts/still to do:

334
src/ludus/parser_new.clj Normal file
View File

@ -0,0 +1,334 @@
(ns ludus.parser-new)
(defn ? [val default] (if (nil? val) default val))
(defn ok? [{status :status}]
(= status :ok))
(def failing #{:err :none})
(def passing #{:ok :group :quiet})
(defn pass? [{status :status}] (contains? passing status))
(defn fail? [{status :status}] (contains? failing status))
(defn data [{d :data}] d)
(defn remaining [{r :remaining}] r)
(defn pname [parser] (? (:name parser) parser))
(defn str-part [kw] (apply str (next (str kw))))
(defn kw+str [kw mystr] (keyword (str (str-part kw) mystr)))
(defn value [token]
(if (= :none (:literal token)) (:lexeme token) (:literal token)))
(defn apply-kw-parser [kw tokens]
(let [token (first tokens)]
;(if (= kw (:type token)) (println "Matched " kw))
(if (= kw (:type token))
{:status :ok
:type kw
:data (if (some? (value token)) [(value token)] [])
:token token
:remaining (rest tokens)}
{:status :none :token token :trace [kw] :remaining (rest tokens)})))
(defn apply-fn-parser [parser tokens]
(let [rule (:rule parser) name (:name parser) result (rule tokens)]
;(if (pass? result) (println "Matched " (:name parser)))
result))
(defn apply-parser [parser tokens]
;(println "Applying parser " (? (:name parser) parser))
(let [result (cond
(keyword? parser) (apply-kw-parser parser tokens)
(:rule parser) (apply-fn-parser parser tokens)
(fn? parser) (apply-fn-parser (parser) tokens)
:else (throw (Exception. "`apply-parser` requires a parser")))]
;(println "Parser result " (? (:name parser) parser) (:status result))
result
))
(defn choice [name parsers]
{:name name
:rule (fn choice-fn [tokens]
(loop [ps parsers]
(let [result (apply-parser (first ps) tokens)
rem-ts (remaining result)
rem-ps (rest ps)]
(cond
(pass? result)
{:status :ok :type name :data [result] :token (first tokens) :remaining rem-ts}
(= :err (:status result))
(update result :trace #(conj % name))
(empty? rem-ps)
{:status :none :token (first tokens) :trace [name] :remaining rem-ts}
:else (recur rem-ps)))))})
(defn order-1 [name parsers]
{:name name
:rule (fn order-fn [tokens]
(let [origin (first tokens)
first-result (apply-parser (first parsers) tokens)]
(case (:status first-result)
(:err :none)
(assoc (update first-result :trace #(conj % name)) :status :none)
(:ok :quiet :group)
(loop [ps (rest parsers)
results (case (:status first-result)
:ok [first-result]
:quiet []
:group (:data first-result))
ts (remaining first-result)]
(let [result (apply-parser (first ps) ts)
res-rem (remaining result)]
(if (empty? (rest ps))
(case (:status result)
:ok {:status :group
:type name
:data (conj results result)
:token origin
:remaining res-rem}
:quiet {:status :group
:type name
:data results
:token origin
:remaining res-rem}
:group {:status :group
:type name
:data (vec (concat results (:data result)))
:token origin
:remaining res-rem}
(:err :none)
(assoc (update result :trace #(conj % name)) :status :err))
(case (:status result)
:ok (recur (rest ps) (conj results result) res-rem)
:group (recur (rest ps)
(vec (concat results (:data result)))
res-rem)
:quiet (recur (rest ps) results res-rem)
(:err :none)
(assoc (update result :trace #(conj % name)) :status :err))))))))})
(defn order-0 [name parsers]
{:name name
:rule (fn order-fn [tokens]
(let [origin (first tokens)]
(loop [ps parsers
results []
ts tokens]
(let [result (apply-parser (first ps) ts)
res-rem (remaining result)]
(if (empty? (rest ps))
;; Nothing more: return
(case (:status result)
:ok {:status :group
:type name
:data (conj results result)
:token origin
:remaining res-rem}
:quiet {:status :group
:type name
:data results
:token origin
:remaining res-rem}
:group {:status :group
:type name
:data (vec (concat results (:data result)))
:token origin
:remaining res-rem}
(:err :none)
(assoc (update result :trace #(conj % name)) :status :err))
;; Still parsers left in the vector: recur
(case (:status result)
:ok (recur (rest ps) (conj results result) res-rem)
:group (recur (rest ps)
(vec (concat results (:data result)))
res-rem)
:quiet (recur (rest ps) results res-rem)
(:err :none)
(assoc (update result :trace #(conj % name)) :status :err)
(throw (ex-info (str "Got bad result: " (:status result)) result))))))))})
(defn weak-order [name parsers]
{:name name
:rule (fn order-fn [tokens]
(let [origin (first tokens)]
(loop [ps parsers
results []
ts tokens]
(let [result (apply-parser (first ps) ts)
res-rem (remaining result)]
(if (empty? (rest ps))
;; Nothing more: return
(case (:status result)
:ok {:status :group
:type name
:data (conj results result)
:token origin
:remaining res-rem}
:quiet {:status :group
:type name
:data results
:token origin
:remaining res-rem}
:group {:status :group
:type name
:data (vec (concat results (:data result)))
:token origin
:remaining res-rem}
(:err :none)
(update result :trace #(conj % name)))
;; Still parsers left in the vector: recur
(case (:status result)
:ok (recur (rest ps) (conj results result) res-rem)
:group (recur (rest ps)
(vec (concat results (:data result)))
res-rem)
:quiet (recur (rest ps) results res-rem)
(:err :none)
(update result :trace #(conj % name))))))))})
(defn quiet [parser]
{:name (kw+str (? (:name parser) parser) "-quiet")
:rule (fn quiet-fn [tokens]
(let [result (apply-parser parser tokens)]
(if (pass? result)
(assoc result :status :quiet)
result)))})
(defn zero+
([parser] (zero+ (pname parser) parser))
([name parser]
{:name (kw+str name "-zero+")
:rule (fn zero+fn [tokens]
(loop [results []
ts tokens]
(let [result (apply-parser parser ts)]
(case (:status result)
:ok (recur (conj results result) (remaining result))
:group (recur (vec (concat results (:data result))) (remaining result))
:quiet (recur results (remaining result))
:err (update result :trace #(conj % name))
:none {:status :group
:type name
:data results
:token (first tokens)
:remaining ts}))))}))
(defn one+
([parser] (one+ (pname parser) parser))
([name parser]
{:name (kw+str name "-one+")
:rule (fn one+fn [tokens]
(let [first-result (apply-parser parser tokens)
rest-parser (zero+ name parser)]
(case (:status first-result)
(:ok :group)
(let [rest-result (apply-parser rest-parser (remaining first-result))]
(case (:status rest-result)
(:ok :group :quiet)
{:status :group
:type name
:data (vec (concat (:data first-result) (data rest-result)))
:token (first tokens)
:remaining (remaining rest-result)}
:none {:status :group :type name
:data first-result
:token (first tokens)
:remaining (remaining rest-result)}
:err (update rest-result :trace #(conj % name))))
:quiet
(let [rest-result (apply-parser rest-parser (remaining first-result))]
{:status :quiet
:type name
:data []
:token (first tokens)
:remaining (remaining rest-result)})
(:err :none) first-result)))}))
(defn maybe
([parser] (maybe (pname parser) parser))
([name parser]
{:name (kw+str name "-maybe")
:rule (fn maybe-fn [tokens]
(let [result (apply-parser parser tokens)]
(if (pass? result)
result
{:status :group :type name :data [] :token (first tokens) :remaining tokens}
)))}))
(defn flat
([parser] (flat (pname parser) parser))
([name parser]
{:name (kw+str name "-flat")
:rule (fn flat-fn [tokens]
(let [result (apply-parser parser tokens)]
(if (pass? result) (first (:data result)) result)))}))
(defn group
([parser] (group (pname parser) parser))
([name parser]
{:name (kw+str name "-group")
:rule (fn group-fn [tokens]
(let [result (apply-parser parser tokens)]
(if (= :group (:status result))
(assoc result :status :ok)
result)))}))
(defn err-msg [{token :token trace :trace}]
(println "Unexpected token " (:type token) " on line " (:line token))
(println "Expected token " (first trace)))
(defmacro defp [name & items]
(let [arg (last items)
fns (into [] (butlast items))]
`(defn ~name [] ((apply comp ~fns) (keyword '~name) ~arg))))
(macroexpand '(defp foo group choice [:one :two]))
(comment (defp foo quiet choice [:one :two])
(def group-choice (apply comp '(group choice)))
(group-choice :thing [:a :b])
((apply comp [group choice]) :foo [:one :two])
(fn? foo)
foo
(keyword 'foo)
(foo))

View File

@ -37,6 +37,22 @@
::data/type ::data/clj ::data/type ::data/clj
:body /}) :body /})
(def gt {:name "gt"
::data/type ::data/clj
:body >})
(def gte {:name "gte"
::data/type ::data/clj
:body >=})
(def lt {:name "lt"
::data/type ::data/clj
:body <})
(def lte {:name "lte"
::data/type ::data/clj
:body <=})
(def inc- {:name "inc" (def inc- {:name "inc"
::data/type ::data/clj ::data/type ::data/clj
:body inc}) :body inc})
@ -93,23 +109,104 @@
(def get- {:name "get" (def get- {:name "get"
::data/type ::data/clj ::data/type ::data/clj
:body get}) :body (fn
([key, map]
(if (map? map)
(get map key)
nil))
([key, map, default]
(if (map? map)
(get map key default)
default)))})
(comment (def first- {:name "first"
(def draw {:name "draw"
::data/type ::data/clj ::data/type ::data/clj
:body draw/ludus-draw}) :body (fn [v] (second v))})
(def draw {:name "draw" (def rest- {:name "rest"
::data/type ::data/clj ::data/type ::data/clj
:body d/draw})) :body (fn [v]
(into [::data/list] (nthrest v 2)))})
(def prelude {"eq" eq (def nth- {:name "nth"
::data/type ::data/clj
:body (fn
([i, xs]
(cond
(> 0 i) nil
(contains? xs (inc i)) (nth xs (inc i))
:else nil))
([i, xs, default]
(cond
(> 0 i) default
(contains? xs (inc i)) (nth xs (inc i))
:else default)))})
(defn get-type [value]
(let [t (type value)]
(cond
(nil? value) :nil
(= clojure.lang.Keyword t) :keyword
(= java.lang.Long t) :number
(= java.lang.Double t) :number
(= java.lang.String t) :string
(= java.lang.Boolean t) :boolean
(= clojure.lang.PersistentHashSet t) :set
;; tuples and lists
(= clojure.lang.PersistentVector t)
(if (= ::data/tuple (first value)) :tuple :list)
;; structs dicts namespaces refs
(= clojure.lang.PersistentArrayMap t)
(cond
(::data/type value) (case (::data/type value)
(::data/fn ::data/clj) :fn
::data/ns :ns)
(::data/dict value) :dict
(::data/struct value) :struct
:else :none
))))
(def type- {:name "type"
::data/type ::data/clj
:body get-type})
(defn strpart [kw] (->> kw str rest (apply str)))
(def clj {:name "clj"
::data/type ::data/clj
:body (fn [& args]
(println "Args passed: " args)
(let [called (-> args first strpart read-string eval)
fn-args (rest args)]
(println "Fn: " called)
(println "Args: " fn-args)
(apply called fn-args)))})
(def count- {:name "count"
::data/type ::data/clj
:body (fn [xs] (dec (count xs)))})
(def prelude {
"id" id
"eq" eq
"add" add "add" add
"print" print- "print" print-
"sub" sub "sub" sub
"mult" mult "mult" mult
"div" div "div" div
"gt" gt
"gte" gte
"lt" lt
"lte" lte
"inc" inc- "inc" inc-
"dec" dec- "dec" dec-
"not" not "not" not
@ -122,5 +219,10 @@
"assoc" assoc- "assoc" assoc-
"conj" conj- "conj" conj-
"get" get- "get" get-
;"draw" draw "type" type-
"clj" clj
"first" first-
"rest" rest-
"nth" nth-
"count" count-
}) })

View File

@ -75,18 +75,18 @@
::data/type ::data/ns ::data/type ::data/ns
::data/name "process" ::data/name "process"
:list {::data/type ::data/clj "list" {::data/type ::data/clj
:name "list" :name "list"
:body (fn [] (into [] (keys @processes)))} :body (fn [] (into [] (keys @processes)))}
:info {::data/type ::data/clj "info" {::data/type ::data/clj
:name "info" :name "info"
:body (fn [pid] :body (fn [pid]
(let [process @(get @processes pid) (let [process @(get @processes pid)
queue (into [] (:queue process))] queue (into [] (:queue process))]
(assoc process :queue queue ::data/dict true)))} (assoc process :queue queue ::data/dict true)))}
:flush {::data/type ::data/clj "flush" {::data/type ::data/clj
:name "flush" :name "flush"
:body (fn [pid] :body (fn [pid]
(let [process (get @processes pid) (let [process (get @processes pid)

View File

@ -1,12 +1,15 @@
(ns ludus.repl (ns ludus.repl
(:require (:require
[ludus.scanner :as scanner] [ludus.scanner :as scanner]
[ludus.parser :as parser] ;[ludus.parser :as parser]
[ludus.parser-new :as p]
[ludus.grammar :as g]
[ludus.interpreter :as interpreter] [ludus.interpreter :as interpreter]
[ludus.prelude :as prelude] [ludus.prelude :as prelude]
[ludus.show :as show] [ludus.show :as show]
[ludus.data :as data] [ludus.data :as data]
[ludus.process :as process])) ;[ludus.process :as process]
))
(declare repl-prelude new-session) (declare repl-prelude new-session)
@ -20,7 +23,7 @@
(println "\nGoodbye!") (println "\nGoodbye!")
(System/exit 0)) (System/exit 0))
(def base-ctx (merge prelude/prelude process/process (def base-ctx (merge prelude/prelude ;process/process
{::repl true {::repl true
"repl" "repl"
{::data/struct true {::data/struct true
@ -91,12 +94,19 @@
(= "" input) (recur) (= "" input) (recur)
:else :else
(let [parsed (-> input (scanner/scan) (parser/parse)) (let [parsed (->> input
{result :result ctx :ctx pid- :pid} (scanner/scan)
:tokens
(p/apply-parser g/script))]
(if (= :err (:status parsed))
(do
(println (p/err-msg parsed))
(recur))
(let [{result :result ctx :ctx pid- :pid}
(if pid (if pid
(interpreter/interpret-repl parsed orig-ctx pid) (interpreter/interpret-repl parsed orig-ctx pid)
(interpreter/interpret-repl parsed orig-ctx))] (interpreter/interpret-repl parsed orig-ctx))]
(if (= result ::interpreter/error) (if (= result :error)
(recur) (recur)
(do (do
(println (show/show result)) (println (show/show result))
@ -104,7 +114,7 @@
(swap! session-atom #(assoc % :ctx ctx))) (swap! session-atom #(assoc % :ctx ctx)))
(when (not (= pid pid-)) (when (not (= pid pid-))
(swap! session-atom #(assoc % :pid pid-))) (swap! session-atom #(assoc % :pid pid-)))
(recur)))))))) (recur))))))))))
(defn launch [] (defn launch []
(println "Welcome to Ludus (v. 0.1.0-alpha)") (println "Welcome to Ludus (v. 0.1.0-alpha)")

View File

@ -7,66 +7,73 @@
(def reserved-words (def reserved-words
"List of Ludus reserved words." "List of Ludus reserved words."
;; see ludus-spec repo for more info ;; see ludus-spec repo for more info
{"as" ::token/as ;; impl for `import`; not yet for patterns {"as" :as ;; impl for `import`; not yet for patterns
"cond" ::token/cond ;; impl ;"cond" :cond ;; impl
"do" ::token/do ;; impl "do" :do ;; impl
"else" ::token/else ;; impl "else" :else ;; impl
"false" ::token/false ;; impl "false" :false ;; impl -> literal word
"fn" ::token/fn ;; impl "fn" :fn ;; impl
"if" ::token/if ;; impl "if" :if ;; impl
"import" ::token/import ;; impl "import" :import ;; impl
"let" ::token/let ;; impl "let" :let ;; impl
"loop" ::token/loop ;; impl "loop" :loop ;; impl
"match" ::token/match ;; impl ; "match" :match ;; impl
"nil" ::token/nil ;; impl "nil" :nil ;; impl -> literal word
"ns" ::token/ns ;; impl "ns" :ns ;; impl
;; "panic!" ::token/panic ;; impl (should be a function) ;; "panic!" :panic ;; impl (should be a function)
"recur" ::token/recur ;; impl "recur" :recur ;; impl
"ref" ::token/ref ;; impl "ref" :ref ;; impl
"then" ::token/then ;; impl "then" :then ;; impl
"true" ::token/true ;; impl "true" :true ;; impl -> literal word
"with" ::token/with ;; impl "with" :with ;; impl
;; actor model/concurrency ;; actor model/concurrency
"receive" ::token/receive "receive" :receive
;;"self" ::token/self ;; maybe not necessary?: self() is a function ;;"self" :self ;; maybe not necessary?: self() is a function
;;"send" ::token/send ;; not necessary: send(pid, message) is a function ;;"send" :send ;; not necessary: send(pid, message) is a function
"spawn" ::token/spawn "spawn" :spawn
;;"to" ::token/to ;; not necessary if send is a function ;;"to" :to ;; not necessary if send is a function
;; type system ;; type system
;; "data" ::token/data ;; we are going to tear out datatypes for now: see if dynamism works for us ;; "data" :data ;; we are going to tear out datatypes for now: see if dynamism works for us
;; others ;; others
"repeat" ::token/repeat ;; syntax sugar over "loop": still unclear what this syntax could be ;;"repeat" :repeat ;; syntax sugar over "loop": still unclear what this syntax could be
"test" ::token/test "test" :test
"when" ::token/when "when" :when
;; "module" ::token/module ;; not necessary if we don't have datatypes ;; "module" :module ;; not necessary if we don't have datatypes
"is" :is
})
(def literal-words {
"true" true
"false" false
"nil" nil
}) })
(defn- new-scanner (defn- new-scanner
"Creates a new scanner." "Creates a new scanner."
[source] [source]
{::source source {:source source
::length (count source) :length (count source)
::errors [] :errors []
::start 0 :start 0
::current 0 :current 0
::line 1 :line 1
::tokens []}) :tokens []})
(defn- at-end? (defn- at-end?
"Tests if a scanner is at end of input." "Tests if a scanner is at end of input."
[scanner] [scanner]
(>= (::current scanner) (::length scanner))) (>= (:current scanner) (:length scanner)))
(defn- current-char (defn- current-char
"Gets the current character of the scanner." "Gets the current character of the scanner."
[scanner] [scanner]
(nth (::source scanner) (::current scanner) nil)) (nth (:source scanner) (:current scanner) nil))
(defn- advance (defn- advance
"Advances the scanner by a single character." "Advances the scanner by a single character."
[scanner] [scanner]
(update scanner ::current inc)) (update scanner :current inc))
(defn- next-char (defn- next-char
"Gets the next character from the scanner." "Gets the next character from the scanner."
@ -75,7 +82,7 @@
(defn- current-lexeme (defn- current-lexeme
[scanner] [scanner]
(subs (::source scanner) (::start scanner) (::current scanner))) (subs (:source scanner) (:start scanner) (:current scanner)))
(defn- char-in-range? [start end char] (defn- char-in-range? [start end char]
(and char (and char
@ -107,11 +114,7 @@
(defn- whitespace? [c] (defn- whitespace? [c]
(or (= c \space) (= c \tab))) (or (= c \space) (= c \tab)))
;; TODO: update token terminators: (def terminators #{\: \; \newline \{ \} \( \) \[ \] \$ \# \- \= \& \, \> nil \\})
;; remove: \|
;; add: \>
;; research others
(def terminators #{\: \; \newline \{ \} \( \) \[ \] \$ \# \- \= \& \, \| nil \\})
(defn- terminates? [c] (defn- terminates? [c]
(or (whitespace? c) (contains? terminators c))) (or (whitespace? c) (contains? terminators c)))
@ -120,28 +123,28 @@
([scanner token-type] ([scanner token-type]
(add-token scanner token-type nil)) (add-token scanner token-type nil))
([scanner token-type literal] ([scanner token-type literal]
(update scanner ::tokens conj (update scanner :tokens conj
(token/token (token/token
token-type token-type
(current-lexeme scanner) (current-lexeme scanner)
literal literal
(::line scanner) (:line scanner)
(::start scanner))))) (:start scanner)))))
;; TODO: errors should also be in the vector of tokens ;; TODO: errors should also be in the vector of tokens
;; The goal is to be able to be able to hand this to an LSP? ;; The goal is to be able to be able to hand this to an LSP?
;; Do we need a different structure ;; Do we need a different structure
(defn- add-error [scanner msg] (defn- add-error [scanner msg]
(let [token (token/token (let [token (token/token
::token/error :error
(current-lexeme scanner) (current-lexeme scanner)
nil nil
(::line scanner) (:line scanner)
(::start scanner)) (:start scanner))
err-token (assoc token :message msg)] err-token (assoc token :message msg)]
(-> scanner (-> scanner
(update ::errors conj err-token) (update :errors conj err-token)
(update ::tokens conj err-token)))) (update :tokens conj err-token))))
(defn- add-keyword (defn- add-keyword
[scanner] [scanner]
@ -149,7 +152,7 @@
key ""] key ""]
(let [char (current-char scanner)] (let [char (current-char scanner)]
(cond (cond
(terminates? char) (add-token scanner ::token/keyword (keyword key)) (terminates? char) (add-token scanner :keyword (keyword key))
(word-char? char) (recur (advance scanner) (str key char)) (word-char? char) (recur (advance scanner) (str key char))
:else (add-error scanner (str "Unexpected " char "after keyword :" key)))))) :else (add-error scanner (str "Unexpected " char "after keyword :" key))))))
@ -166,28 +169,33 @@
(= curr \.) (if float? (= curr \.) (if float?
(add-error scanner (str "Unexpected second decimal point after " num ".")) (add-error scanner (str "Unexpected second decimal point after " num "."))
(recur (advance scanner) (str num curr) true)) (recur (advance scanner) (str num curr) true))
(terminates? curr) (add-token scanner ::token/number (edn/read-string num)) (terminates? curr) (add-token scanner :number (edn/read-string num))
(digit? curr) (recur (advance scanner) (str num curr) float?) (digit? curr) (recur (advance scanner) (str num curr) float?)
:else (add-error scanner (str "Unexpected " curr " after number " num ".")))))) :else (add-error scanner (str "Unexpected " curr " after number " num "."))))))
;; TODO: add string interpolation ;; TODO: activate string interpolation
;; This still has to be devised
(defn- add-string (defn- add-string
[scanner] [scanner]
(loop [scanner scanner (loop [scanner scanner
string ""] string ""
interpolate? false]
(let [char (current-char scanner)] (let [char (current-char scanner)]
(case char (case char
\newline (add-error scanner "Unterminated string.") \{ (recur (update (advance scanner)) (str string char) true)
\" (add-token (advance scanner) ::token/string string) ; allow multiline strings
\newline (recur (update (advance scanner) :line inc) (str string char) interpolate?)
\" (if interpolate?
;(add-token (advance scanner) :interpolated string)
(add-token (advance scanner) :string string)
(add-token (advance scanner) :string string))
\\ (let [next (next-char scanner) \\ (let [next (next-char scanner)
scanner (if (= next \newline) scanner (if (= next \newline)
(update scanner ::line inc) (update scanner :line inc)
scanner)] scanner)]
(recur (advance (advance scanner)) (str string next))) (recur (advance (advance scanner)) (str string next) interpolate?))
(if (at-end? scanner) (if (at-end? scanner)
(add-error scanner "Unterminated string.") (add-error scanner "Unterminated string.")
(recur (advance scanner) (str string char))))))) (recur (advance scanner) (str string char) interpolate?))))))
(defn- add-word (defn- add-word
[char scanner] [char scanner]
@ -195,7 +203,9 @@
word (str char)] word (str char)]
(let [curr (current-char scanner)] (let [curr (current-char scanner)]
(cond (cond
(terminates? curr) (add-token scanner (get reserved-words word ::token/word)) (terminates? curr) (add-token scanner
(get reserved-words word :word)
(get literal-words word :none))
(word-char? curr) (recur (advance scanner) (str word curr)) (word-char? curr) (recur (advance scanner) (str word curr))
:else (add-error scanner (str "Unexpected " curr " after word " word ".")))))) :else (add-error scanner (str "Unexpected " curr " after word " word "."))))))
@ -205,7 +215,7 @@
word (str char)] word (str char)]
(let [curr (current-char scanner)] (let [curr (current-char scanner)]
(cond (cond
(terminates? curr) (add-token scanner ::token/datatype) (terminates? curr) (add-token scanner :datatype)
(word-char? curr) (recur (advance scanner) (str word curr)) (word-char? curr) (recur (advance scanner) (str word curr))
:else (add-error scanner (str "Unexpected " curr " after datatype " word ".")))))) :else (add-error scanner (str "Unexpected " curr " after datatype " word "."))))))
@ -215,7 +225,7 @@
ignored "_"] ignored "_"]
(let [char (current-char scanner)] (let [char (current-char scanner)]
(cond (cond
(terminates? char) (add-token scanner ::token/ignored) (terminates? char) (add-token scanner :ignored)
(word-char? char) (recur (advance scanner) (str ignored char)) (word-char? char) (recur (advance scanner) (str ignored char))
:else (add-error scanner (str "Unexpected " char " after word " ignored ".")))))) :else (add-error scanner (str "Unexpected " char " after word " ignored "."))))))
@ -224,7 +234,7 @@
comm (str char)] comm (str char)]
(let [char (current-char scanner)] (let [char (current-char scanner)]
(if (= \newline char) (if (= \newline char)
(update scanner ::line inc) (update scanner :line inc)
(recur (advance scanner) (str comm char)))))) (recur (advance scanner) (str comm char))))))
(defn- scan-token [scanner] (defn- scan-token [scanner]
@ -233,69 +243,52 @@
next (current-char scanner)] next (current-char scanner)]
(case char (case char
;; one-character tokens ;; one-character tokens
\( (add-token scanner ::token/lparen) \( (add-token scanner :lparen)
\) (add-token scanner ::token/rparen) ;; :break is a special zero-char token before closing braces
\{ (add-token scanner ::token/lbrace) ;; it makes parsing much simpler
\} (add-token scanner ::token/rbrace) \) (add-token (add-token scanner :break) :rparen)
\[ (add-token scanner ::token/lbracket) \{ (add-token scanner :lbrace)
\] (add-token scanner ::token/rbracket) \} (add-token (add-token scanner :break) :rbrace)
\; (add-token scanner ::token/semicolon) \[ (add-token scanner :lbracket)
\, (add-token scanner ::token/comma) \] (add-token (add-token scanner :break) :rbracket)
\newline (add-token (update scanner ::line inc) ::token/newline) \; (add-token scanner :semicolon)
\\ (add-token scanner ::token/backslash) \, (add-token scanner :comma)
\= (add-token scanner ::token/equals) \newline (add-token (update scanner :line inc) :newline)
\> (add-token scanner ::token/pipeline) \\ (add-token scanner :backslash)
\= (add-token scanner :equals)
\> (add-token scanner :pipeline)
;; two-character tokens ;; two-character tokens
;; -> ;; ->
\- (cond \- (cond
(= next \>) (add-token (advance scanner) ::token/rarrow) (= next \>) (add-token (advance scanner) :rarrow)
(digit? next) (add-number char scanner) (digit? next) (add-number char scanner)
:else (add-error scanner (str "Expected -> or negative number after `-`. Got `" char next "`"))) :else (add-error scanner (str "Expected -> or negative number after `-`. Got `" char next "`")))
;; at current we're not using this
;; <-
;;\< (if (= next \-)
;; (add-token (advance scanner) ::token/larrow)
;; (add-error scanner (str "Expected <-. Got " char next)))
;; |>
;; Consider => , with =>> for bind
; \| (if (= next \>)
; (add-token (advance scanner) ::token/pipeline)
; (add-error scanner (str "Expected |>. Got " char next)))
;; possible additional operator: bind/result
;; possible additional operator: bind/some
;; oh god, monads
;; additional arrow possibilities: >> ||> ~> => !>
;; dict #{ ;; dict #{
\# (if (= next \{) \# (if (= next \{)
(add-token (advance scanner) ::token/startdict) (add-token (advance scanner) :startdict)
(add-error scanner (str "Expected beginning of dict: #{. Got " char next))) (add-error scanner (str "Expected beginning of dict: #{. Got " char next)))
;; set ${ ;; set ${
\$ (if (= next \{) \$ (if (= next \{)
(add-token (advance scanner) ::token/startset) (add-token (advance scanner) :startset)
(add-error scanner (str "Expected beginning of set: ${. Got " char next))) (add-error scanner (str "Expected beginning of set: ${. Got " char next)))
;; struct @{ ;; struct @{
\@ (if (= next \{) \@ (if (= next \{)
(add-token (advance scanner) ::token/startstruct) (add-token (advance scanner) :startstruct)
(add-error scanner (str "Expected beginning of struct: @{. Got " char next))) (add-error scanner (str "Expected beginning of struct: @{. Got " char next)))
;; placeholders ;; placeholders
;; there's a flat _, and then ignored words ;; there's a flat _, and then ignored words
\_ (cond \_ (cond
(terminates? next) (add-token scanner ::token/placeholder) (terminates? next) (add-token scanner :placeholder)
(alpha? next) (add-ignored scanner) (alpha? next) (add-ignored scanner)
:else (add-error scanner (str "Expected placeholder: _. Got " char next))) :else (add-error scanner (str "Expected placeholder: _. Got " char next)))
;; comments ;; comments
;; & starts an inline comment ;; & starts an inline comment
;; TODO: include comments in scanned file
;; TODO, maybe: add doc comments: &&& (or perhaps a docstring in an fn?)
\& (add-comment char scanner) \& (add-comment char scanner)
;; keywords ;; keywords
@ -306,7 +299,7 @@
;; splats ;; splats
\. (let [after_next (current-char (advance scanner))] \. (let [after_next (current-char (advance scanner))]
(if (= ".." (str next after_next)) (if (= ".." (str next after_next))
(add-token (advance (advance scanner)) ::token/splat) (add-token (advance (advance scanner)) :splat)
(add-error scanner (str "Expected splat: ... . Got " (str "." next after_next))))) (add-error scanner (str "Expected splat: ... . Got " (str "." next after_next)))))
;; strings ;; strings
@ -316,20 +309,18 @@
(cond (cond
(whitespace? char) scanner ;; for now just skip whitespace characters (whitespace? char) scanner ;; for now just skip whitespace characters
(digit? char) (add-number char scanner) (digit? char) (add-number char scanner)
(upper? char) (add-data char scanner) (upper? char) (add-word char scanner) ;; no datatypes for now
(lower? char) (add-word char scanner) (lower? char) (add-word char scanner)
:else (add-error scanner (str "Unexpected character: " char)))))) :else (add-error scanner (str "Unexpected character: " char))))))
(defn- next-token [scanner] (defn- next-token [scanner]
(assoc scanner ::start (::current scanner))) (assoc scanner :start (:current scanner)))
(defn scan [source] (defn scan [source]
(loop [scanner (new-scanner (str source "\n"))] (loop [scanner (new-scanner source)]
(if (at-end? scanner) (if (at-end? scanner)
(let [scanner (add-token scanner ::token/eof)] (let [scanner (add-token (add-token scanner :break) :eof)]
{:tokens (::tokens scanner) {:tokens (:tokens scanner)
:errors (::errors scanner)}) :errors (:errors scanner)})
(recur (-> scanner (scan-token) (next-token)))))) (recur (-> scanner (scan-token) (next-token))))))
(scan "2 :three true nil")

View File

@ -8,7 +8,7 @@
(defn- show-vector [v] (defn- show-vector [v]
(if (= (first v) ::data/tuple) (if (= (first v) ::data/tuple)
(str "(" (apply str (into [] show-linear (next v))) ")") (str "(" (apply str (into [] show-linear (next v))) ")")
(str "[" (apply str (into [] show-linear v)) "]"))) (str "[" (apply str (into [] show-linear (next v))) "]")))
(defn- show-map [v] (defn- show-map [v]
(cond (cond
@ -25,7 +25,7 @@
(str "@{" (apply str (into [] show-keyed (dissoc v ::data/struct))) "}") (str "@{" (apply str (into [] show-keyed (dissoc v ::data/struct))) "}")
(::data/ref v) ;; TODO: reconsider this (::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/dict v) (::data/dict v)
(str "#{" (apply str (into [] show-keyed (dissoc v ::data/dict))) "}") (str "#{" (apply str (into [] show-keyed (dissoc v ::data/dict))) "}")
@ -58,5 +58,3 @@
(def show-keyed (comp (def show-keyed (comp
(map #(str (show (first %)) " " (show (second %)))) (map #(str (show (first %)) " " (show (second %))))
(interpose ", "))) (interpose ", ")))
(show {::data/type ::data/fn :name "foo"})

View File

@ -2,8 +2,8 @@
(defn token (defn token
[type text literal line start] [type text literal line start]
{::type type {:type type
::lexeme text :lexeme text
::literal literal :literal literal
::line line :line line
::start start}) :start start})

47
tokens Normal file
View File

@ -0,0 +1,47 @@
TOKENS:
:nil
:true
:false
:word
:keyword
:number
:string
:as
:cond
:do
:else
:fn
:if
:import
:let
:loop
:ref
:then
:with
:receive
:spawn
:repeat
:test
:when
:lparen
:rparen
:lbrace
:rbrace
:lbracket
:rbracket
:semicolon
:comma
:newline
:backslash
:equals
:pipeline
:rarrow
:startdict
:startstruct
:startset
:splat
:eof