From 03562eb8e3fb79f2a9fec7c2018aafb5a8d842de Mon Sep 17 00:00:00 2001
From: Jon Rafkind <rafkind@racket-lang.org>
Date: Mon, 19 Jul 2010 15:56:49 -0600
Subject: [PATCH] fix if. add check_expect. add some comparison operators

---
 collects/honu/core/main.rkt                   |  9 ++++++++-
 .../honu/core/private/honu-typed-scheme.rkt   | 20 ++++++++++++++-----
 collects/honu/core/private/literals.rkt       |  2 ++
 collects/honu/core/private/parse.rkt          |  7 ++++++-
 collects/honu/private/common.honu             | 10 ++++++++++
 5 files changed, 41 insertions(+), 7 deletions(-)

diff --git a/collects/honu/core/main.rkt b/collects/honu/core/main.rkt
index 10051e012c..789e1aed44 100644
--- a/collects/honu/core/main.rkt
+++ b/collects/honu/core/main.rkt
@@ -54,9 +54,16 @@
                      (+ scheme:+)
                      (honu-/ /)
                      (honu-- -)
+                     (honu-< <)
+                     (honu-> >)
+                     (honu->= >=)
+                     (honu-<= <=)
+                     (honu-== ==)
                      (honu-= =)
+                     (honu-!= !=)
                      (honu-? ?)
                      (honu-: :)
+                     (honu-and and)
                      (honu-comma |,|)
                      (honu-. |.|)
                      )
@@ -107,7 +114,7 @@
                                  (scheme-syntax schemeSyntax)
                                  ))
          #%braces #%parens #%brackets
-         x
+         sqrt
          true
          false
          display
diff --git a/collects/honu/core/private/honu-typed-scheme.rkt b/collects/honu/core/private/honu-typed-scheme.rkt
index e7be223c15..e297c44550 100644
--- a/collects/honu/core/private/honu-typed-scheme.rkt
+++ b/collects/honu/core/private/honu-typed-scheme.rkt
@@ -389,21 +389,31 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
     (define-syntax-class expr
       [pattern e])
     (define-syntax-class paren-expr
-      [pattern (#%parens expr:expr)])
+      [pattern (#%parens expr:expression) #:with result #'expr.result])
     (define-syntax-class block
                          [pattern (#%braces statement ...)
-                                  #:with line (parse-complete-block #'(statement ...))])
+                                  #:with line #'(honu-unparsed-begin statement ...)
+                                  #;
+                                  (parse-complete-block #'(statement ...))])
     ;; (printf "Original syntax ~a\n" (syntax->datum stx))
     (syntax-parse stx
       #:literals (else)
       [(_ condition:paren-expr on-true:block else on-false:block . rest)
        ;; (printf "used if with else\n")
        (let ([result #'(if condition.expr on-true.line on-false.line)])
-         (expression-result ctx result (syntax/loc #'rest rest)))]
+         (values
+           (lambda () result)
+           #'rest)
+           #;
+           (expression-result ctx result (syntax/loc #'rest rest)))]
       [(_ condition:paren-expr on-true:block . rest)
        ;; (printf "used if with no else\n")
-       (let ([result #'(when condition.expr on-true.line)])
-         (expression-result ctx result #'rest))])))
+       (let ([result #'(when condition.result on-true.line)])
+         (values
+           (lambda () result)
+           #'rest)
+           #;
+           (expression-result ctx result #'rest))])))
 
 #|
 if (foo){
diff --git a/collects/honu/core/private/literals.rkt b/collects/honu/core/private/literals.rkt
index 1eae990460..cba1debcc1 100644
--- a/collects/honu/core/private/literals.rkt
+++ b/collects/honu/core/private/literals.rkt
@@ -17,7 +17,9 @@
                 honu-= honu-+= honu--= honu-*= honu-/= honu-%=
                 honu-&= honu-^= honu-\|= honu-<<= honu->>= honu->>>=
                 honu->> honu-<< honu->>> honu-< honu-> honu-<= honu->=
+                honu-!= honu-==
                 honu-? honu-: honu-comma honu-. #%braces #%brackets #%parens colon
+                honu-and
                 ellipses-comma ellipses-comma* ellipses-repeat honu-for-syntax)
 
 (define-literal-set cruft (#%parens #%brackets #%braces semicolon))
diff --git a/collects/honu/core/private/parse.rkt b/collects/honu/core/private/parse.rkt
index 63c0fc182b..8f2fd835f2 100644
--- a/collects/honu/core/private/parse.rkt
+++ b/collects/honu/core/private/parse.rkt
@@ -306,7 +306,11 @@
 ;; the first set of operators is `expression-1'
 (splicing-let-syntax ([sl (make-rename-transformer #'syntax-lambda)])
   (infix-operators expression-1 expression-last
-                                      ([honu-= (sl (left right) #'(= left right))]
+                                      ([honu-and (sl (left right) #'(and left right))])
+                                      (
+                                       #;
+                                       [honu-= (sl (left right) #'(= left right))]
+                                       [honu-== (sl (left right) #'(equal? left right))]
                                        [honu-+= (sl (left right) #'(+ left right))]
                                        [honu--= (sl (left right) #'(- left right))]
                                        [honu-*= (sl (left right) #'(* left right))]
@@ -324,6 +328,7 @@
                                        [honu->>> (sl (left right) #'(+ left right))]
                                        [honu-< (sl (left right) #'(< left right))]
                                        [honu-> (sl (left right) #'(> left right))]
+                                       [honu-!= (sl (left right) #'(not (equal? left right)))]
                                        [honu-<= (sl (left right) #'(<= left right))]
                                        [honu->= (sl (left right) #'(>= left right))])
                                       ([honu-+ (sl (left right) #'(+ left right))]
diff --git a/collects/honu/private/common.honu b/collects/honu/private/common.honu
index ff21377b74..1198cfade6 100644
--- a/collects/honu/private/common.honu
+++ b/collects/honu/private/common.honu
@@ -5,3 +5,13 @@ provide print;
 macro print ()
 { _ (value:expression); } { syntax(display(value_result); newline();); }
 { _ value:expression_comma ... ; } { syntax({display(value_result); newline();} ...); }
+
+provide check_expect;
+provide expect;
+keywords expect;
+macro check_expect (expect) { _ check:expression expect expected:expression ; }
+{ syntax({ checked = check_result;
+           out = expected_result;
+           if (checked != out){
+             print "Expected ", out, " but got ", checked;
+           }});}