From 74c00f4962873a3fca4df658621b912e636c79dd Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay.mccarthy@gmail.com>
Date: Wed, 7 Oct 2015 10:52:37 -0400
Subject: [PATCH] infix

---
 remix/README           |  4 +--
 remix/num/gen0.rkt     |  3 +-
 remix/stx0.rkt         | 80 +++++++++++++++++++++++++++++++++++++++++-
 remix/tests/simple.rkt | 31 ++++++++++++++++
 4 files changed, 114 insertions(+), 4 deletions(-)

diff --git a/remix/README b/remix/README
index faa8f8f..5491454 100644
--- a/remix/README
+++ b/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...
 
diff --git a/remix/num/gen0.rkt b/remix/num/gen0.rkt
index 1083d82..2a5bcfc 100644
--- a/remix/num/gen0.rkt
+++ b/remix/num/gen0.rkt
@@ -1,3 +1,4 @@
 #lang racket/base
 ;; xxx fill out
-(provide + < /)
+(provide + < / * -
+         bitwise-and)
diff --git a/remix/stx0.rkt b/remix/stx0.rkt
index 352fd2a..cf2909e 100644
--- a/remix/stx0.rkt
+++ b/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+)
diff --git a/remix/tests/simple.rkt b/remix/tests/simple.rkt
index cb5d1ab..456729b 100644
--- a/remix/tests/simple.rkt
+++ b/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)