Make lots of progress on prelude & turtle graphics, fixing partial function application bug along the way.

src/ludus/base.cljc

@@ -2,6 +2,7 @@
   (:require
     [ludus.data :as data]
     [ludus.show :as show]
+    [clojure.math :as math]
     ;[ludus.draw :as d]
     #?(:cljs [cljs.reader])
     #?(:cljs [goog.object :as o])
@@ -66,6 +67,7 @@
 (def not- {:name "not"
            ::data/type ::data/clj
            :body not})
+
 (defn- print-show [lvalue]
   (if (string? lvalue) lvalue (show/show lvalue)))
 
@@ -160,6 +162,12 @@
                :cljs js/Number
                )
 
+            :ratio
+            #?(
+               :clj clojure.lang.Ratio
+               :cljs js/Number
+               )
+
             :string
             #?(
                :clj java.lang.String
@@ -204,6 +212,8 @@
 
       (= (:integer types) t) :number
 
+      (= (:ratio types) t) :number
+
       (= (:string types) t) :string
 
       (= (:boolean types) t) :boolean
@@ -230,6 +240,25 @@
             ::data/type ::data/clj
             :body get-type})
 
+(defn- kv->tuple [[k v]] [::data/tuple k v])
+
+(def to_list {name "to_list"
+              ::data/type ::data/clj
+              :body (fn [item]
+                      (case (get-type item)
+                        (:number :nil :boolean :fn :string :ref :keyword) [::data/list item]
+                        :list item
+                        :set (into [::data/list] item)
+                        :tuple (into [::data/list] (rest item))
+                        :dict (into [::data/list] (map kv->tuple) (dissoc item ::data/dict))
+                        :struct (into [::data/list] (map kv->tuple) (dissoc item ::data/struct))
+                        :ns (into [::data/list] (map kv->tuple) (dissoc item ::data/struct ::data/type ::data/name))
+                        ))})
+
+(def to_dict {name "to_dict"
+              ::data/type ::data/clj
+              :body (fn [struct] (-> struct (assoc ::data/dict true) (dissoc ::data/struct ::data/type ::data/name)))})
+
 (defn strpart [kw] (->> kw str rest (apply str)))
 
 (def readstr
@@ -265,8 +294,8 @@
             :body into})
 
 (def to_vec {:name "to_vec"
-             ::data/type ::data.clj
+             ::data/type ::data/clj
-             :body (fn [xs] (into [] xs))})
+             :body (fn [xs] (into [] (dissoc xs ::data/type ::data/struct ::data/name)))})
 
 (def fold {:name "fold"
            ::data/type ::data/clj
@@ -291,6 +320,60 @@
            ::data/type ::data/clj
            :body str})
 
+(def doc- {:name "doc"
+           ::data/type ::data/clj
+           :body (fn [f]
+                   (let [name (:name f)
+                         docstring (:doc f)
+                         clauses (:clauses f)
+                         patterns (map first clauses)
+                         pretty-patterns (map show/show-pattern patterns)]
+                     (println name)
+                     (println docstring)
+                     (println (apply str (interpose "\n" pretty-patterns)))
+                     :ok)
+                   )})
+
+(def sin {:name "sin"
+          ::data/type ::data/clj
+          :body math/sin})
+
+(def cos {:name "cos"
+          ::data/type ::data/clj
+          :body math/cos})
+
+(def tan {:name "tan"
+          ::data/type ::data/clj
+          :body math/tan})
+
+(def atan_2 {:name "atan_2"
+             ::data/type ::data/clj
+             :body math/atan2})
+
+(def sqrt {:name "sqrt"
+           ::data/type ::data/clj
+           :body math/sqrt})
+
+(def random {:name "random"
+             ::data/type ::data/clj
+             :body rand})
+
+(def floor {:name "floor"
+            ::data/type ::data/clj
+            :body math/floor})
+
+(def ceil {:name "ceil"
+           ::data/type ::data/clj
+           :body math/ceil})
+
+(def round {:name "round"
+            ::data/type ::data/clj
+            :body math/round})
+
+(def range- {:name "range"
+             ::data/type ::data/clj
+             :body (fn [start end] (into [::data/list] (range (-> start math/ceil int) end)))})
+
 (def base {
            :id id
            :eq eq
@@ -328,4 +411,17 @@
            :prn prn-
            :concat concat-
            :str str-
+           :to_list to_list
+           :doc doc-
+           :pi math/PI
+           :sin sin
+           :cos cos
+           :tan tan
+           :atan_2 atan_2
+           :sqrt sqrt
+           :random random
+           :ceil ceil
+           :floor floor
+           :round round
+           :range range-
            })

src/ludus/interpreter.cljc

@@ -450,7 +450,7 @@
      :body (fn [arg]
              (call-fn
                lfn
-               (concat [::data/tuple] (replace {::data/placeholder arg} (rest args)))
+               (into [::data/tuple] (replace {::data/placeholder arg} (rest args)))
                ctx))}
 
     (= (::data/type lfn) ::data/clj) (apply (:body lfn) (next args))
@@ -954,11 +954,15 @@
 ;; repl
 (comment
   
-  (def source "#{:foo bar}")
+  (def source "fn foo {
+    \"Docstring\"
+    () -> :foo
+    (foo) -> :bar
+    }")
 
   (def tokens (-> source scanner/scan :tokens))
 
-  (def ast (p/apply-parser g/pattern tokens))
+  (def ast (p/apply-parser g/script tokens))
 
   ;(def result (interpret-safe source ast {}))
 

src/ludus/prelude.ld

@@ -43,9 +43,15 @@ fn count {
 	(xs as :struct) -> dec (base :count (xs))
 }
 
+fn list? {
+	"Returns true if the value is a list."
+	(l as :list) -> true
+	(_) -> false
+}
+
 fn list {
-	"Takes a tuple, and returns it as a list."
+	"Takes a value and returns it as a list. For values, it simply wraps them in a list. For collections, conversions are as follows. A tuple->list conversion preservers order and length. Unordered collections do not preserve order. Associative collections return lists of (key, value) tuples."
-	(xs as :tuple) -> base :into ([], base :rest (xs))
+	(x) -> base :to_list (x)
 }
 
 fn fold {
@@ -78,7 +84,7 @@ fn conj {
 	(xs as :set, x) -> base :conj (xs, x)
 }
 
-fn print {
+fn print! {
 	"Sends a text representation of Ludus values to the console."
 	(...args) -> base :print (args)
 }
@@ -93,7 +99,7 @@ fn type {
 	(x) -> base :type (x)
 }
 
-fn prn {
+fn prn! {
 	"Prints the underlying Clojure data structure of a Ludus value."
 	(x) -> base :prn (x)
 }
@@ -200,6 +206,28 @@ fn div/0 {
 	}
 }
 
+fn div/safe {
+	"Divides a number. Returns a result tuple."
+	(x as :number) -> (:ok, x)
+	(_, 0) -> (:err, "Division by zero")
+	(x, y) -> (:ok, div (x, y))
+	(x, y, ...zs) -> {
+		let divisor = fold (mult, zs, y)
+		div/safe (x, divisor)
+	}
+}
+
+fn abs {
+	"Returns the absolute value of a number."
+	(0) -> 0
+	(n) -> if neg? (n) then mult (-1, n) else n
+}
+
+fn angle {
+	"Calculates the angle between two vectors."
+	(v1, v2) -> sub (atan/2 (v2), atan/2 (v1))
+}
+
 fn zero? {
 	"Returns true if a number is 0."
 	(0) -> true
@@ -322,17 +350,23 @@ fn or {
 	(x, y, ...zs) -> fold (base :or, zs, base :or (x, y))
 }
 
-fn assoc {
+fn set {
 	"Takes a dict, key, and value, and returns a new dict with the key set to value."
-	(d as :dict) -> d
+	(dict as :dict) -> dict
-	(d as :dict, key as :keyword, value) -> base :assoc (d, key, value)
+	(dict as :dict, key as :keyword, value) -> base :assoc (dict, key, value)
-	(d as :dict, (key as :keyword, value)) -> base :assoc (d, key, value)
+	(dict as :dict, (key as :keyword, value)) -> base :assoc (dict, key, value)
 }
 
-fn dissoc {
+fn unset {
 	"Takes a dict and a key, and returns a new dict with the key and associated value omitted."
-	(d as :dict) -> d
+	(dict as :dict) -> dict
-	(d as :dict, key as :keyword) -> base :dissoc (d, key)
+	(dict as :dict, key as :keyword) -> base :dissoc (dict, key)
+}
+
+fn update {
+	"Takes a dict, key, and function, and returns a new dict with the key set to the result of applying the function to original value held at the key."
+	(dict as :dict) -> dict
+	(dict as :dict, key as :keyword, updater as :fn) -> base :assoc (dict, key, updater (get (key, dict)))
 }
 
 fn coll? {
@@ -366,14 +400,15 @@ fn get {
 	(key as :keyword, coll, default) -> base :get (key, coll, default)
 }
 
-& TODO: make this less awkward once we have tail recursion
+fn dict {
+	"Takes a struct or ns, and returns it as a dict. Returns dicts unharmed."
+	(struct as :struct) -> base :to_dict (struct)
+	(ns_ as :ns) -> base :to_dict (ns_)
+	(dict as :dict) -> dict
+}
 
-&&&&&&&&& TODO:
+& TODO: make this less awkward once we have tail recursion
-&& Fix bug here:
+fn each! {
-&& 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, []) -> nil
 	(f as :fn, [x]) -> { f (x); nil }
@@ -383,36 +418,281 @@ fn each {
 	}
 }
 
-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
+fn doc! {
-& forward, fd (pixels)
+	"Prints the documentation of a function to the console."
-& back, bk (pixels)
+	(f as :fn) -> base :doc (f) 
-& left, lt (turns)
+	(_) -> :none
-& 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}
 
-print ("Loaded Prelude.")
+& math operations necessary for turtle graphics
+& sin
+& cos
+& tan
+& atan/2
+& square
+& dist
+& sum_of_squares
+& random
+
+let pi = base :pi
+
+let tau = mult (2, pi)
+
+fn sin {
+	"Returns the sine of an angle. Default angle measure is turns. An optional keyword argument specifies the units of the angle passed in."
+	(a as :number) -> do a > turn/rad > base :sin
+	(a as :number, :turns) -> do a > turn/rad > base :sin
+	(a as :number, :degrees) -> do a > deg/rad > base :sin
+	(a as :number, :radians) -> base :sin (a)
+}
+
+fn cos {
+	"Returns the cosine of an angle. Default angle measure is turns. An optional keyword argument specifies the units of the angle passed in."
+	(a as :number) -> do a > turn/rad > base :cos
+	(a as :number, :turns) -> do a > turn/rad > base :cos
+	(a as :number, :degrees) -> do a > deg/rad > base :cos
+	(a as :number, :radians) -> base :cos (a)
+}
+
+fn tan {
+	"Returns the sine of an angle. Default angle measure is turns. An optional keyword argument specifies the units of the angle passed in."
+	(a as :number) -> do a > turn/rad > base :tan
+	(a as :number, :turns) -> do a > turn/rad > base :tan
+	(a as :number, :degrees) -> do a > deg/rad > base :tan
+	(a as :number, :radians) -> base :tan (a)
+}
+
+fn turn/deg {
+	"Converts an angle in turns to an angle in degrees."
+	(a as :number) -> mult (a, 360)
+}
+
+fn deg/turn {
+	"Converts an angle in degrees to an angle in turns."
+	(a as :number) -> div (a, 360)
+}
+
+fn turn/rad {
+	"Converts an angle in turns to an angle in radians."
+	(a as :number) -> mult (a, tau)
+}
+
+fn rad/turn {
+	"Converts an angle in radians to an angle in turns."
+	(a as :number) -> div (a, tau)
+}
+
+fn deg/rad {
+	"Converts an angle in degrees to an angle in radians."
+	(a as :number) -> mult (tau, div (a, 360))
+}
+
+fn rad/deg {
+	"Converts an angle in radians to an angle in degrees."
+	(a as :number) -> mult (360, div (a, tau))
+}
+
+fn atan/2 {
+	"Returns an angle from a slope. Takes an optional keyword argument to specify units. Takes either two numbers or a vector tuple."
+	(x as :number, y as :number) -> do base :atan_2 (x, y) > rad/turn
+	(x, y, :turns) -> atan/2 (x, y)
+	(x, y, :radians) -> base :atan_2 (x, y)
+	(x, y, :degrees) -> do base :atan_2 (x, y) > rad/deg
+	((x, y)) -> atan/2 (x, y)
+	((x, y), units as :keyword) -> atan/2 (x, y, units)
+}
+
+fn mod {
+	"Returns the modulus of num and div. Truncates towards negative infinity."
+	(num as :number, y as :number) -> base :mod (num, div)
+}
+
+fn square {
+	"Squares a number."
+	(x as :number) -> mult (x, x)
+}
+
+fn sqrt {
+	"Returns the square root of a number."
+	(x as :number) -> base :sqrt (x) 
+}
+
+fn sum_of_squares {
+	"Returns the sum of squares of numbers."
+	() -> 0
+	(x as :number) -> square (x)
+	(x as :number, y as :number) -> add (square (x), square (y))
+	(x, y, ...zs) -> fold (sum_of_squares, zs, sum_of_squares (x, y))
+}
+
+fn dist {
+	"Returns the distance from the origin to a point described by (x, y)."
+	(x as :number, y as :number) -> sqrt (sum_of_squares (x, y))
+	((x, y)) -> dist (x, y)
+}
+
+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."
+	() -> base :random ()
+	(n as :number) -> base :random (n)
+	(m as :number, n as :number) -> add (m, random (n))
+}
+
+fn floor {
+	"Truncates a number towards negative infinity. With positive numbers, it returns the integer part. With negative numbers, returns the next more-negative integer."
+	(n as :number) -> base :floor (n)
+}
+
+fn ceil {
+	"Truncates a number towards positive infinity. With negative numbers, it returns the integer part. With positive numbers, returns the next more-positive integer."
+	(n as :number) -> base :ceil (n)
+}
+
+fn round {
+	"Rounds a number to the nearest integer."
+	(n as :number) -> base :round (n)
+}
+
+fn range {
+	"Returns the set of integers between start (inclusive) and end (exclusive) as a list. With one argument, starts at 0. If end is less than start, returns an empty list."
+	(end as :number) -> base :range (0, end)
+	(start as :number, end as :number) -> base :range (start, end)
+}
+
+& turtle_commands is a list of commands, expressed as tuples
+& the first member of each tuple is the command
+ref turtle_commands = []
+
+fn add_command! (command) -> {
+	fn updater (commands) -> conj (commands, command)
+	update! (turtle_commands, updater)
+}
+
+fn forward! {
+	"Moves the turtle forward by a number of steps. Alias: fd!"
+	(steps as :number) -> add_command! ((:forward, steps))
+}
+
+let fd! = forward!
+
+fn back! {
+	"Moves the turtle backward by a number of steps. Alias: bk!"
+	(steps as :number) -> add_command! ((:back, steps))
+}
+
+let bk! = back!
+
+fn left! {
+	"Rotates the turtle left, measured in turns. Alias: lt!"
+	(turns as :number) -> add_command! ((:left, turns))
+}
+
+let lt! = left!
+
+fn right! {
+	"Rotates the turtle right, measured in turns. Alias: rt!"
+	(turns as :number) -> add_command! ((:right, turns))
+}
+
+let rt! = right!
+
+fn penup! {
+	"Lifts the turtle's pen, stopping it from drawing. Alias: pu!"
+	() -> add_command! ((:penup))
+}
+
+let pu! = penup!
+
+fn pendown! {
+	"Lowers the turtle's pen, causing it to draw. Alias: pd!"
+	() -> add_command! ((:pendown))
+}
+
+let pd! = pendown!
+
+fn pencolor! {
+	"Changes the turtle's pen color. Takes a single grayscale value, an rgb tuple, or an rgba tuple. Alias: pc!"
+	(gray as :number) -> add_command! ((:pencolor, (gray, gray, gray, 255)))
+	((r as :number, g as :number, b as :number)) -> add_command! ((:pencolor, (r, g, b, 255)))
+	((r as :number, g as :number, b as :number, a as :number)) -> add_command! ((:pencolor, (r, g, b, a)))
+}
+
+let pc! = pencolor!
+
+fn penwidth! {
+	"Sets the width of the turtle's pen, measured in pixels. Alias: pw!"
+	(width as :number) -> add_command! ((:penwidth, width))
+}
+
+let pw! = penwidth!
+
+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."
+	() -> add_command! ((:home))
+}
+
+fn clear! {
+	"Clears the canvas and sends the turtle home."
+	() -> add_command! ((:clear))
+}
+
+& goto ((x, y))
+fn goto! {
+	"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, y)) -> goto! (x, y)
+}
+
+fn apply_command {
+	"Takes a turtle state and a command and calculates the new state."
+	(state, command) -> match command with {
+		(:goto, (x, y)) -> assoc (state, :position, (x, y))
+		(:right, turns) -> update (state, :heading, sub (_, turns))
+		(:left, turns) -> update (state, :heading, add (_, turns))
+		(:forward, steps) -> {
+			let #{heading, position} = state
+			& turtle heading is a quarter turn off from 
+			let angle = add (0.25, heading) 
+			let v = (cos (angle), sin (angle))
+			update (state, :position, add (v, _))
+		}
+		(:back, steps) -> {
+			let #{heading, position} = state
+			let v = (cos (heading), sin (heading))
+			update (state, :position, sub (_, v))
+		}
+	}
+}
+
+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)
+}
+
+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}
+
+& position () -> (x, y)
+& heading () -> turns
+& penstate () -> @{:down :boolean, :color (r, g, b, a), :width pixels}
 
 ns prelude {
 	first
@@ -426,19 +706,23 @@ ns prelude {
 	list
 	inc
 	dec
-	print
+	print!
 	show
-	prn
+	prn!
 	type
 	report
 	concat
 	deref
 	set!
+	update!
 	add
 	sub
 	mult
 	div
 	div/0
+	div/safe
+	angle
+	abs
 	zero?
 	neg?
 	pos?
@@ -456,9 +740,44 @@ ns prelude {
 	coll?
 	ordered?
 	assoc?
-	assoc
+	set
+	unset
+	update
 	get
-	each
+	dict
+	each!
 	panic!
-	foo
+	doc!
+	sin
+	cos
+	tan
+	turn/rad
+	rad/turn
+	turn/deg
+	deg/turn
+	rad/deg
+	deg/rad
+	atan/2
+	mod
+	square
+	sum_of_squares
+	dist
+	random
+	pi
+	tau
+	floor
+	ceil
+	round
+	range
+	forward!, fd!
+	back!, bk!
+	right!, rt!
+	left!, lt!
+	penup!, pu!
+	pendown!, pd!
+	pencolor!, pc!
+	penwidth!, pw!
+	home!, clear!, goto!,
+	turtle_commands, turtle_init
+	apply_command
 }

src/ludus/show.cljc

@@ -25,7 +25,7 @@
     (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) " {" (-> v ::data/value deref show) "}")
 
     (::data/dict v)
     (str "#{" (apply str (into [] show-keyed (dissoc v ::data/dict))) "}")