diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/math.lux | 89 | ||||
| -rw-r--r-- | stdlib/test/test/lux/math.lux | 33 |
2 files changed, 68 insertions, 54 deletions
diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index 73c37d598..c2933ba85 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -99,45 +99,48 @@ (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;frac s;frac) - (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<Parser> - [_ (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<Parser> - [_ (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))) - )) - )) + (#Unary Code Infix) + (#Binary Infix Code Infix)) + +(def: infix^ + (Syntax Infix) + (<| p;rec (function [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;frac s;frac) + (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;seq s;any infix^)) + (s;tuple ($_ p;either + (do p;Monad<Parser> + [_ (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 [(#Binary _subject _op _param) + (` and) + (#Binary subject op param)]]) + [init-param [init-subject init-op init-param]] + steps)))) + (do p;Monad<Parser> + [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]] + [(#Binary _subject _op _param) op param]) + [init-subject init-op init-param] + steps))) + )) + ))) (def: (infix-to-prefix infix) (-> Infix Code) @@ -147,15 +150,19 @@ (#Call parts) (code;form parts) + + (#Unary op subject) + (` ((~ op) (~ (infix-to-prefix subject)))) - (#Infix left op right) + (#Binary left op right) (` ((~ op) (~ (infix-to-prefix right)) (~ (infix-to-prefix left)))) )) -(syntax: #export (infix [expr (infix^ [])]) +(syntax: #export (infix [expr infix^]) {#;doc (doc "Infix math syntax." (infix [x i.* 10]) (infix [[x i.+ y] i.* [x i.- y]]) + (infix [sin [x i.+ y]]) (infix [[x n.< y] and [y n.< z]]) (infix [#and x n.< y n.< z]) (infix [(n.* +3 +9) gcd +450]) diff --git a/stdlib/test/test/lux/math.lux b/stdlib/test/test/lux/math.lux index 63a449965..701790886 100644 --- a/stdlib/test/test/lux/math.lux +++ b/stdlib/test/test/lux/math.lux @@ -8,7 +8,7 @@ [number "f/" Number<Frac>] (coll [list "List/" Fold<List> Functor<List>]) [product]) - ["R" math/random] + ["r" math/random] ["&" math]) lux/test) @@ -23,7 +23,7 @@ ## ## I won't be testing this, until I can figure out what's going on, or ## ## come up with my own implementation ## (context: "Trigonometry" -## [angle (|> R;frac (:: @ map (f.* &;tau)))] +## [angle (|> r;frac (:: @ map (f.* &;tau)))] ## ($_ seq ## (test "Sine and arc-sine are inverse functions." ## (|> angle &;sin &;asin (within? margin angle))) @@ -36,11 +36,11 @@ ## )) (context: "Roots" - [factor (|> R;nat (:: @ map (|>. (n.% +1000) + [factor (|> r;nat (:: @ map (|>. (n.% +1000) (n.max +1) nat-to-int int-to-frac))) - base (|> R;frac (:: @ map (f.* factor)))] + base (|> r;frac (:: @ map (f.* factor)))] ($_ seq (test "Square-root is inverse of square." (|> base (&;pow 2.0) &;root2 (f.= base))) @@ -50,7 +50,7 @@ )) (context: "Rounding" - [sample (|> R;frac (:: @ map (f.* 1000.0)))] + [sample (|> r;frac (:: @ map (f.* 1000.0)))] ($_ seq (test "The ceiling will be an integer value, and will be >= the original." (let [ceil'd (&;ceil sample)] @@ -71,12 +71,12 @@ )) (context: "Exponentials and logarithms" - [sample (|> R;frac (:: @ map (f.* 10.0)))] + [sample (|> r;frac (:: @ map (f.* 10.0)))] (test "Logarithm is the inverse of exponential." (|> sample &;exp &;log (within? 1.0e-15 sample)))) (context: "Greatest-Common-Divisor and Least-Common-Multiple" - [#let [gen-nat (|> R;nat (:: @ map (|>. (n.% +1000) (n.max +1))))] + [#let [gen-nat (|> r;nat (:: @ map (|>. (n.% +1000) (n.max +1))))] x gen-nat y gen-nat] ($_ (test "GCD" @@ -93,17 +93,24 @@ )) (context: "Infix syntax" - [x R;nat - y R;nat - z R;nat + [x r;nat + y r;nat + z r;nat + theta r;frac #let [top (|> x (n.max y) (n.max z)) bottom (|> x (n.min y) (n.min z))]] ($_ seq (test "Constant values don't change." - (n.= x (&;infix x))) + (n.= x + (&;infix x))) - (test "Can call infix functions." - (n.= (&;gcd y x) (&;infix [x &;gcd y]))) + (test "Can call binary functions." + (n.= (&;gcd y x) + (&;infix [x &;gcd y]))) + + (test "Can call unary functions." + (f.= (&;sin theta) + (&;infix [&;sin theta]))) (test "Can use regular syntax in the middle of infix code." (n.= (&;gcd +450 (n.* +3 +9)) |