Fix anonymous fn bug
This commit is contained in:
parent
314101d17d
commit
30fa4e9d97
|
@ -442,7 +442,7 @@
|
||||||
(get map kw))))))
|
(get map kw))))))
|
||||||
|
|
||||||
(defn- call-fn [lfn args ctx]
|
(defn- call-fn [lfn args ctx]
|
||||||
; (println "Calling function " (:name lfn))
|
;(println "Calling function " (:name lfn))
|
||||||
(cond
|
(cond
|
||||||
(= ::data/partial (first args))
|
(= ::data/partial (first args))
|
||||||
{::data/type ::data/clj
|
{::data/type ::data/clj
|
||||||
|
@ -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)
|
||||||
|
|
||||||
)
|
)
|
|
@ -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
|
||||||
}
|
}
|
Loading…
Reference in New Issue
Block a user