diff --git a/src/ludus/base.cljc b/src/ludus/base.cljc index 285447c..69da780 100644 --- a/src/ludus/base.cljc +++ b/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 - :body (fn [xs] (into [] xs))}) + ::data/type ::data/clj + :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- }) \ No newline at end of file diff --git a/src/ludus/interpreter.cljc b/src/ludus/interpreter.cljc index e323769..04a6f10 100644 --- a/src/ludus/interpreter.cljc +++ b/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 {})) diff --git a/src/ludus/prelude.ld b/src/ludus/prelude.ld index 8774c0a..38fa842 100644 --- a/src/ludus/prelude.ld +++ b/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." - (xs as :tuple) -> base :into ([], base :rest (xs)) + "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." + (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 - (d as :dict, key as :keyword, value) -> base :assoc (d, key, value) - (d as :dict, (key as :keyword, value)) -> base :assoc (d, key, value) + (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) } -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 - (d as :dict, key as :keyword) -> base :dissoc (d, key) + (dict as :dict) -> dict + (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: -&& 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 { +& TODO: make this less awkward once we have tail recursion +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 -& 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} +fn doc! { + "Prints the documentation of a function to the console." + (f as :fn) -> base :doc (f) + (_) -> :none +} -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 } \ No newline at end of file diff --git a/src/ludus/show.cljc b/src/ludus/show.cljc index 17f14ae..064fe7c 100644 --- a/src/ludus/show.cljc +++ b/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))) "}")