mescc: Avoid duplication of globals.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sun, 23 Apr 2017 11:53:36 +0000 (13:53 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sun, 23 Apr 2017 11:53:36 +0000 (13:53 +0200)
* module/language/c99/compiler.mes (globals:add-string): New function.
  (expr->arg): Use it to avoid globals duplication.
  (expr->accu): Do not pre-add globals.

module/language/c99/compiler.mes

index 56d0dddc86521dffffc03f8d7e6243f1715c0453..2a7cc69e8f0745c297924b00b0d2dc9e070d054f 100644 (file)
     (let ((info ((expr->accu info) o)))
       (append-text info (wrap-as (i386:push-accu))))))
 
+(define (globals:add-string globals)
+  (lambda (o)
+    (let ((string (add-s:-prefix o)))
+      (if (assoc-ref globals string) globals
+          (append globals (list (string->global o)))))))
+
 (define (expr->arg info) ;; FIXME: get Mes curried-definitions
   (lambda (o)
     (let ((text (.text info)))
       (pmatch o
 
         ((p-expr (string ,string))
-         (append-text info ((push-global-address info) (add-s:-prefix string))))
+         (let* ((globals ((globals:add-string (.globals info)) string))
+                (info (clone info #:globals globals)))
+           (append-text info ((push-global-address info) (add-s:-prefix string)))))
 
         ((p-expr (ident ,name))
          (append-text info ((push-ident info) name)))
         ((fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list))
          (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME
                                    (append-text info (wrap-as (asm->hex arg0))))
-             (let* ((globals (append globals (filter-map expr->global expr-list)))
-                    (info (clone info #:globals globals))
-                    (text-length (length text))
+             (let* ((text-length (length text))
                     (args-info (let loop ((expressions (reverse expr-list)) (info info))
                                  (if (null? expressions) info
                                      (loop (cdr expressions) ((expr->arg info) (car expressions))))))
-                    (text (.text args-info))
                     (n (length expr-list)))
                (if (and (not (assoc-ref locals name))
                         (assoc-ref (.functions info) name))
-                   (clone args-info #:text
-                          (append text
-                                  (list (lambda (f g ta t d)
-                                          (i386:call f g ta t d (+ t (function-offset name f)) n))))
-                          #:globals globals)
+                   (append-text args-info (list (lambda (f g ta t d)
+                                                  (i386:call f g ta t d (+ t (function-offset name f)) n))))
                    (let* ((empty (clone info #:text '()))
                           (accu ((expr->accu empty) `(p-expr (ident ,name)))))
-                     (clone args-info #:text
-                            (append text
-                                    (.text accu)
-                                    (list (lambda (f g ta t d)
-                                            (i386:call-accu f g ta t d n))))
-                            #:globals globals))))))
+                     (append-text args-info (append (.text accu)
+                                                    (list (lambda (f g ta t d)
+                                                            (i386:call-accu f g ta t d n))))))))))
 
         ((fctn-call ,function (expr-list . ,expr-list))
-         (let* ((globals (append globals (filter-map expr->global expr-list)))
-                (info (clone info #:globals globals))
-                (text-length (length text))
+         (let* ((text-length (length text))
                 (args-info (let loop ((expressions (reverse expr-list)) (info info))
                              (if (null? expressions) info
                                  (loop (cdr expressions) ((expr->arg info) (car expressions))))))
-                (text (.text args-info))
                 (n (length expr-list))
                 (empty (clone info #:text '()))
                 (accu ((expr->accu empty) function)))
-           (clone info #:text
-                  (append text
-                          (.text accu)
-                          (list (lambda (f g ta t d)
-                                  (i386:call-accu f g ta t d n))))
-                  #:globals globals)))
+           (append-text args-info (append (.text accu)
+                                          (list (lambda (f g ta t d)
+                                                  (i386:call-accu f g ta t d n)))))))
 
         ((cond-expr . ,cond-expr)
          ((ast->info info) `(expr-stmt ,o)))