infix

remix/README

@@ -4,7 +4,7 @@ DONE demonstrate how @ everywhere enables non-() macros like datalog
 
 DONE {} particular => (#%braces)
 
-TODO {} infix
+DONE {} infix
 
 DONE [] particular => (#%brackets)
 
@@ -60,7 +60,7 @@ TODO No set! (use data-structure mutation and :=)
 
 TODO No effects or expressions at top-level (controversial, mf says wrong) [set-once!]
 
-TODO "Versioned" libraries
+DONE "Versioned" libraries
 
 TODO Make macros less weird and more like programs, by...
 

remix/num/gen0.rkt

@@ -1,3 +1,4 @@
 #lang racket/base
 ;; xxx fill out
-(provide + < /)
+(provide + < / * -
+         bitwise-and)

remix/stx0.rkt

@@ -1,5 +1,8 @@
 #lang racket/base
 (require (for-syntax racket/base
+                     racket/list
+                     racket/match
+                     racket/generic
                      syntax/parse))
 
 (define-syntax (def stx)
@@ -32,8 +35,79 @@
      (syntax/loc stx
        (remix-block . body))]))
 
+(begin-for-syntax
+  (define-generics binary-operator
+    [binary-operator-precedence binary-operator])
+  (define (operator-chars? s)
+    (not
+     (ormap (λ (c) (or (char-alphabetic? c)
+                       (char-numeric? c)))
+            (string->list s))))
+  (define-syntax-class operator-sym
+    (pattern op:identifier
+             #:when (operator-chars? (symbol->string (syntax->datum #'op)))))
+  (define PRECEDENCE-TABLE
+    (hasheq '* 30 '/ 30
+            '+ 40 '- 40
+            '< 60 '<= 60
+            '> 60 '>= 60
+            '= 70))
+  (define (shunting-yard:precendence op)
+    (define v (syntax-local-value op (λ () #f)))
+    (or (and v (binary-operator? v) (binary-operator-precedence v))
+        (hash-ref PRECEDENCE-TABLE (syntax->datum op) 150)))
+  
+  (define (shunting-yard:consume-input input output operators)
+    (match input
+      ['()
+       (shunting-yard:pop-operators output operators)]
+      [(cons token input)
+       (syntax-parse token
+         #:literals (unquote)
+         [(~or (unquote (~and op1:expr (~not _:operator-sym))) op1:operator-sym)
+          (define-values (output-p operators-p)
+            (shunting-yard:push-operator output operators #'op1))
+          (shunting-yard:consume-input input output-p operators-p)]
+         [(~or (unquote arg:operator-sym) arg:expr)
+          (shunting-yard:consume-input input (cons #'arg output) operators)])]))
+  (define (shunting-yard:push-operator output operators op1)
+    (match operators
+      ['()
+       (values output (cons op1 operators))]
+      [(cons op2 operators-p)
+       (cond
+         [(<= (shunting-yard:precendence op2) (shunting-yard:precendence op1))
+          (shunting-yard:push-operator
+           (shunting-yard:push-operator-to-output op2 output)
+           operators-p op1)]
+         [else
+          (values output (cons op1 operators))])]))
+  (define (shunting-yard:pop-operators output operators)
+    (match operators
+      ['()
+       (match output
+         [(list result)
+          result]
+         [_
+          (error 'shunting-yard:pop-operators "Too much output: ~v" output)])]
+      [(cons op operators)
+       (shunting-yard:pop-operators
+        (shunting-yard:push-operator-to-output op output)
+        operators)]))
+  (define (shunting-yard:push-operator-to-output op output)
+    (syntax-parse output
+      [(arg2:expr arg1:expr output:expr ...)
+       (cons (quasisyntax/loc op
+               (#,op arg1 arg2))
+             (syntax->list
+              #'(output ...)))])))
 (define-syntax (#%braces stx)
-  (syntax-parse stx))
+  (syntax-parse stx
+    [(_ input-tokens:expr ...)
+     (shunting-yard:consume-input
+      (syntax->list #'(input-tokens ...))
+      empty
+      empty)]))
 
 (define-syntax (#%dot stx)
   (syntax-parse stx))
@@ -59,9 +133,13 @@
                      [remix-cond cond])
          #%brackets
          #%braces
+         (for-syntax gen:binary-operator
+                     binary-operator?
+                     binary-operator-precedence)
          #%dot
          #%app
          #%datum
+         unquote
          module
          module*
          module+)

remix/tests/simple.rkt

@@ -34,4 +34,35 @@
  path(X, Y)?
 }
 
+(def v7
+  {3 + 4})
+(module+ test
+  v7)
 
+(def v-26
+  {2 * 3 - 48 / 4 - 4 * 5})
+(module+ test
+  v-26)
+
+(def v15
+  {v7 * 2 + 1})
+(module+ test
+  v15)
+
+(def v14
+  (def (f x y) (+ x y))
+  {v7 ,f v7})
+(module+ test
+  v14)
+
+(def v1
+  (def & bitwise-and)
+  {5 & 1})
+(module+ test
+  v1)
+
+(def v9
+  (def & 2)
+  {v7 + ,&})
+(module+ test
+  v9)