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

Clean it up, wire it up.

Browse Source
This commit is contained in:
Scott Richmond 2023-11-16 19:16:31 -05:00
parent e276298f4e
commit 7ec258ee24
24 changed files with 110 additions and 2076 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
deps.edn
View File

@ -1,7 +1,11 @@
{
:deps {org.clojure/clojurescript {:mvn/version "1.11.121"}}
:aliases {:nREPL
{:extra-deps
{nrepl/nrepl {:mvn/version "0.9.0"}}}}
:aliases
{:repl
{:exec-fn clojure.core.server/start-server
:exec-args {:name "repl"
:port 5555
:accept clojure.core.server/repl
:server-daemon false}}}
}

5
justfile
View File

@ -1,2 +1,3 @@
repl: # start a repl
clj -X clojure.core.server/start-server :name repl :port 5555 :accept clojure.core.server/repl :server-daemon false
# start a repl
repl:
clj -X:repl

22
src/ludus/analyzer.clj
View File

@ -1,22 +0,0 @@
(ns ludus.analyzer
(:require
[ludus.ast :as ast]
[ludus.token :as token]))
(defn analyze [ast] ast)
(comment "
Here's where we do a bunch of static analysis.
Some things we might wish for:
* No unused bindings
* No unbound names
* Compound `loop` and `gen` forms must have LHS's (tuple patterns) of the same length
* Recur must be in tail position in `loop`s
* Tail call optimization for simple recursion (rewrite it as a loop?)
* Check arities for statically known functions
* Enforce single-member tuple after called keywords
* Placeholders may only appear in tuples in synthetic expressions
* Each of these may have zero or one placeholders
* Function arities are correct
* Arity of called keywords must be 1
")

0
src/ludus/ast.clj → src/ludus/ast.cljc
View File

0
src/ludus/collections.clj → src/ludus/collections.cljc
View File

35
src/ludus/compile.clj
View File

@ -1,35 +0,0 @@
(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)
")

39
src/ludus/core.clj
View File

@ -1,39 +0,0 @@
(ns ludus.core
"A tree-walk interpreter for the Ludus language."
(:require
[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]
(let [scanned (scanner/scan source)]
(if (not-empty (:errors scanned))
(do
(println "I found some scanning errors!")
(pp/pprint (:errors scanned))
(System/exit 65))
(let [parsed (p/apply-parser g/script (:tokens scanned))]
(if (p/fail? parsed)
(do
(println "I found some parsing errors!")
(println (p/err-msg parsed))
(System/exit 66))
(let [interpreted (interpreter/interpret source file parsed)]
(println (show/show interpreted))
(System/exit 0)))))))
(defn -main [& args]
(cond
(= (count args) 1)
(let [file (first args)
source (loader/load-import file)]
(run file source))
:else (repl/launch)))

39
src/ludus/core.cljc Normal file
View File

@ -0,0 +1,39 @@
(ns ludus.core
(:require
[ludus.scanner :as scanner]
[ludus.parser :as parser]
[ludus.grammar :as grammar]
[ludus.interpreter :as interpreter]
[ludus.show :as show]
[clojure.pprint :as pp]
))
(println "Hi, there.")
(defn run [source]
(println (str "Running some ludus source: " source))
(let [scanned (scanner/scan source)]
(if (not-empty (:errors scanned))
(do
(println "I found some scanning errors!")
(pp/pprint (:errors scanned))
nil
)
(let [parsed (parser/apply-parser grammar/script (:tokens scanned))]
(if (parser/fail? parsed)
(do
(println "I found some parsing errors!")
(println (parser/err-msg parsed))
nil
)
(let [interpreted (interpreter/interpret source parsed)]
(println (show/show interpreted))
interpreted
))))))
(run "
fn foo () -> :bar
foo ()
")

3
src/ludus/core.cljs
View File

@ -1,3 +0,0 @@
(ns ludus.core)
(println "Hello, world!")

0
src/ludus/data.clj → src/ludus/data.cljc
View File

32
src/ludus/draw.clj
View File

@ -1,32 +0,0 @@
(ns ludus.draw
(:require [quil.core :as q]
[quil.middleware :as m]))
(defn setup []
(q/frame-rate 60)
(q/color-mode :hsb)
{:color 0 :angle 0})
(defn update-state [state]
{:color (mod (+ (:color state) 0.7) 255)
:angle (+ (:angle state) 0.1)})
(defn draw-state [state]
(q/background 240)
(q/fill (:color state) 255 255)
(let [angle (:angle state)
x (* 150 (q/cos angle))
y (* 150 (q/sin angle))]
(q/with-translation [(/ (q/width) 2)
(/ (q/height) 2)]
(q/ellipse x y 100 100))))
(defn ludus-draw []
(q/defsketch sketch
:title "Hello Ludus"
:size [500 500]
:setup setup
:update update-state
:draw draw-state
:features []
:middleware [m/fun-mode]))

53
src/ludus/grammar.clj → src/ludus/grammar.cljc
View File

@ -1,6 +1,13 @@
(ns ludus.grammar
(:require [ludus.parser-new :refer :all]
[ludus.scanner :as scan]))
(:require
#?(
:clj [ludus.parser :refer :all]
:cljs [ludus.parser
:refer [choice quiet one+ zero+ group order-0 order-1 flat maybe weak-order]
:refer-macros [defp]
]
)
))
(declare expression pattern)
@ -275,44 +282,4 @@
(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))
(quiet :eof)])

236
src/ludus/interpreter.clj → src/ludus/interpreter.cljc
View File

@ -1,21 +1,16 @@
(ns ludus.interpreter
(:require
[ludus.parser :as parser]
[ludus.parser-new :as p]
[ludus.parser :as p]
[ludus.grammar :as g]
[ludus.scanner :as scanner]
[ludus.ast :as ast]
[ludus.prelude :as prelude]
[ludus.data :as data]
[ludus.show :as show]
[ludus.loader :as loader]
[ludus.token :as token]
[ludus.process :as process]
;;[ludus.loader :as loader]
[clojure.pprint :as pp]
[clojure.set]
[clojure.string]))
(def ^:dynamic self @process/current-pid)
;; right now this is not very efficient:
;; it's got runtime checking
;; we should be able to do these checks statically
@ -593,30 +588,30 @@
(let [[k v] kv]
[k (f v)]))))
(defn- interpret-import [ast ctx]
(let [data (:data ast)
path (-> data first :data first)
name (-> data second :data first)
file (ludus-resolve :file ctx)
from (if (= ::not-found file) :cwd file)]
(if (contains? @ctx name)
(throw (ex-info (str "Name " name " is alrady bound") {:ast ast}))
(let [source (try
(loader/load-import path from)
(catch Exception e
(if (::loader/error (ex-data e))
(throw (ex-info (ex-message e) {:ast ast}))
(throw e))))
parsed (->> source (scanner/scan) :tokens (p/apply-parser g/script))]
(if (p/fail? parsed)
(throw (ex-info
(str "Parse error in file " path "\n"
(p/err-msg parsed))
{:ast ast}))
(let [interpret-result (interpret-file source path parsed)]
(vswap! ctx update-ctx {name interpret-result})
interpret-result))
))))
; (defn- interpret-import [ast ctx]
; (let [data (:data ast)
; path (-> data first :data first)
; name (-> data second :data first)
; file (ludus-resolve :file ctx)
; from (if (= ::not-found file) :cwd file)]
; (if (contains? @ctx name)
; (throw (ex-info (str "Name " name " is alrady bound") {:ast ast}))
; (let [source (try
; (loader/load-import path from)
; (catch Exception e
; (if (::loader/error (ex-data e))
; (throw (ex-info (ex-message e) {:ast ast}))
; (throw e))))
; parsed (->> source (scanner/scan) :tokens (p/apply-parser g/script))]
; (if (p/fail? parsed)
; (throw (ex-info
; (str "Parse error in file " path "\n"
; (p/err-msg parsed))
; {:ast ast}))
; (let [interpret-result (interpret-file source path parsed)]
; (vswap! ctx update-ctx {name interpret-result})
; interpret-result))
; ))))
(defn- interpret-ref [ast ctx]
(let [data (:data ast)
@ -757,70 +752,9 @@
(vswap! ctx update-ctx {name ns})
ns))))
;; TODO: update this to use new AST representation
(defn- interpret-receive [ast ctx]
(let [process-atom (get @process/processes self)
inbox (promise)
clauses (:clauses ast)]
;; (println "receiving in" self)
(swap! process-atom #(assoc % :inbox inbox :status :idle))
;; (println "awaiting message in" self)
(let [msg @inbox]
(swap! process-atom #(assoc % :status :occupied))
;; (println "message received by" self ":" msg)
(loop [clause (first clauses)
clauses (rest clauses)]
(if clause
(let [pattern (:pattern clause)
body (:body clause)
new-ctx (volatile! {::parent ctx})
match? (match pattern msg new-ctx)
success (:success match?)
clause-ctx (:ctx match?)]
(if success
(do
(vswap! new-ctx #(merge % clause-ctx))
(let [result (interpret-ast body new-ctx)]
(swap! process-atom #(assoc % :status :idle))
result))
(recur (first clauses) (rest clauses))))
(throw (ex-info "Match Error: No match found" {:ast ast})))))))
;; TODO: update send to be a function (here or in prelude)
(defn- interpret-send [ast ctx]
(let [msg (interpret-ast (:msg ast) ctx)
pid (interpret-ast (:pid ast) ctx)
process-atom (get @process/processes pid)
process @process-atom
q (:queue process)
status (:status process)]
(when (not (= :dead status))
(swap! process-atom #(assoc % :queue (conj q msg)))
(Thread/sleep 1) ;; this is terrible--but it avoids deadlock
;;TODO: actually debug this?
;;THOUGHT: is swap! returning before the value is actually changed? Clojure docs say atoms are synchronous
)
msg))
(defn- interpret-spawn [ast ctx]
(let [expr (-> ast :data first)
process (process/new-process)
pid (:pid @process)]
(with-bindings {#'self pid}
(future
(try (interpret-ast expr ctx)
(catch Exception e
(println "Panic in Ludus process" (str self ":") (ex-message e))
;; (pp/pprint (ex-data e))
(println "On line" (get-in (ex-data e) [:ast :token ::token/line]) "in" (ludus-resolve :file ctx))))
(swap! process #(assoc % :status :dead))))
pid))
(defn- interpret-literal [ast] (-> ast :data first))
(defn interpret-ast [ast ctx]
;(println "interpreting ast type" (:type ast))
;(println "AST: " ast)
(case (:type ast)
(:nil :true :false :number :string :keyword) (interpret-literal ast)
@ -845,16 +779,12 @@
:ns-expr (interpret-ns ast ctx)
:import-expr (interpret-import ast ctx)
;; :import-expr (interpret-import ast ctx)
:ref-expr (interpret-ref ast ctx)
:when-expr (interpret-ast (-> ast :data first) ctx)
; ::ast/spawn (interpret-spawn ast ctx)
; ::ast/receive (interpret-receive ast ctx)
:recur-call
{::data/recur true :args (interpret-ast (-> ast :data first) ctx)}
@ -899,99 +829,29 @@
(clojure.string/trim (nth lines (dec line))))))
;; TODO: update this to use new parser pipeline & new AST representation
(defn interpret-file [source path parsed]
(try
(let [base-ctx (volatile! {::parent (volatile! prelude/prelude) :file path})]
; (defn interpret-file [source path parsed]
; (try
; (let [base-ctx (volatile! {::parent (volatile! prelude/prelude) :file path})]
; (interpret-ast parsed base-ctx))
; (catch clojure.lang.ExceptionInfo e
; (println "Ludus panicked in" path)
; (println "On line" (get-in (ex-data e) [:ast :token :line]))
; (println ">>> " (get-line source (get-in (ex-data e) [:ast :token :line])))
; (println (ex-message e))
; (System/exit 67))))
;; TODO: update this to use new parser pipeline & new AST representation
(defn interpret [source parsed]
(try
(let [base-ctx (volatile! {::parent (volatile! prelude/prelude)})]
(interpret-ast parsed base-ctx))
(catch clojure.lang.ExceptionInfo e
(println "Ludus panicked in" path)
(println "Ludus panicked!")
(println "On line" (get-in (ex-data e) [:ast :token :line]))
(println ">>> " (get-line source (get-in (ex-data e) [:ast :token :line])))
(println (ex-message e))
(System/exit 67))))
;; TODO: update this to use new parser pipeline & new AST representation
(defn interpret [source path parsed]
(try
(let [base-ctx (volatile! {::parent (volatile! prelude/prelude) :file path})
process (process/new-process)]
(process/start-vm)
(with-bindings {#'self (:pid @process)}
(let [result (interpret-ast parsed base-ctx)]
(swap! process #(assoc % :status :dead))
(process/stop-vm)
result)))
(catch clojure.lang.ExceptionInfo e
(println "Ludus panicked in" path)
(println "On line" (get-in (ex-data e) [:ast :token :line]))
(println ">>> " (get-line source (get-in (ex-data e) [:ast :token :line])))
(println (ex-message e))
(System/exit 67))))
(defn interpret-safe [parsed]
(try
(let [base-ctx (volatile! {::parent (volatile! prelude/prelude)})
process (process/new-process)]
(process/start-vm)
(with-bindings {#'self (:pid @process)}
(let [result (interpret-ast parsed base-ctx)]
(swap! process #(assoc % :status :dead))
(process/stop-vm)
result)))
(catch clojure.lang.ExceptionInfo e
(process/stop-vm)
(println "Ludus panicked on line " (get-in (ex-data e) [:ast :token :line]))
(println "> " (get-in (ex-data e) [:ast :token]))
(println (ex-message e))
;(pp/pprint (ex-data e))
)))
;; TODO: update this to use new parser pipeline & new AST representation
(defn interpret-repl
([parsed ctx]
(let [orig-ctx @ctx
process (process/new-process)
pid (:pid @process)]
(try
(process/start-vm)
(with-bindings {#'self pid}
(let [result (interpret-ast parsed ctx)]
{:result result :ctx ctx :pid pid}))
(catch clojure.lang.ExceptionInfo e
(println "Ludus panicked!")
(println (ex-message e))
{:result :error :ctx (volatile! orig-ctx) :pid pid}))))
([parsed ctx pid]
(let [orig-ctx @ctx]
(try
(process/start-vm)
(with-bindings {#'self pid}
(let [result (interpret-ast parsed ctx)]
{:result result :ctx ctx :pid pid}))
(catch clojure.lang.ExceptionInfo e
(println "Ludus panicked!")
(println (ex-message e))
{:result :error :ctx (volatile! orig-ctx) :pid pid}
)))))
(comment
(def source "
let 2 = 1
")
(println "")
(println "****************************************")
(println "*** *** NEW INTERPRETATION *** ***")
(println "")
(let [result (->> source
scanner/scan
:tokens
(p/apply-parser g/script)
interpret-safe
show/show
)]
(println result)
result))
(pp/pprint (ex-data e)
;;(System/exit 67)
))))
(+ 1 2)

38
src/ludus/interpreter_new.clj
View File

@ -1,38 +0,0 @@
(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
))

16
src/ludus/loader.clj
View File

@ -1,16 +0,0 @@
(ns ludus.loader
(:require [babashka.fs :as fs]))
(defn cwd [] (fs/cwd))
(defn load-import
([file]
(let [path (-> file (fs/canonicalize) (fs/file))]
(try (slurp path)
(catch java.io.FileNotFoundException _
(throw (ex-info (str "File " path " not found") {:path path ::error true}))))))
([file from]
(load-import
(fs/path
(if (= from :cwd) (fs/cwd) (fs/parent (fs/canonicalize from)))
(fs/path file)))))

135
src/ludus/ludus.ebnf
View File

@ -1,135 +0,0 @@
(*
ludus.ebnf
An Instaparse-style EBNF grammer for Ludus.
*)
script = <wsnl?> toplevel <ws?> {<terminator> <ws?> toplevel <ws?>} <wsnl?>
terminator = (";" | <{comment}> "\n")+
ws = (" " | "\t" | "\r")+
wsnl = (ws | <{comment}> "\n")+
reserved = "cond" | "let" | "if" | "then" | "else" | "nil" | "true" | "false" | "as" | "match" | "with" | "NaN" | "recur"
comment = "&" not_nl*
not_nl = #"[^\n]"
toplevel = expression | import | test | ns
test = <"test" ws> string <ws> expression
import = <"import" ws> string <ws "as" ws> name
ns = <"ns" ws> name <ws? "{" wsnl?> entries <wsnl? "}">
entries = [(name | entry) {<separator> [(name | entry)]}]
expression = if | cond | let | tuple | atom | synthetic | block | match | fn | do | loop | dict | struct | list | ref | spawn | send | receive | repeat
(* TODO: is this right? *)
repeat = <"repeat" ws> (number | name) <ws> fn_clause
spawn = <"spawn" ws> expression
receive = <"receive" ws? "{" wsnl?> match_clause {terminator <ws?> [match_clause]} <wsnl? "}">
ref = <"ref" ws> name <ws? "=" ws?> expression
loop = <"loop" ws> tuple <ws "with" ws> (fn_clause
| (<"{" wsnl?> fn_clause {terminator <ws?> [fn_clause]} <wsnl? "}">))
do = <"do" ws> expression {<pipe> expression}
pipe = wsnl? "|>" wsnl?
fn = lambda | named | complex
lambda = <"fn" ws?> fn_clause
named = <"fn" ws?> name <ws> fn_clause
complex = <"fn" ws?> name <ws?> "{" <wsnl?> string? <wsnl> fn_clause {terminator <ws?> [fn_clause]} <wsnl? "}">
fn_clause = tuple_pattern <arrow> expression
match = <"match" ws> expression <ws "with" ws? "{" wsnl?> match_clause {terminator <ws?> [match_clause]} <wsnl? "}">
match_clause = pattern constraint? <arrow> expression
constraint = <"when" ws> expression
let = <"let" ws> pattern <ws "=" wsnl> expression
pattern = tuple_pattern | atom | placeholder | "else" | splattern
tuple_pattern = <"(" wsnl?> [pattern {<separator> [pattern]}] <{separator} ws? ")">
struct_pattern = <"@{" wsnl?> [(name | pattern_entry | splattern) {<separator> [(name | pattern_entry | splattern)]}] <{separator} ws? "}">
dict_pattern = <"#{" wsnl?> [(name | pattern_entry | splattern) {<separator> [(name | pattern_entry | splattern)]}] <{separator} ws? "}">
pattern_entry = keyword <ws> pattern
splattern = <"..."> name | ignored | placeholder
block = <"{" wsnl?> expression {<terminator ws?> expression <ws?>} <wsnl? "}">
cond = "cond" <ws> expression <ws? "{" wsnl?> cond_clause {terminator <ws?> [cond_clause]} <wsnl? "}">
cond_clause = expression <arrow> expression
arrow = <ws? "->" wsnl?>
if = <"if" ws> expression <wsnl "then" ws> expression <wsnl> <"else" ws> expression
synthetic = (name | keyword | recur) ((<ws?> (args | keyword))+)
recur = <"recur">
separator = <ws?> ("," | "\n") <ws?>
args = <"(" ws? {separator}> [arg_expr {<separator> [arg_expr]}] <{separator} ws? ")">
arg_expr = expression | placeholder
placeholder = <"_">
tuple = <"(" wsnl?> [expression {<separator> [expression]}] <{separator} ws? ")">
list = <"[" wsnl?> [(expression | splat) {<separator> [(expression | splat)]}] <{separator} ws? "]">
struct = <"@{" wsnl?> [(name | entry) {<separator> [(name | entry)]}] <{separator} ws? "}">
dict = <"#{" wsnl?> [(name | entry | splat) {<separator> [(name | entry | splat)]}] <{separator} ws? "}">
entry = keyword <ws> expression
splat = <"..."> name
atom = name | ignored | keyword | number | string | boolean | nil
boolean = true | false
true = <"true">
false = <"false">
nil = <"nil">
string = <'"'> {escaped_quote | nonquote} <'"'>
escaped_quote = "\\" '\"'
nonquote = #'[^"]'
keyword = #":[a-zA-Z][a-zA-Z0-9\/\-_!\*\?]*"
ignored = #"_[a-z][a-zA-Z0-9\/\-_!\*\?]*"
name = !reserved #"[a-z][a-zA-Z0-9\/\-_!\*\?]*"
(* TODO: Debug this to reject things starting with 0, eg 012. *)
number = #"\-?[1-9][0-9]*" | #"\-?(0|[1-9][0-9]*).[0-9]+" | ["-"] "0" | "NaN"

1279
src/ludus/parser.clj
View File

File diff suppressed because it is too large Load Diff

22
src/ludus/parser_new.clj → src/ludus/parser.cljc
View File

@ -1,4 +1,4 @@
(ns ludus.parser-new)
(ns ludus.parser)
(defn ? [val default] (if (nil? val) default val))
@ -48,7 +48,7 @@
(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")))]
:else (throw (ex-info "`apply-parser` requires a parser" {})))]
;(println "Parser result " (? (:name parser) parser) (:status result))
result
))
@ -314,21 +314,3 @@
(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))

0
src/ludus/prelude.clj → src/ludus/prelude.cljc
View File

96
src/ludus/process.clj
View File

@ -1,96 +0,0 @@
(ns ludus.process
(:require
[ludus.data :as data])
(:import (java.util.concurrent Executors)))
;; virtual thread patch from https://ales.rocks/notes-on-virtual-threads-and-clojure
(defn- thread-factory [name]
(-> (Thread/ofVirtual)
(.name name 0)
(.factory)))
(set-agent-send-off-executor!
(Executors/newThreadPerTaskExecutor
(thread-factory "ludus-vthread-")))
(def processes (atom {}))
(def current-pid (atom 1001))
(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))
(def vm-state (atom :stopped))
(defn- values [m] (into [] (map (fn [[_ v]] v)) m))
(defn- map-values [m f] (into {} (map (fn [[k v]] [k (f v)])) m))
(defn process-msg [process]
;;(println "processing message" self)
(let [q (:queue process)
inbox (:inbox process)]
(when (not (realized? inbox))
;;(println "delivering message in" self)
(deliver inbox (peek q))
(assoc process :queue (pop q) :inbox nil))))
(defn run-process [process-atom]
(let [process @process-atom
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))))
(defn start-vm []
;; (println "Starting Ludus VM")
(when (= @vm-state :stopped)
(future
(reset! vm-state :running)
(loop []
(when (= @vm-state :running)
(run! run-process (values @processes))
(recur)
;; (println "Ludus VM shutting down")
)))))
(defn stop-vm []
(reset! vm-state :stopped)
(reset! processes {})
(reset! current-pid 1001)
nil)
(def process {"process" {
::data/struct true
::data/type ::data/ns
::data/name "process"
"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)))}
"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))}
}})

124
src/ludus/repl.clj
View File

@ -1,124 +0,0 @@
(ns ludus.repl
(:require
[ludus.scanner :as scanner]
;[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]
))
(declare repl-prelude new-session)
(def sessions (atom {}))
(def current-session (atom nil))
(def prompt "=> ")
(defn- exit []
(println "\nGoodbye!")
(System/exit 0))
(def base-ctx (merge prelude/prelude ;process/process
{::repl true
"repl"
{::data/struct true
::data/type ::data/ns
::data/name "repl"
:flush
{:name "flush"
::data/type ::data/clj
:body (fn
([]
(let [session @current-session]
(swap! session #(assoc % :ctx (volatile! base-ctx)))
:ok))
([name]
(if-let [session (get @sessions name)]
(do
(swap! session #(assoc % :ctx (volatile! base-ctx)))
:ok)
(do
(println "No session named" name)
:error))))}
:new
{:name "new"
::data/type ::data/clj
:body (fn [name]
(let [session (new-session name)]
(reset! current-session session)
:ok))}
:switch
{:name "switch"
::data/type ::data/clj
:body (fn [name]
(if-let [session (get @sessions name)]
(do
(reset! current-session session)
:ok)
(do
(println "No session named" name)
:error)))}
:quit
{:name "quit"
::data/type ::data/clj
:body (fn [] (exit))}
}}))
(defn- new-session [name]
(let [session (atom {:name name
:ctx (volatile! base-ctx)
:history []})]
(swap! sessions #(assoc % name session))
session))
(defn repl-loop []
(let [session-atom @current-session
session @session-atom
orig-ctx (:ctx session)
pid (:pid session)]
(print (str (:name session) prompt))
(flush)
(let [input (read-line)]
(cond
(= nil input) (exit)
(= "" input) (recur)
:else
(let [parsed (->> input
(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
(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)")
(let [session (new-session :ludus)]
(reset! current-session session)
(repl-loop)))

2
src/ludus/scanner.clj → src/ludus/scanner.cljc
View File

@ -181,7 +181,7 @@
interpolate? false]
(let [char (current-char scanner)]
(case char
\{ (recur (update (advance scanner)) (str string char) true)
\{ (recur (advance scanner) (str string char) true)
; allow multiline strings
\newline (recur (update (advance scanner) :line inc) (str string char) interpolate?)
\" (if interpolate?

0
src/ludus/show.clj → src/ludus/show.cljc
View File

0
src/ludus/token.clj → src/ludus/token.cljc
View File