(;module: {#;doc "Common mathematical constants and functions."} lux (lux (control monad) (data (coll [list "" Fold]) [number "Int/" Number] [product] text/format) [compiler] (macro ["s" syntax #+ syntax: Syntax "s/" Functor] [ast]))) ## [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 AST) (#Call (List AST)) (#Infix Infix AST Infix)) (def: (infix^ _) (-> Unit (Syntax Infix)) ($_ s;alt ($_ s;either (s/map ast;bool s;bool) (s/map ast;nat s;nat) (s/map ast;int s;int) (s/map ast;deg s;deg) (s/map ast;real s;real) (s/map ast;char s;char) (s/map ast;text s;text) (s/map ast;symbol s;symbol) (s/map ast;tag s;tag)) (s;form (s;many s;any)) (s;tuple (s;either (do s;Monad [_ (s;this! (' #and)) init-subject (infix^ []) init-op s;any init-param (infix^ []) steps (s;some (s;seq s;any (infix^ [])))] (wrap (product;right (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 s;Monad [_ (wrap []) init-subject (infix^ []) init-op s;any init-param (infix^ []) steps (s;some (s;seq s;any (infix^ [])))] (wrap (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 AST) (case infix (#Const value) value (#Call parts) (ast;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))))