a11afc42b0bb — Leonard Ritter 6 months ago
* `:=` is now implemented by the list wildcard handler
* `:=` accepts multiple left-hand arguments
* `as:=` auto-wraps right hand arguments as well
2 files changed, 51 insertions(+), 16 deletions(-)

M lib/scopes/core.sc
M testing/test_operators.sc
M lib/scopes/core.sc +42 -15
@@ 3042,6 3042,38 @@ fn pointer-ras (T vT)
     __as = (box-pointer (spice-cast-macro pointer-as))
     __ras = (box-pointer (spice-cast-macro pointer-ras))
 
+# explicit support for binding operator :=
+# --------------------------------------------------------------------------
+
+fn has-binding-operator? (expr)
+    loop (expr)
+        if (empty? expr)
+            break false
+        let at next = ('decons expr)
+        if (== ('typeof at) Symbol)
+            let at = (as at Symbol)
+            if (== at ':=)
+                return true
+        repeat next
+
+fn parse-binding-expr (anchor expr)
+    loop (lhs rhs = '() expr)
+        if (empty? rhs)
+            error str"unexpected end of binding expression"
+        let at rhs = ('decons rhs)
+        if (== ('typeof at) Symbol)
+            let at = (as at Symbol)
+            if (== at ':=)
+                let rhs =
+                    if (== (countof rhs) 1) rhs
+                    else (list rhs)
+                let newexpr =
+                    'join
+                        cons let ('reverse lhs)
+                        cons '= rhs
+                return newexpr
+        repeat (cons at lhs) rhs
+
 # infix notation support
 # --------------------------------------------------------------------------
 

          
@@ 3260,7 3292,7 @@ fn list-handler (topexpr env)
                 sc_error_append_calltrace err ('tag msg expr-anchor)
                 raise err
         return expr env
-    elseif (has-infix-ops? env expr)
+    if (has-infix-ops? env expr)
         let at next = ('decons expr)
         let expr =
             try

          
@@ 3270,6 3302,8 @@ fn list-handler (topexpr env)
                 hide-traceback;
                 error@+ err ('anchor topexpr-at) "while expanding infix expression"
         return (cons expr topexpr-next) env
+    elseif (has-binding-operator? expr)
+        return (cons (parse-binding-expr expr-anchor expr) topexpr-next) env
     else
         return topexpr env
 

          
@@ 3805,7 3839,12 @@ inline make-inplace-let-op (op)
     sugar-macro
         fn expand-infix-let (expr)
             raising Error
-            let name value = (decons expr 2)
+            let name value = (decons expr)
+            let value =
+                if (== (countof value) 1)
+                    let k = (decons value)
+                    k
+                else `value
             qq [let] [name] = ([op] [name] [value])
 
 inline make-inplace-op (op)

          
@@ 3826,17 3865,6 @@ let
     ^= = (make-inplace-op ^)
     ..= = (make-inplace-op ..)
 
-    := =
-        sugar-macro
-            fn expand-infix-let (expr)
-                raising Error
-                let name value = (decons expr)
-                let value =
-                    if (== (countof value) 1)
-                        let k = (decons value)
-                        k
-                    else `value
-                qq [let] [name] = [value]
     as:= = (make-inplace-let-op as)
     <- =
         sugar-macro

          
@@ 3866,8 3894,7 @@ define-infix< 50 >>=; define-infix< 50 <
 define-infix< 50 &=; define-infix< 50 |=; define-infix< 50 ^=
 define-infix< 50 ..=
 
-define-infix* 50 :=
-define-infix< 50 as:=
+define-infix* 50 as:=
 
 define-infix> 100 or
 define-infix> 200 and

          
M testing/test_operators.sc +9 -1
@@ 61,10 61,18 @@ do
     test
         not not not not true
 
-# := auto-wraps the right hand side
+# := auto-wraps the right hand side, accepts multiple left hand arguments
 x := + 1 2
 test (x == 3)
 x := 4
 test (x == 4)
+x y z := 1, 2, 3
+test (and (x == 1) (y == 2) (z == 3))
+x := 1.0
+# as:= auto-wraps right hand side as well
+x as:= integer 32
+test (x == 1)
+
+
 
 ;
  No newline at end of file