Fix anonymous fn bug

This commit is contained in:
Scott Richmond 2023-12-03 21:10:22 -05:00
parent 314101d17d
commit 30fa4e9d97
2 changed files with 125 additions and 58 deletions

View File

@ -598,7 +598,7 @@
(defn- interpret-fn [ast ctx] (defn- interpret-fn [ast ctx]
(let [data (:data ast)] (let [data (:data ast)]
(case (:type (first data)) (case (:type (first data))
:fn-clause (build-fn ast ctx :anon (-> data first :data)) :fn-clause (build-fn ast ctx :anon [(-> data first :data)])
:word (build-named-fn ast ctx data)))) :word (build-named-fn ast ctx data))))
(defn- interpret-do [ast ctx] (defn- interpret-do [ast ctx]
@ -954,20 +954,16 @@
;; repl ;; repl
(comment (comment
(def source "fn foo { (def source "fn foo () -> :foo")
\"Docstring\"
() -> :foo
(foo) -> :bar
}")
(def tokens (-> source scanner/scan :tokens)) (def tokens (-> source scanner/scan :tokens))
(def ast (p/apply-parser g/script tokens)) (def ast (p/apply-parser g/fn-named tokens))
;(def result (interpret-safe source ast {})) ;(def result (interpret-safe source ast {}))
(-> ast prettify-ast println) (-> ast prettify-ast println)
(-> ast show/show-pattern println) ;(-> ast show/show-pattern println)
) )

View File

@ -54,6 +54,12 @@ fn list {
(x) -> base :to_list (x) (x) -> base :to_list (x)
} }
fn set {
"Takes an ordered collection--list or tuple--and turns it into a set."
(xs as :list) -> base :into (${}, xs)
(xs as :tuple) -> base :into (${}, xs)
}
fn fold { fn fold {
"Folds a list." "Folds a list."
(f as :fn, xs as :list) -> fold (f, xs, f ()) (f as :fn, xs as :list) -> fold (f, xs, f ())
@ -70,13 +76,13 @@ fn fold {
fn map { fn map {
"Maps over a list." "Maps over a list."
(f as :fn, xs) -> { (f as :fn, xs) -> {
fn mapper (prev, curr) -> conj (prev, f (curr)) fn mapper (prev, curr) -> append (prev, f (curr))
fold (mapper, xs, []) fold (mapper, xs, [])
} }
} }
fn conj { fn append {
"Adds an element to a list or set. Short for conjoin." "Adds an element to a list or set."
() -> [] () -> []
(xs as :list) -> xs (xs as :list) -> xs
(xs as :list, x) -> base :conj (xs, x) (xs as :list, x) -> base :conj (xs, x)
@ -135,9 +141,9 @@ fn deref {
(r as :ref) -> base :deref (r) (r as :ref) -> base :deref (r)
} }
fn set! { fn make! {
"Sets the value of a ref." "Sets the value of a ref."
(r as :ref, value) -> base :set! (r, value) (r as :ref, value) -> base :make! (r, value)
} }
fn update! { fn update! {
@ -145,7 +151,7 @@ fn update! {
(r as :ref, f as :fn) -> { (r as :ref, f as :fn) -> {
let current = deref (r) let current = deref (r)
let new = f (current) let new = f (current)
set! (r, new) make! (r, new)
} }
} }
@ -162,7 +168,7 @@ fn add {
(x as :number, y as :number) -> base :add (x, y) (x as :number, y as :number) -> base :add (x, y)
(x, y, ...zs) -> fold (base :add, zs, base :add (x, y)) (x, y, ...zs) -> fold (base :add, zs, base :add (x, y))
& add vectors & add vectors
((x1, y1), (x2, y2)) -> (base :add (x1, y1), base :add (x2, y2)) ((x1, y1), (x2, y2)) -> (add (x1, x2), add (y1, y2))
} }
fn sub { fn sub {
@ -350,14 +356,15 @@ fn or {
(x, y, ...zs) -> fold (base :or, zs, base :or (x, y)) (x, y, ...zs) -> fold (base :or, zs, base :or (x, y))
} }
fn set { fn assoc {
"Takes a dict, key, and value, and returns a new dict with the key set to value." "Takes a dict, key, and value, and returns a new dict with the key set to value."
() -> #{}
(dict as :dict) -> dict (dict as :dict) -> dict
(dict as :dict, key as :keyword, value) -> base :assoc (dict, key, value) (dict as :dict, key as :keyword, value) -> base :assoc (dict, key, value)
(dict as :dict, (key as :keyword, value)) -> base :assoc (dict, key, value) (dict as :dict, (key as :keyword, value)) -> base :assoc (dict, key, value)
} }
fn unset { fn dissoc {
"Takes a dict and a key, and returns a new dict with the key and associated value omitted." "Takes a dict and a key, and returns a new dict with the key and associated value omitted."
(dict as :dict) -> dict (dict as :dict) -> dict
(dict as :dict, key as :keyword) -> base :dissoc (dict, key) (dict as :dict, key as :keyword) -> base :dissoc (dict, key)
@ -369,6 +376,30 @@ fn update {
(dict as :dict, key as :keyword, updater as :fn) -> base :assoc (dict, key, updater (get (key, dict))) (dict as :dict, key as :keyword, updater as :fn) -> base :assoc (dict, key, updater (get (key, dict)))
} }
fn keys {
"Takes an associative collection and returns a list of keys in that collection. Returns an empty list on anything other than a collection."
(coll) -> if not (assoc? (coll))
then []
else do coll > list > map (first, _)
}
fn values {
"Takes an associative collection and returns a list of values in that collection. Returns an empty list on anything other than a collection."
(coll) -> if not (assoc? (coll))
then []
else do coll > list > map (second, _)
}
fn diff {
"Takes two associate data structures and returns a dict describing their differences. Does this shallowly, offering diffs only for keys in the original dict."
(d1 as :dict, d2 as :dict) -> {
let key1 = keys (d1)
let key2 = keys (d2)
let all = do concat (d1, d2) > set > list
let diffs = fold ()
}
}
fn coll? { fn coll? {
"Returns true if a value is a collection: dict, struct, list, tuple, or set." "Returns true if a value is a collection: dict, struct, list, tuple, or set."
(coll as :dict) -> true (coll as :dict) -> true
@ -401,10 +432,12 @@ fn get {
} }
fn dict { fn dict {
"Takes a struct or ns, and returns it as a dict. Returns dicts unharmed." "Takes a struct or ns, and returns it as a dict. Or, takes a list or tuple of (key, value) tuples and returns it as a dict. Returns dicts unharmed."
(struct as :struct) -> base :to_dict (struct) (struct as :struct) -> base :to_dict (struct)
(ns_ as :ns) -> base :to_dict (ns_) (ns_ as :ns) -> base :to_dict (ns_)
(dict as :dict) -> dict (dict as :dict) -> dict
(list as :list) -> fold (assoc, list)
(tup as :tuple) -> do tup > list > dict
} }
& TODO: make this less awkward once we have tail recursion & TODO: make this less awkward once we have tail recursion
@ -430,15 +463,7 @@ fn doc! {
(_) -> :none (_) -> :none
} }
& math operations necessary for turtle graphics &&& Trigonometry functions
& sin
& cos
& tan
& atan/2
& square
& dist
& sum_of_squares
& random
let pi = base :pi let pi = base :pi
@ -537,6 +562,7 @@ fn dist {
((x, y)) -> dist (x, y) ((x, y)) -> dist (x, y)
} }
&&& Number functions
fn random { fn random {
"Returns a random number. With zero arguments, returns a random number between 0 (inclusive) and 1 (exclusive). With one argument, returns a random number between 0 and n. With two arguments, returns a random number between m and n." "Returns a random number. With zero arguments, returns a random number between 0 (inclusive) and 1 (exclusive). With one argument, returns a random number between 0 and n. With two arguments, returns a random number between m and n."
() -> base :random () () -> base :random ()
@ -565,13 +591,42 @@ fn range {
(start as :number, end as :number) -> base :range (start, end) (start as :number, end as :number) -> base :range (start, end)
} }
&&& Turtle & other graphics
let colors = @{
:white (255, 255, 255)
:light_gray (150, 150, 150)
:dark_gray (50, 50, 50)
:red (255, 0, 0)
:green (0, 255, 0)
:blue (0, 0, 255)
}
& the initial turtle state
let turtle_init = #{
:position (0, 0) & let's call this the origin for now
:heading 0 & this is straight up
:pendown true
:color colors :white
:penwidth 1
:visible true
}
& turtle_commands is a list of commands, expressed as tuples & turtle_commands is a list of commands, expressed as tuples
& the first member of each tuple is the command & the first member of each tuple is the command
ref turtle_commands = [] ref turtle_commands = []
& give ourselves a ref for current turtle state
ref turtle_state = turtle_init
& and a list of turtle states
ref turtle_states = [turtle_init]
fn add_command! (command) -> { fn add_command! (command) -> {
fn updater (commands) -> conj (commands, command) update! (turtle_commands, append (_, command))
update! (turtle_commands, updater) let current_state = deref (turtle_state)
let new_state = apply_command (current_state, command)
update! (turtle_states, append (_, new_state))
make! (turtle_state, new_state)
} }
fn forward! { fn forward! {
@ -632,6 +687,15 @@ fn penwidth! {
let pw! = penwidth! let pw! = penwidth!
fn background! {
"Sets the background color behind the turtle and path. Alias: bg!"
(gray as :number) -> background! ((gray, gray, gray, 255))
((r as :number, g as :number, b as :number)) -> background! ((r, g, b, 255))
((r as :number, g as :number, b as :number, a as :number)) -> background! ((r, g, b, a))
}
let bg! = background!
fn home! { fn home! {
"Sends the turtle home: to the centre of the screen, pointing up. If the pen is down, the turtle will draw a path to home." "Sends the turtle home: to the centre of the screen, pointing up. If the pen is down, the turtle will draw a path to home."
() -> add_command! ((:home)) () -> add_command! ((:home))
@ -642,51 +706,51 @@ fn clear! {
() -> add_command! ((:clear)) () -> add_command! ((:clear))
} }
& goto ((x, y))
fn goto! { fn goto! {
"Sends the turtle to (x, y) coordinates. If the pen is down, the turtle will draw a path to its new location." "Sends the turtle to (x, y) coordinates. If the pen is down, the turtle will draw a path to its new location."
(x as :number, y as :number) -> add_command! ((:goto, (x, y))) (x as :number, y as :number) -> add_command! ((:goto, (x, y)))
((x, y)) -> goto! (x, y) ((x, y)) -> goto! (x, y)
} }
fn heading/vector {
"Takes a turtle heading, and returns a unit vector of that heading."
(heading) -> {
& 0 is 90º/0.25T, 0.25 is 180º/0.5T, 0.5 is 270º, 0.75 is 0º
let angle = add (heading, 0.25)
(cos (angle), sin (angle))
}
}
fn apply_command { fn apply_command {
"Takes a turtle state and a command and calculates the new state." "Takes a turtle state and a command and calculates a new state."
(state, command) -> match command with { (state, command) -> match command with {
(:goto, (x, y)) -> assoc (state, :position, (x, y)) (:goto, (x, y)) -> assoc (state, :position, (x, y))
(:right, turns) -> update (state, :heading, sub (_, turns)) (:right, turns) -> update (state, :heading, sub (_, turns))
(:left, turns) -> update (state, :heading, add (_, turns)) (:left, turns) -> update (state, :heading, add (_, turns))
(:forward, steps) -> { (:forward, steps) -> {
let #{heading, position} = state let #{heading, position} = state
& turtle heading is a quarter turn off from let unit = heading/vector (heading)
let angle = add (0.25, heading) let vect = mult (steps, unit)
let v = (cos (angle), sin (angle)) update (state, :position, add (vect, _))
update (state, :position, add (v, _))
} }
(:back, steps) -> { (:back, steps) -> {
let #{heading, position} = state let #{heading, position} = state
let v = (cos (heading), sin (heading)) let unit = heading/vector (heading)
update (state, :position, sub (_, v)) let vect = mult (steps, unit)
update (state, :position, sub (_, vect))
} }
(:penup) -> assoc (state, :pendown, false)
(:pendown) -> assoc (state, :pendown, true)
(:penwidth, pixels) -> assoc (state, :penwidth, pixels)
(:pencolor, color) -> assoc (state, :pencolor, color)
} }
} }
let colors = @{ fn turtle/p5 {
:white (255, 255, 255) "Takes a list of turtle states and returns a list of p5 calls that will render the turtle states."
:light_gray (150, 150, 150) () -> :todo
:dark_gray (50, 50, 50)
:red (255, 0, 0)
:green (0, 255, 0)
:blue (0, 0, 255)
} }
let turtle_init = #{
:position (0, 0) & let's call this the origin
:heading 0 & this is straight up
:pendown true
:color colors :white
:penwidth 1
:visible true
}
& turtlestate () -> @{:position (x, y), :heading turns, :visible boolean, :pen penstate} & turtlestate () -> @{:position (x, y), :heading turns, :visible boolean, :pen penstate}
@ -700,10 +764,11 @@ ns prelude {
rest rest
nth nth
count count
conj append
fold fold
map map
list list
set
inc inc
dec dec
print! print!
@ -713,7 +778,7 @@ ns prelude {
report report
concat concat
deref deref
set! make!
update! update!
add add
sub sub
@ -740,11 +805,14 @@ ns prelude {
coll? coll?
ordered? ordered?
assoc? assoc?
set assoc
unset dissoc
update update
get get
dict dict
keys
values
diff
each! each!
panic! panic!
doc! doc!
@ -779,5 +847,8 @@ ns prelude {
penwidth!, pw! penwidth!, pw!
home!, clear!, goto!, home!, clear!, goto!,
turtle_commands, turtle_init turtle_commands, turtle_init
apply_command add_command!, apply_command,
heading/vector
turtle_state
turtle_states
} }