From 1c86406c9cd6809a64e3e77f0d24c8d307b75c29 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jens=20Axel=20S=C3=B8gaard?= <jensaxel@soegaard.net>
Date: Wed, 4 Jul 2012 23:43:16 +0200
Subject: [PATCH] Unparse now handles Equal. -1*x prints as -x. Solve works for
 a*x+b=0.

---
 bracket/bracket-lang.rkt |  2 ++
 bracket/bracket.rkt      | 35 +++++++++++++++++++++++++++++++++++
 bracket/unparse.rkt      | 33 ++++++++++++++++++++++++---------
 3 files changed, 61 insertions(+), 9 deletions(-)

diff --git a/bracket/bracket-lang.rkt b/bracket/bracket-lang.rkt
index 52cadb91f..305df3135 100644
--- a/bracket/bracket-lang.rkt
+++ b/bracket/bracket-lang.rkt
@@ -5,11 +5,13 @@
 
 (require (submod "bracket.rkt" symbolic-application)
          (submod "bracket.rkt" bracket)
+         (submod "bracket.rkt" solve)
          "unparse.rkt")
 
 (provide (for-syntax #%module-begin)
          #%module-begin)
 (provide (all-from-out racket)
+         Solve
          unparse)
 
 (define-syntax (DeclareVars stx)
diff --git a/bracket/bracket.rkt b/bracket/bracket.rkt
index 81a7de003..6fc663853 100644
--- a/bracket/bracket.rkt
+++ b/bracket/bracket.rkt
@@ -1225,6 +1225,33 @@
            (and (free-of u x)
                 (List 0 u))]))))
 
+(module solve racket
+  (require (submod ".." expression)
+           (submod ".." bracket)
+           (submod ".." pattern-matching))
+  
+  (provide Solve)
+  
+  (define-match-expander List: 
+    (λ (stx)
+      (syntax-case stx ()
+        [(_ pat ...) #'(list 'List pat ...)])))
+  
+  (define-match-expander Equal: 
+    (λ (stx)
+      (syntax-case stx ()
+        [(_ pat1 pat2) #'(list 'Equal pat1 pat2)])))
+  
+  (define (Solve u x)
+    (match u
+      [(Equal: u1 u2)
+       (match (Match-linear-form (Minus u1 u2) x)
+         [(List: a b) 
+          ; ax+b=0 => x= -b/a
+          (Equal x (Quotient (Minus b) a))])]
+      [_ #f])))
+    
+
 (module test racket
   (require (submod ".." symbolic-application)
            (submod ".." bracket)
@@ -1393,6 +1420,14 @@
   (check-equal? (Match-linear-form (Times 3 x x y) x) #f)
   (check-equal? (Match-linear-form (Plus 3 (Power x 2) y) x) #f)
   (check-equal? (Match-linear-form (Plus 3 x y) x) (List 1 (Plus 3 y)))
+  ; List:
+  ; Equal:
+  
+  ;;; Solve
+  (require (submod ".." solve))
+  (check-equal? (Solve (Equal x 1) x) (Equal x 1))
+  (check-equal? (Solve (Equal (Times 2 x) 1) x) (Equal x 1/2))
+  (check-equal? (Solve (Equal (Times a x) b) x) (Equal x (Quotient b a)))
   
   )
 
diff --git a/bracket/unparse.rkt b/bracket/unparse.rkt
index d9b197ed1..b49efd662 100644
--- a/bracket/unparse.rkt
+++ b/bracket/unparse.rkt
@@ -5,7 +5,9 @@
 
 (provide unparse)
 
-(require (submod "bracket.rkt" expression-core))
+(require (submod "bracket.rkt" expression-core)
+         (submod "bracket.rkt" equation-expression))
+
 
 (define (map/first? base f xs)
   (cond
@@ -48,10 +50,15 @@
   (case (operator form)
     [(Times) 
      (define ops (operands form))
-     (define unwrapped
-       (string-append* (add-between (map unparse-factor ops) "*")))
-     (wrap-if (and level-below-times? (>= (length ops) 2))
-              unwrapped)]
+     (cond
+       [(empty? ops) "1"]
+       [(eqv? (first ops) -1)
+        (string-append "-" (unparse-product (cons 'Times (rest ops))))]
+       [else
+        (define unwrapped
+          (string-append* (add-between (map unparse-factor ops) "*")))
+        (wrap-if (and level-below-times? (>= (length ops) 2))
+                 unwrapped)])]
     [else
      (unparse-factor form first?)]))
 
@@ -80,10 +87,14 @@
     [(times-expression? form) ; This case is for unsimplified expressions
      (format "(~a)" (unparse-product form #t))]
     [(compound-expression? form)
-     ; Note: Set expressions are compound expressions.
-     (format "~a(~a)" (operator form)
-             (string-append* (add-between (map/first? #t unparse (operands form)) ",")))]
-    
+     (case (kind form)
+       [(Equal)
+        (define-values (t r) (equation->sides form))
+        (format "~a=~a" (unparse t) (unparse r))]
+       [else
+        ; Note: Set expressions are compound expressions.
+        (format "~a(~a)" (operator form)
+                (string-append* (add-between (map/first? #t unparse (operands form)) ",")))])]
     [else
      ; TODO: pass value unchanged: stuff like #void, #eof, special values etc.
      (format "~a" (object-name form))
@@ -102,6 +113,7 @@
 
 (module* test #f
   (require rackunit )
+  (require (submod "bracket.rkt" bracket))
   (define x 'x)
   (define y 'y)
   (define z 'z)
@@ -125,6 +137,7 @@
   (check-equal? (unparse '(Plus -1 x)) "-1+x")
   (check-equal? (unparse '(Plus 2/3 x)) "2/3+x")
   (check-equal? (unparse '(Plus 2.0 x)) "2.0+x")
+  (check-equal? (unparse (Minus x)) "-x")
   ; Products
   (check-equal? (unparse '(Times 2 x)) "2*x")
   (check-equal? (unparse '(Times 2/3 x)) "2/3*x")
@@ -169,4 +182,6 @@
   (check-equal? (unparse '(Set 1)) "Set(1)")
   (check-equal? (unparse '(Set 1 2)) "Set(1,2)")
   (check-equal? (unparse '(Set 1 2 3)) "Set(1,2,3)")
+  ; Equal
+  (check-equal? (unparse '(Equal x 2)) "x=2")
   )