(;module: {#;doc "Common mathematical constants and functions."} lux (lux (control monad ["p" parser "p/" Functor]) (data (coll [list "L/" Fold]) [product]) [macro] (macro ["s" syntax #+ syntax: Syntax] [code]))) ## [Values] (do-template [ ] [(def: #export Real (_lux_proc ["math" ] []))] [e "e"] [pi "pi"] ) (def: #export tau {#;doc "The same as 2*PI."} Real 6.28318530717958647692) (do-template [ ] [(def: #export ( input) (-> Real Real) (_lux_proc ["math" ] [input]))] [cos "cos"] [sin "sin"] [tan "tan"] [acos "acos"] [asin "asin"] [atan "atan"] [cosh "cosh"] [sinh "sinh"] [tanh "tanh"] [exp "exp"] [log "log"] [root2 "root2"] [root3 "root3"] [ceil "ceil"] [floor "floor"] [round "round"] ) (do-template [ ] [(def: #export ( param subject) (-> Real Real Real) (_lux_proc ["math" ] [subject param]))] [atan2 "atan2"] [pow "pow"] ) (def: #export (log' base input) (r./ (log base) (log input))) (def: #export (factorial n) (-> Nat Nat) (loop [acc +1 n n] (if (n.<= +1 n) acc (recur (n.* n acc) (n.dec n))))) (def: #export (hypotenuse catA catB) (-> Real Real Real) (root2 (r.+ (pow 2.0 catA) (pow 2.0 catB)))) (def: #export (gcd a b) {#;doc "Greatest Common Divisor."} (-> Nat Nat Nat) (case b +0 a _ (gcd b (n.% b a)))) (def: #export (lcm x y) {#;doc "Least Common Multiple."} (-> Nat Nat Nat) (case [x y] (^or [_ +0] [+0 _]) +0 _ (|> x (n./ (gcd x y)) (n.* y)) )) ## [Syntax] (type: #rec Infix (#Const Code) (#Call (List Code)) (#Infix Infix Code Infix)) (def: (infix^ _) (-> Unit (Syntax Infix)) ($_ p;alt ($_ p;either (p/map code;bool s;bool) (p/map code;nat s;nat) (p/map code;int s;int) (p/map code;deg s;deg) (p/map code;real s;real) (p/map code;text s;text) (p/map code;symbol s;symbol) (p/map code;tag s;tag)) (s;form (p;many s;any)) (s;tuple (p;either (do p;Monad [_ (s;this (' #and)) init-subject (infix^ []) init-op s;any init-param (infix^ []) steps (p;some (p;seq s;any (infix^ [])))] (wrap (product;right (L/fold (function [[op param] [subject [_subject _op _param]]] [param [(#Infix _subject _op _param) (` and) (#Infix subject op param)]]) [init-param [init-subject init-op init-param]] steps)))) (do p;Monad [_ (wrap []) init-subject (infix^ []) init-op s;any init-param (infix^ []) steps (p;some (p;seq s;any (infix^ [])))] (wrap (L/fold (function [[op param] [_subject _op _param]] [(#Infix _subject _op _param) op param]) [init-subject init-op init-param] steps))) )) )) (def: (infix-to-prefix infix) (-> Infix Code) (case infix (#Const value) value (#Call parts) (code;form parts) (#Infix left op right) (` ((~ op) (~ (infix-to-prefix right)) (~ (infix-to-prefix left)))) )) (syntax: #export (infix [expr (infix^ [])]) {#;doc (doc "Infix math syntax." (infix [x i.* 10]) (infix [[x i.+ y] i.* [x i.- y]]) (infix [[x n.< y] and [y n.< z]]) (infix [#and x n.< y n.< z]) (infix [(n.* +3 +9) gcd +450]) "The rules for infix syntax are simple." "If you want your binary function to work well with it." "Then take the argument to the right (y) as your first argument," "and take the argument to the left (x) as your second argument.")} (wrap (list (infix-to-prefix expr))))