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

Fix merge conflicts

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

52
sandbox.ld
View File

@ -26,4 +26,54 @@ let baz = do 69 > default (12) > print (:baz, _)
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)
")

24
src/ludus/core.clj
View File

@ -1,13 +1,15 @@
(ns ludus.core
"A tree-walk interpreter for the Ludus language."
(:require
[ludus.scanner :as scanner]
[ludus.parser :as parser]
[ludus.interpreter :as interpreter]
[ludus.show :as show]
[clojure.pprint :as pp]
[ludus.loader :as loader]
[ludus.repl :as repl])
[ludus.scanner :as scanner]
;[ludus.parser :as parser]
[ludus.parser-new :as p]
[ludus.grammar :as g]
[ludus.interpreter :as interpreter]
[ludus.show :as show]
[clojure.pprint :as pp]
[ludus.loader :as loader]
[ludus.repl :as repl])
(:gen-class))
(defn- run [file source]
@ -17,13 +19,13 @@
(println "I found some scanning errors!")
(pp/pprint (:errors scanned))
(System/exit 65))
(let [parsed (parser/parse scanned)]
(if (not-empty (:errors parsed))
(let [parsed (p/apply-parser g/script (:tokens scanned))]
(if (p/fail? parsed)
(do
(println "I found some parsing errors!")
(pp/pprint (:errors parsed))
(println (p/err-msg parsed))
(System/exit 66))
(let [interpreted (interpreter/interpret parsed file)]
(let [interpreted (interpreter/interpret source file parsed)]
(println (show/show interpreted))
(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))

937
src/ludus/interpreter.clj
View File

File diff suppressed because it is too large Load Diff

38
src/ludus/interpreter_new.clj Normal file
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
))

6
src/ludus/parser.clj
View File

@ -1224,8 +1224,10 @@
(parser)
(parse-script)))
(comment
(def my-source "
(do
(def my-source "
data Foo {foo, bar}
data Bar as {
Bar
@ -1234,7 +1236,7 @@ data Bar as {
")
(::ast (parse (scanner/scan my-source))))
(::ast (parse (scanner/scan my-source)))))
(comment "
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))

118
src/ludus/prelude.clj
View File

@ -37,6 +37,22 @@
::data/type ::data/clj
: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"
::data/type ::data/clj
:body inc})
@ -93,23 +109,104 @@
(def get- {:name "get"
::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 draw {:name "draw"
(def first- {:name "first"
::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
:body (fn [v]
(into [::data/list] (nthrest v 2)))})
(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 d/draw}))
:body (fn [xs] (dec (count xs)))})
(def prelude {"eq" eq
(def prelude {
"id" id
"eq" eq
"add" add
"print" print-
"sub" sub
"mult" mult
"div" div
"gt" gt
"gte" gte
"lt" lt
"lte" lte
"inc" inc-
"dec" dec-
"not" not
@ -122,5 +219,10 @@
"assoc" assoc-
"conj" conj-
"get" get-
;"draw" draw
"type" type-
"clj" clj
"first" first-
"rest" rest-
"nth" nth-
"count" count-
})

74
src/ludus/process.clj
View File

@ -1,6 +1,6 @@
(ns ludus.process
(:require
[ludus.data :as data])
(:require
[ludus.data :as data])
(:import (java.util.concurrent Executors)))
;; virtual thread patch from https://ales.rocks/notes-on-virtual-threads-and-clojure
@ -20,13 +20,13 @@
(defn new-process []
(let [pid @current-pid
process (atom {:pid pid
:queue clojure.lang.PersistentQueue/EMPTY
:inbox nil
:status :occupied
})]
(swap! processes #(assoc % pid process))
(swap! current-pid inc)
process))
:queue clojure.lang.PersistentQueue/EMPTY
:inbox nil
:status :occupied
})]
(swap! processes #(assoc % pid process))
(swap! current-pid inc)
process))
(def vm-state (atom :stopped))
@ -37,7 +37,7 @@
(defn process-msg [process]
;;(println "processing message" self)
(let [q (:queue process)
inbox (:inbox process)]
inbox (:inbox process)]
(when (not (realized? inbox))
;;(println "delivering message in" self)
(deliver inbox (peek q))
@ -45,9 +45,9 @@
(defn run-process [process-atom]
(let [process @process-atom
status (:status process)
q (:queue process)
inbox (:inbox process)]
status (:status process)
q (:queue process)
inbox (:inbox process)]
;;(println "running process" self ":" (into [] q))
(when (and (= status :idle) (not-empty q) inbox)
(swap! process-atom process-msg))))
@ -59,10 +59,10 @@
(reset! vm-state :running)
(loop []
(when (= @vm-state :running)
(run! run-process (values @processes))
(recur)
;; (println "Ludus VM shutting down")
)))))
(run! run-process (values @processes))
(recur)
;; (println "Ludus VM shutting down")
)))))
(defn stop-vm []
(reset! vm-state :stopped)
@ -71,26 +71,26 @@
nil)
(def process {"process" {
::data/struct true
::data/type ::data/ns
::data/name "process"
::data/struct true
::data/type ::data/ns
::data/name "process"
:list {::data/type ::data/clj
:name "list"
:body (fn [] (into [] (keys @processes)))}
"list" {::data/type ::data/clj
:name "list"
:body (fn [] (into [] (keys @processes)))}
:info {::data/type ::data/clj
:name "info"
:body (fn [pid]
(let [process @(get @processes pid)
queue (into [] (:queue process))]
(assoc process :queue queue ::data/dict true)))}
"info" {::data/type ::data/clj
:name "info"
:body (fn [pid]
(let [process @(get @processes pid)
queue (into [] (:queue process))]
(assoc process :queue queue ::data/dict true)))}
:flush {::data/type ::data/clj
:name "flush"
:body (fn [pid]
(let [process (get @processes pid)
queue (into [] (:queue @process))]
(swap! process #(assoc % :queue clojure.lang.PersistentQueue/EMPTY))
queue))}
}})
"flush" {::data/type ::data/clj
:name "flush"
:body (fn [pid]
(let [process (get @processes pid)
queue (into [] (:queue @process))]
(swap! process #(assoc % :queue clojure.lang.PersistentQueue/EMPTY))
queue))}
}})

42
src/ludus/repl.clj
View File

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

237
src/ludus/scanner.clj
View File

@ -1,72 +1,79 @@
(ns ludus.scanner
(:require
[ludus.token :as token]
;; [clojure.pprint :as pp]
[clojure.edn :as edn]))
[ludus.token :as token]
;; [clojure.pprint :as pp]
[clojure.edn :as edn]))
(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
"cond" ::token/cond ;; impl
"do" ::token/do ;; impl
"else" ::token/else ;; impl
"false" ::token/false ;; impl
"fn" ::token/fn ;; impl
"if" ::token/if ;; impl
"import" ::token/import ;; impl
"let" ::token/let ;; impl
"loop" ::token/loop ;; impl
"match" ::token/match ;; impl
"nil" ::token/nil ;; impl
"ns" ::token/ns ;; impl
;; "panic!" ::token/panic ;; impl (should be a function)
"recur" ::token/recur ;; impl
"ref" ::token/ref ;; impl
"then" ::token/then ;; impl
"true" ::token/true ;; impl
"with" ::token/with ;; impl
{"as" :as ;; impl for `import`; not yet for patterns
;"cond" :cond ;; impl
"do" :do ;; impl
"else" :else ;; impl
"false" :false ;; impl -> literal word
"fn" :fn ;; impl
"if" :if ;; impl
"import" :import ;; impl
"let" :let ;; impl
"loop" :loop ;; impl
; "match" :match ;; impl
"nil" :nil ;; impl -> literal word
"ns" :ns ;; impl
;; "panic!" :panic ;; impl (should be a function)
"recur" :recur ;; impl
"ref" :ref ;; impl
"then" :then ;; impl
"true" :true ;; impl -> literal word
"with" :with ;; impl
;; actor model/concurrency
"receive" ::token/receive
;;"self" ::token/self ;; maybe not necessary?: self() is a function
;;"send" ::token/send ;; not necessary: send(pid, message) is a function
"spawn" ::token/spawn
;;"to" ::token/to ;; not necessary if send is a function
"receive" :receive
;;"self" :self ;; maybe not necessary?: self() is a function
;;"send" :send ;; not necessary: send(pid, message) is a function
"spawn" :spawn
;;"to" :to ;; not necessary if send is a function
;; 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
"repeat" ::token/repeat ;; syntax sugar over "loop": still unclear what this syntax could be
"test" ::token/test
"when" ::token/when
;; "module" ::token/module ;; not necessary if we don't have datatypes
;;"repeat" :repeat ;; syntax sugar over "loop": still unclear what this syntax could be
"test" :test
"when" :when
;; "module" :module ;; not necessary if we don't have datatypes
"is" :is
})
(def literal-words {
"true" true
"false" false
"nil" nil
})
(defn- new-scanner
"Creates a new scanner."
[source]
{::source source
::length (count source)
::errors []
::start 0
::current 0
::line 1
::tokens []})
{:source source
:length (count source)
:errors []
:start 0
:current 0
:line 1
:tokens []})
(defn- at-end?
"Tests if a scanner is at end of input."
[scanner]
(>= (::current scanner) (::length scanner)))
(>= (:current scanner) (:length scanner)))
(defn- current-char
"Gets the current character of the scanner."
[scanner]
(nth (::source scanner) (::current scanner) nil))
(nth (:source scanner) (:current scanner) nil))
(defn- advance
"Advances the scanner by a single character."
[scanner]
(update scanner ::current inc))
(update scanner :current inc))
(defn- next-char
"Gets the next character from the scanner."
@ -75,12 +82,12 @@
(defn- current-lexeme
[scanner]
(subs (::source scanner) (::start scanner) (::current scanner)))
(subs (:source scanner) (:start scanner) (:current scanner)))
(defn- char-in-range? [start end char]
(and char
(>= (int char) (int start))
(<= (int char) (int end))))
(>= (int char) (int start))
(<= (int char) (int end))))
(defn- digit? [c]
(char-in-range? \0 \9 c))
@ -107,11 +114,7 @@
(defn- whitespace? [c]
(or (= c \space) (= c \tab)))
;; TODO: update token terminators:
;; remove: \|
;; add: \>
;; research others
(def terminators #{\: \; \newline \{ \} \( \) \[ \] \$ \# \- \= \& \, \| nil \\})
(def terminators #{\: \; \newline \{ \} \( \) \[ \] \$ \# \- \= \& \, \> nil \\})
(defn- terminates? [c]
(or (whitespace? c) (contains? terminators c)))
@ -120,28 +123,28 @@
([scanner token-type]
(add-token scanner token-type nil))
([scanner token-type literal]
(update scanner ::tokens conj
(token/token
token-type
(current-lexeme scanner)
literal
(::line scanner)
(::start scanner)))))
(update scanner :tokens conj
(token/token
token-type
(current-lexeme scanner)
literal
(:line scanner)
(:start scanner)))))
;; 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?
;; Do we need a different structure
(defn- add-error [scanner msg]
(let [token (token/token
::token/error
(current-lexeme scanner)
nil
(::line scanner)
(::start scanner))
:error
(current-lexeme scanner)
nil
(:line scanner)
(:start scanner))
err-token (assoc token :message msg)]
(-> scanner
(update ::errors conj err-token)
(update ::tokens conj err-token))))
(update :errors conj err-token)
(update :tokens conj err-token))))
(defn- add-keyword
[scanner]
@ -149,7 +152,7 @@
key ""]
(let [char (current-char scanner)]
(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))
:else (add-error scanner (str "Unexpected " char "after keyword :" key))))))
@ -166,28 +169,33 @@
(= curr \.) (if float?
(add-error scanner (str "Unexpected second decimal point after " num "."))
(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?)
:else (add-error scanner (str "Unexpected " curr " after number " num "."))))))
;; TODO: add string interpolation
;; This still has to be devised
;; TODO: activate string interpolation
(defn- add-string
[scanner]
(loop [scanner scanner
string ""]
string ""
interpolate? false]
(let [char (current-char scanner)]
(case char
\newline (add-error scanner "Unterminated string.")
\" (add-token (advance scanner) ::token/string string)
\{ (recur (update (advance scanner)) (str string char) true)
; 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)
scanner (if (= next \newline)
(update scanner ::line inc)
(update scanner :line inc)
scanner)]
(recur (advance (advance scanner)) (str string next)))
(recur (advance (advance scanner)) (str string next) interpolate?))
(if (at-end? scanner)
(add-error scanner "Unterminated string.")
(recur (advance scanner) (str string char)))))))
(recur (advance scanner) (str string char) interpolate?))))))
(defn- add-word
[char scanner]
@ -195,7 +203,9 @@
word (str char)]
(let [curr (current-char scanner)]
(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))
:else (add-error scanner (str "Unexpected " curr " after word " word "."))))))
@ -205,7 +215,7 @@
word (str char)]
(let [curr (current-char scanner)]
(cond
(terminates? curr) (add-token scanner ::token/datatype)
(terminates? curr) (add-token scanner :datatype)
(word-char? curr) (recur (advance scanner) (str word curr))
:else (add-error scanner (str "Unexpected " curr " after datatype " word "."))))))
@ -215,7 +225,7 @@
ignored "_"]
(let [char (current-char scanner)]
(cond
(terminates? char) (add-token scanner ::token/ignored)
(terminates? char) (add-token scanner :ignored)
(word-char? char) (recur (advance scanner) (str ignored char))
:else (add-error scanner (str "Unexpected " char " after word " ignored "."))))))
@ -224,7 +234,7 @@
comm (str char)]
(let [char (current-char scanner)]
(if (= \newline char)
(update scanner ::line inc)
(update scanner :line inc)
(recur (advance scanner) (str comm char))))))
(defn- scan-token [scanner]
@ -233,69 +243,52 @@
next (current-char scanner)]
(case char
;; one-character tokens
\( (add-token scanner ::token/lparen)
\) (add-token scanner ::token/rparen)
\{ (add-token scanner ::token/lbrace)
\} (add-token scanner ::token/rbrace)
\[ (add-token scanner ::token/lbracket)
\] (add-token scanner ::token/rbracket)
\; (add-token scanner ::token/semicolon)
\, (add-token scanner ::token/comma)
\newline (add-token (update scanner ::line inc) ::token/newline)
\\ (add-token scanner ::token/backslash)
\= (add-token scanner ::token/equals)
\> (add-token scanner ::token/pipeline)
\( (add-token scanner :lparen)
;; :break is a special zero-char token before closing braces
;; it makes parsing much simpler
\) (add-token (add-token scanner :break) :rparen)
\{ (add-token scanner :lbrace)
\} (add-token (add-token scanner :break) :rbrace)
\[ (add-token scanner :lbracket)
\] (add-token (add-token scanner :break) :rbracket)
\; (add-token scanner :semicolon)
\, (add-token scanner :comma)
\newline (add-token (update scanner :line inc) :newline)
\\ (add-token scanner :backslash)
\= (add-token scanner :equals)
\> (add-token scanner :pipeline)
;; two-character tokens
;; ->
\- (cond
(= next \>) (add-token (advance scanner) ::token/rarrow)
(= next \>) (add-token (advance scanner) :rarrow)
(digit? next) (add-number char scanner)
: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 #{
\# (if (= next \{)
(add-token (advance scanner) ::token/startdict)
(add-token (advance scanner) :startdict)
(add-error scanner (str "Expected beginning of dict: #{. Got " char next)))
;; set ${
\$ (if (= next \{)
(add-token (advance scanner) ::token/startset)
(add-token (advance scanner) :startset)
(add-error scanner (str "Expected beginning of set: ${. Got " char next)))
;; struct @{
\@ (if (= next \{)
(add-token (advance scanner) ::token/startstruct)
(add-token (advance scanner) :startstruct)
(add-error scanner (str "Expected beginning of struct: @{. Got " char next)))
;; placeholders
;; there's a flat _, and then ignored words
\_ (cond
(terminates? next) (add-token scanner ::token/placeholder)
(terminates? next) (add-token scanner :placeholder)
(alpha? next) (add-ignored scanner)
:else (add-error scanner (str "Expected placeholder: _. Got " char next)))
;; comments
;; & 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)
;; keywords
@ -306,7 +299,7 @@
;; splats
\. (let [after_next (current-char (advance scanner))]
(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)))))
;; strings
@ -316,20 +309,18 @@
(cond
(whitespace? char) scanner ;; for now just skip whitespace characters
(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)
:else (add-error scanner (str "Unexpected character: " char))))))
(defn- next-token [scanner]
(assoc scanner ::start (::current scanner)))
(assoc scanner :start (:current scanner)))
(defn scan [source]
(loop [scanner (new-scanner (str source "\n"))]
(loop [scanner (new-scanner source)]
(if (at-end? scanner)
(let [scanner (add-token scanner ::token/eof)]
{:tokens (::tokens scanner)
:errors (::errors scanner)})
(let [scanner (add-token (add-token scanner :break) :eof)]
{:tokens (:tokens scanner)
:errors (:errors scanner)})
(recur (-> scanner (scan-token) (next-token))))))
(scan "2 :three true nil")

44
src/ludus/show.clj
View File

@ -1,31 +1,31 @@
(ns ludus.show
(:require
[ludus.data :as data]
[clojure.pprint :as pp]))
[ludus.data :as data]
[clojure.pprint :as pp]))
(declare show show-linear show-keyed)
(defn- show-vector [v]
(if (= (first v) ::data/tuple)
(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]
(cond
(or (= (::data/type v) ::data/fn)
(= (::data/type v) ::data/clj))
(= (::data/type v) ::data/clj))
(str "fn " (:name v))
(= (::data/type v) ::data/ns)
(str "ns " (::data/name v) " {"
(apply str (into [] show-keyed (dissoc v ::data/struct ::data/type ::data/name)))
"}")
(apply str (into [] show-keyed (dissoc v ::data/struct ::data/type ::data/name)))
"}")
(::data/struct v)
(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/dict v)
(str "#{" (apply str (into [] show-keyed (dissoc v ::data/dict))) "}")
@ -38,25 +38,23 @@
(defn show
([v]
(cond
(string? v) (str "\"" v "\"")
(number? v) (str v)
(keyword? v) (str v)
(boolean? v) (str v)
(nil? v) "nil"
(vector? v) (show-vector v)
(set? v) (show-set v)
(map? v) (show-map v)
:else
(with-out-str (pp/pprint v))
))
(cond
(string? v) (str "\"" v "\"")
(number? v) (str v)
(keyword? v) (str v)
(boolean? v) (str v)
(nil? v) "nil"
(vector? v) (show-vector v)
(set? v) (show-set v)
(map? v) (show-map v)
:else
(with-out-str (pp/pprint v))
))
([v & vs] (apply str (into [] (comp (map show) (interpose " ")) (concat [v] vs))))
)
(def show-linear (comp (map show) (interpose ", ")))
(def show-keyed (comp
(map #(str (show (first %)) " " (show (second %))))
(interpose ", ")))
(show {::data/type ::data/fn :name "foo"})
(map #(str (show (first %)) " " (show (second %))))
(interpose ", ")))

10
src/ludus/token.clj
View File

@ -2,8 +2,8 @@
(defn token
[type text literal line start]
{::type type
::lexeme text
::literal literal
::line line
::start start})
{:type type
:lexeme text
:literal literal
:line line
: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