- Added unary function support for the "infix" macro.

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))