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

Make lots and lots of progress; discover error in pattern matching.

Browse Source
This commit is contained in:
Scott Richmond 2023-12-02 16:14:57 -05:00
parent 4a84afc971
commit ab48dfa6b3
3 changed files with 369 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/ludus/base.cljc
View File

@ -66,18 +66,22 @@
(def not- {:name "not"
::data/type ::data/clj
:body not})
(def panic! {:name "panic!"
::data/type ::data/clj
:body (fn [& args] (throw (ex-info (apply show/show (interpose " " args)) {})))})
(defn- print-show [lvalue]
(if (string? lvalue) lvalue (show/show lvalue)))
(defn- stringify-args [arglist]
(apply str (interpose " " (into [] (map print-show) (rest arglist)))))
(def panic! {:name "panic!"
::data/type ::data/clj
:body (fn panic-inner
([] (panic-inner [::data/list]))
([args] (throw (ex-info (stringify-args args) {}))))})
(def print- {:name "print"
::data/type ::data/clj
:body (fn [& args]
(println (apply str (into [] (map print-show) args)))
:body (fn [args]
(println (stringify-args args))
:ok)})
(def deref- {:name "deref"
@ -106,6 +110,10 @@
::data/type ::data/clj
:body assoc})
(def dissoc- {name "dissoc"
::data/type ::data/clj
:body dissoc})
(def get- {:name "get"
::data/type ::data/clj
:body (fn
@ -304,6 +312,7 @@
:and and-
:or or-
:assoc assoc-
:dissoc dissoc-
:conj conj-
:get get-
:type type-

61
src/ludus/interpreter.cljc
View File

@ -13,6 +13,15 @@
[clojure.set]
[clojure.string]))
(defn prettify-ast [ast]
(cond
(not (map? ast)) ast
(not (:data ast)) (dissoc ast :remaining :token)
:else (let [{:keys [type data]} ast]
{:type type ;:token token
:data (into [] (map prettify-ast) data)})
))
;; right now this is not very efficient:
;; it's got runtime checking
;; we should be able to do these checks statically
@ -59,15 +68,22 @@
(if (:success match?)
(do
(vswap! ctx-diff #(merge % (:ctx match?)))
(println "current context: " (dissoc @ctx-diff ::parent))
;(println "current context: " (dissoc @ctx-diff ::parent))
(recur (inc i)))
{:success :false :reason (str "Could not match " pattern " with " value)}
{:success :false :reason (str "Could not match " pattern " with " (show/show value))}
)))))))
;; Match-tuple is misbehaving when the first value is a function and the second is a list
;; Hangs on success!
;; printlns at top run just fine
;; println at top of :else - loop happens once
;; println in :else - loop - if - let binding match? does not happen
;; that suggets that match is hanging here
(defn- match-tuple [pattern value ctx-vol]
;(println "\n\n\n**********Matching tuple")
;(println "*****Value: " value)
;(println "*****Pattern: " pattern)
(println "\n\n\n**********Matching tuple")
(println "*****Value: " (show/show value))
(println "*****Pattern: " (prettify-ast pattern))
(let [members (:data pattern)
length (count members)]
(cond
@ -86,9 +102,11 @@
:else
(let [ctx-diff (volatile! @ctx-vol)]
(loop [i length]
(println "Matching tuple elements at index " i)
(if (= 0 i)
{:success true :ctx @ctx-diff}
(let [match? (match (nth members (dec i)) (nth value i) ctx-diff)]
(println "Maybe a match?: " match?)
(if (:success match?)
(do
(vswap! ctx-diff #(merge % (:ctx match?)))
@ -688,7 +706,7 @@
(interpret-ast body new-ctx)))
(recur (first clauses) (rest clauses))))
(throw (ex-info (str "Match Error: No match found in loop for " input) {:ast ast}))))]
(throw (ex-info (str "Match Error: No match found in loop for " (show/show input)) {:ast ast}))))]
(if (::data/recur output)
(recur (:args output))
output)))))
@ -854,7 +872,7 @@
:struct-literal
(interpret-struct ast ctx)
(throw (ex-info (str "Unknown AST node type: " (:type ast)) {:ast ast}))))
(throw (ex-info (str "Unknown AST node type " (get ast :type :err) " on line " (get-in ast [:token :line])) {:ast ast}))))
(defn get-line [source line]
(if line
@ -909,16 +927,16 @@
; (System/exit 67))))
; ;; TODO: update this to use new parser pipeline & new AST representation
; (defn interpret-repl
; ([parsed ctx]
; (let [orig-ctx @ctx]
; (try
; (let [result (interpret-ast parsed ctx)]
; {:result result :ctx ctx})
; (catch clojure.lang.ExceptionInfo e
; (println "Ludus panicked!")
; (println (ex-message e))
; {:result :error :ctx (volatile! orig-ctx)})))))
(defn interpret-repl
([parsed ctx]
(let [orig-ctx @ctx]
(try
(let [result (interpret-ast parsed ctx)]
{:result result :ctx ctx})
(catch #?(:clj Throwable :cljs js/Object) e
(println "Ludus panicked!")
(println (ex-message e))
{:result :error :ctx (volatile! orig-ctx)})))))
(defn interpret-safe [source parsed ctx]
(try
@ -933,15 +951,6 @@
(throw e)
)))
(defn prettify-ast [ast]
(cond
(not (map? ast)) ast
(not (:data ast)) (dissoc ast :remaining :token)
:else (let [{:keys [type data]} ast]
{:type type ;:token token
:data (into [] (map prettify-ast) data)})
))
;; repl
(comment

335
src/ludus/prelude.ld
View File

@ -1,8 +1,9 @@
& this file, uniquely, gets `base` loaded as context. See src/ludus/base.cljc for exports
fn rest {
"Returns all but the first element of a list, as a list."
(xs as :list) -> base :rest (xs)
"Returns all but the first element of a list or tuple, as a list."
(xs as :list) -> base :rest (xs)
(xs as :tuple) -> base :rest (xs)
}
fn inc {
@ -77,17 +78,9 @@ fn conj {
(xs as :set, x) -> base :conj (xs, x)
}
fn add {
"Adds numbers."
() -> 0
(x as :number) -> x
(x as :number, y as :number) -> base :add (x, y)
(x as :number, y as :number, ...zs) -> fold (base :add, add (x, y), zs)
}
fn print {
"Sends a text representation of a Ludus value to stdout."
(x) -> base :print (x)
"Sends a text representation of Ludus values to the console."
(...args) -> base :print (args)
}
fn show {
@ -119,7 +112,16 @@ fn report {
print (x)
x
}
(msg as :string, x) -> print (concat (msg, show (x)))
(msg as :string, x) -> {
print (concat (msg, show (x)))
x
}
}
fn ref? {
"Returns true if a value is a ref."
(r as :ref) -> true
(_) -> false
}
fn deref {
@ -132,6 +134,281 @@ fn set! {
(r as :ref, value) -> base :set! (r, value)
}
fn update! {
"Updates a ref by applying a function to its value. Returns the new value."
(r as :ref, f as :fn) -> {
let current = deref (r)
let new = f (current)
set! (r, new)
}
}
fn number? {
"Returns true if a value is a number."
(x as :number) -> true
(_) -> false
}
fn add {
"Adds numbers or vectors."
() -> 0
(x as :number) -> x
(x as :number, y as :number) -> base :add (x, y)
(x, y, ...zs) -> fold (base :add, zs, base :add (x, y))
& add vectors
((x1, y1), (x2, y2)) -> (base :add (x1, y1), base :add (x2, y2))
}
fn sub {
"Subtracts numbers or vectors."
() -> 0
(x as :number) -> x
(x as :number, y as :number) -> base :sub (x, y)
(x, y, ...zs) -> fold (base :sub, zs, base :sub (x, y))
((x1, y1), (x2, y2)) -> (base :sub (x1, x2), base :sub (x2, y2))
}
fn mult {
"Multiplies numbers or vectors."
() -> 1
(x as :number) -> x
(x as :number, y as :number) -> base :mult (x, y)
(x, y, ...zs) -> fold (base :mult, mult (x, y), zs)
(scalar as :number, (x, y)) -> (mult (x, scalar), mult (y, scalar))
((x, y), scalar as :number) -> mult (scalar, (x, y))
}
fn div {
"Divides numbers. Panics on division by zero."
(x as :number) -> x
(_, 0) -> panic! ("Division by zero.")
(x as :number, y as :number) -> base :div (x, y)
(x, y, ...zs) -> {
let divisor = fold (mult, zs, y)
div (x, divisor)
}
}
fn div/0 {
"Divides number. Returns 0 on division by zero."
(x as :number) -> x
(_, 0) -> 0
(x as :number, y as :number) -> base :div (x, y)
(x, y, ...zs) -> {
let divisor = fold (mult, zs, y)
div/0 (x, divisor)
}
}
fn zero? {
"Returns true if a number is 0."
(0) -> true
(_) -> false
}
fn eq? {
"Returns true if all arguments have the same value."
(x) -> true
(x, y) -> base :eq (x, y)
(x, y, ...zs) -> loop (y, zs) with {
(a, [b]) -> base :eq (a, b)
(a, [b, ...cs]) -> if base :eq (a, b)
then recur (b, cs)
else false
}
}
fn gt? {
"Returns true if numbers are in decreasing order."
(x as :number) -> true
(x as :number, y as :number) -> base :gt (x, y)
(x, y, ...zs) -> loop (y, zs) with {
(a, [b]) -> base :gt (a, b)
(a, [b, ...cs]) -> if base :gt (a, b)
then recur (b, cs)
else false
}
}
fn gte? {
"Returns true if numbers are in decreasing or flat order."
(x as :number) -> true
(x as :number, y as :number) -> base :gte (x, y)
(x, y, ...zs) -> loop (y, zs) with {
(a, [b]) -> base :gte (a, b)
(a, [b, ...cs]) -> if base :gte (a, b)
then recur (b, cs)
else false
}
}
fn lt? {
"Returns true if numbers are in increasing order."
(x as :number) -> true
(x as :number, y as :number) -> base :lt (x, y)
(x, y, ...zs) -> loop (y, zs) with {
(a, [b]) -> base :lt (a, b)
(a, [b, ...cs]) -> if base :lt (a, b)
then recur (b, cs)
else false
}
}
fn lte? {
"Returns true if numbers are in increasing or flat order."
(x as :number) -> true
(x as :number, y as :number) -> base :lte (x, y)
(x, y, ...zs) -> loop (y, zs) with {
(a, [b]) -> base :lte (a, b)
(a, [b, ...cs]) -> if base :lte (a, b)
then recur (b, cs)
else false
}
}
fn neg? {
"Returns true if a value is a negative number, otherwise returns false."
(x as :number) if lt? (x, 0) -> true
(_) -> false
}
fn pos? {
"Returns true if a value is a positive number, otherwise returns false."
(x as :number) if gt? (x, 0) -> true
(_) -> false
}
fn nil? {
"Returns true if a value is nil."
(nil) -> true
(_) -> false
}
fn bool? {
"Returns true if a value is of type :boolean."
(false) -> true
(true) -> true
(_) -> false
}
fn bool {
"Returns false if a value is nil or false, otherwise returns true."
(nil) -> false
(false) -> false
(_) -> true
}
fn not {
"Returns false if a value is truthy, true if a value is falsy."
(nil) -> true
(false) -> true
(_) -> false
}
& TODO: make `and` and `or` special forms which lazily evaluate arguments
fn and {
"Returns true if all values passed in are truthy."
() -> true
(x) -> bool (x)
(x, y) -> base :and (x, y)
(x, y, ...zs) -> fold (base :and, zs, base :and (x, y))
}
fn or {
"Returns true if any value passed in is truthy."
() -> true
(x) -> bool (x)
(x, y) -> base :or (x, y)
(x, y, ...zs) -> fold (base :or, zs, base :or (x, y))
}
fn assoc {
"Takes a dict, key, and value, and returns a new dict with the key set to value."
(d as :dict) -> d
(d as :dict, key as :keyword, value) -> base :assoc (d, key, value)
(d as :dict, (key as :keyword, value)) -> base :assoc (d, key, value)
}
fn dissoc {
"Takes a dict and a key, and returns a new dict with the key and associated value omitted."
(d as :dict) -> d
(d as :dict, key as :keyword) -> base :dissoc (d, key)
}
fn coll? {
"Returns true if a value is a collection: dict, struct, list, tuple, or set."
(coll as :dict) -> true
(coll as :struct) -> true
(coll as :list) -> true
(coll as :tuple) -> true
(coll as :set) -> true
(_) -> false
}
fn ordered? {
"Returns true if a value is an indexed collection: list or tuple."
(coll as :list) -> true
(coll as :tuple) -> true
(_) -> false
}
fn assoc? {
"Returns true if a value is an associative collection: a dict, struct, or namespace."
(assoc as :dict) -> true
(assoc as :struct) -> true
(assoc as :ns) -> true
(_) -> false
}
fn get {
"Takes a dict or struct, key, and optional default value; returns the value at key. If the value is not found, returns nil or the default value. Returns nil or default if the first argument is not a dict or struct."
(key as :keyword, coll) -> base :get (key, coll)
(key as :keyword, coll, default) -> base :get (key, coll, default)
}
& TODO: make this less awkward once we have tail recursion
&&&&&&&&& TODO:
&& Fix bug here:
&& The second pattern in `each` and `foo` hangs when the first argument is a function
&& But maybe not other kinds of values (works fine if it's a keyword)
&& See interpreter.cljc line 76 for more info.
fn each {
"Takes a list and applies a function, presumably with side effects, to each element in the list. Returns nil."
(f as :fn, []) -> :empty
(f, [x]) -> :one
(f, [...xs]) -> :more
}
fn foo {
&(h, []) -> :empty
(h, [x]) -> :one
(h, [...xs]) -> :more
}
fn panic! {
"Causes Ludus to panic, outputting any arguments as messages."
() -> base :panic! ()
(...args) -> base :panic! (args)
}
& base turtle graphics
& forward, fd (pixels)
& back, bk (pixels)
& left, lt (turns)
& right, rt (turns)
& penup, pu ()
& pendown, pd ()
& pencolor, pc (color)
& penwidth (pixels)
& clear ()
& goto ((x, y))
& home ()
& turtlestate () -> @{:position (x, y), :heading turns, :visible boolean, :pen penstate}
& position () -> (x, y)
& turtleheading () -> turns
& penstate () -> @{:down :boolean, :color (r, g, b, a), :width pixels}
ns prelude {
first
second
@ -144,7 +421,6 @@ ns prelude {
list
inc
dec
add
print
show
prn
@ -153,6 +429,31 @@ ns prelude {
concat
deref
set!
}
prelude
add
sub
mult
div
div/0
zero?
neg?
pos?
eq?
gt?
gte?
lt?
lte?
nil?
bool?
bool
not
and
or
coll?
ordered?
assoc?
assoc
get
each
panic!
foo
}