mescc: Refactor comparisons.
authorJan Nieuwenhuizen <janneke@gnu.org>
Fri, 7 Apr 2017 05:06:35 +0000 (07:06 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Fri, 7 Apr 2017 05:06:35 +0000 (07:06 +0200)
* module/language/c99/compiler.mes (compare->accu, append-text, wrap):
  New functions.
  (expr->accu): Use them to implement construct like 1 == inc (0).
* scaffold/t.c (math_test): Test them.

module/language/c99/compiler.mes
scaffold/t.c

index 8d017b20f77adeb8674a3710cca6378d392b92f3..650b143de3d6a06a29a74cafb7ca61758f6ca209 100644 (file)
                                   (i386:accu-not))))
                   #:globals (.globals test-info))))
 
-        ((eq ,a ,b)
-         (let* ((base ((expr->base info) a))
-                (empty (clone base #:text '()))
-                (accu ((expr->accu empty) b)))
-           (clone info #:text
-                  (append text ;; FIXME
-                   (.text base)
-                   (list (lambda (f g ta t d)
-                           (i386:push-base)))
-                   (.text accu)
-                   (list (lambda (f g ta t d)
-                           (i386:pop-base)))
-                   (list (lambda (f g ta t d)
-                           (i386:sub-base)))))))
-
         ((neg (p-expr (fixed ,value)))
          (clone info #:text (append text (value->accu (- (cstring->number value))))))
 
                                     (list (lambda (f g ta t d)
                                             (i386:sub-base))))))
 
-        ((ge ,a ,b)
-         (let* ((base ((expr->base info) a))
-                (empty (clone base #:text '()))
-                (accu ((expr->accu empty) b)))
-           (clone info #:text
-                  (append text ;; FIXME
-                          (.text base)
-                          (list (lambda (f g ta t d)
-                                  (i386:push-base)))
-                          (.text accu)
-                          (list (lambda (f g ta t d)
-                                  (i386:pop-base)))
-                          (list (lambda (f g ta t d)
-                                  (i386:sub-base)))))))
-
-        ((gt ,a ,b)
-         (let* ((base ((expr->base info) a))
-                (empty (clone base #:text '()))
-                (accu ((expr->accu empty) b)))
-           (clone info #:text
-                  (append text
-                          (.text base)
-                          (list (lambda (f g ta t d)
-                                  (i386:push-base)))
-                          (.text accu)
-                          (list (lambda (f g ta t d)
-                                  (i386:pop-base)))
-                          (list (lambda (f g ta t d)
-                                  (i386:sub-base)))))))
-
-        ((ne ,a ,b)
-         (let* ((base ((expr->base info) a))
-                (empty (clone base #:text '()))
-                (accu ((expr->accu empty) b)))
-           (clone info #:text
-                  (append text
-                          (.text base)
-                          (list (lambda (f g ta t d)
-                                  (i386:push-base)))
-                          (.text accu)
-                          (list (lambda (f g ta t d)
-                                  (i386:pop-base)))
-                          (list (lambda (f g ta t d)
-                                  (append 
-                                   (i386:sub-base)
-                                   (i386:xor-zf))))))))
-
-        ((le ,a ,b)
-         (let* ((base ((expr->base info) a))
-                (empty (clone base #:text '()))
-                (accu ((expr->accu empty) b)))
-           (clone info #:text
-                  (append text
-                          (.text base)
-                          (list (lambda (f g ta t d)
-                                  (i386:push-base)))
-                          (.text accu)
-                          (list (lambda (f g ta t d)
-                                  (i386:pop-base)))
-                          (list (lambda (f g ta t d)
-                                  (i386:base-sub)))))))
-
-        ((lt ,a ,b)
-         (let* ((base ((expr->base info) a))
-                (empty (clone base #:text '()))
-                (accu ((expr->accu empty) b)))
-           (clone info #:text
-                  (append text
-                          (.text base)
-                          (list (lambda (f g ta t d)
-                                  (i386:push-base)))
-                          (.text accu)
-                          (list (lambda (f g ta t d)
-                                  (i386:pop-base)))
-                          (list (lambda (f g ta t d)
-                                  (i386:base-sub)))))))
+        ((eq ,a ,b) ((compare->accu info) a b (i386:sub-base)))
+        ((ge ,a ,b) ((compare->accu info) b a (i386:sub-base)))
+        ((gt ,a ,b) ((compare->accu info) b a (i386:sub-base)))
+        ((ne ,a ,b) ((compare->accu info) a b (append (i386:sub-base)
+                                                      (i386:xor-zf))))
+        ((le ,a ,b) ((compare->accu info) b a (i386:base-sub)))
+        ((lt ,a ,b) ((compare->accu info) b a (i386:base-sub)))
 
         ;;((cast (type-name (decl-spec-list (type-spec (typename "SCM"))) (abs-declr (declr-fctn (declr-scope (abs-declr (pointer))) (param-list (param-decl (decl-spec-list (type-spec (typename "SCM")))))))) (d-sel (ident "function") (array-ref (d-sel (ident "cdr") (array-ref (p-expr (ident "fn")) (p-expr (ident "g_cells")))) (p-expr (ident "functions"))))))
         ((cast ,cast ,o)
 
 (define (expr->+base info)
   (lambda (o)
-    (let* ((info (clone info #:text (append (.text info) (list (lambda (f g ta t d) (i386:push-accu))))))
+    (let* ((info (append-text info (wrap (i386:push-accu))))
            (info ((expr->accu info) o))
-           (info (clone info #:text (append (.text info) (list (lambda (f g ta t d) (append (i386:accu->base) (i386:pop-accu))))))))
+           (info (append-text info (wrap (append (i386:accu->base) (i386:pop-accu))))))
       info)))
 
+(define (compare->accu info)
+  (lambda (a b c)
+    (let* ((info ((expr->accu info) a))
+           (info ((expr->+base info) b)))
+      (append-text info (wrap c)))))
+
+(define (append-text info text)
+  (clone info #:text (append (.text info) text)))
+
+(define (wrap o)
+  (list (lambda (f g ta t d) o)))
+
 (define (expr->base info) ;; JUNKME
   (lambda (o)
     (let ((info ((expr->accu info) o)))
index ca2244b7a328f9f91ff42119377c3075b4337ad2..4b1befae54e21b32700ce116d3298417c509c651 100644 (file)
@@ -177,6 +177,8 @@ read_test ()
 int
 math_test ()
 {
+  int i;
+
   puts ("t: 0 < 0\n");
   if (0 < 0) return 1;
 
@@ -201,7 +203,16 @@ math_test ()
   puts ("t: -1 > 0\n");
   if (-1 > 0) return 1;
 
-  int i;
+  puts ("t: 1 == inc (0)\n");
+  if (1 == inc (0)) goto ok0;
+  return 1;
+ ok0:
+
+  puts ("t: 0 < inc (0)\n");
+  if (0 < inc (0)) goto ok1;
+  return 1;
+ ok1:
+
   puts ("t: 4/2=");
   i = 4 / 2;
   if (i!=2) return 1;