mescc: Use records for Guile: <global>.

* module/language/c99/info.scm (<global>): New record.
* module/language/c99/compiler.mes (make-global-entry): Rename from
  make-global.  Update callers.
* module/language/c99/info.mes (make-global, global:type,
  global:pointer, global:value): Move from compiler.mes.

diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes
index fae8a9deb34318ba7b409f908baca309a0bb1f97..e1fd50b4138d10275210ffbed691f824e518ba47 100644 (file)
--- a/module/language/c99/compiler.mes
+++ b/module/language/c99/compiler.mes
@@ -203,21 +203,17 @@
           (wrap-as (i386:push-byte-local-de-de-ref (local:id o)))
           (error "TODO int-de-de-ref")))))
 
-(define (make-global name type pointer value)
-  (cons name (list type pointer value)))
+(define (make-global-entry key type pointer value)
+  (cons key (make-global type pointer value)))
 
-(define global:type car)
-(define global:pointer cadr)
-(define global:value caddr)
+(define (string->global-entry string)
+  (make-global-entry `(#:string ,string) "string" 0 (append (string->list string) (list #\nul))))
 
-(define (string->global string)
-  (make-global `(#:string ,string) "string" 0 (append (string->list string) (list #\nul))))
+(define (int->global-entry value)
+  (make-global-entry (number->string value) "int" 0 (int->bv32 value)))
 
-(define (int->global value)
-  (make-global (number->string value) "int" 0 (int->bv32 value)))
-
-(define (ident->global name type pointer value)
-  (make-global name type pointer (if (pair? value) value (int->bv32 value))))
+(define (ident->global-entry name type pointer value)
+  (make-global-entry name type pointer (if (pair? value) value (int->bv32 value))))
 
 (define (make-local name type pointer id)
   (cons name (list type pointer id)))
@@ -274,7 +270,7 @@
   (lambda (o)
     (let ((string `(#:string ,o)))
       (if (assoc-ref globals string) globals
-          (append globals (list (string->global o)))))))
+          (append globals (list (string->global-entry o)))))))
 
 (define (expr->arg info) ;; FIXME: get Mes curried-definitions
   (lambda (o)
@@ -1132,7 +1128,9 @@
         (assoc-ref (.functions info) o))))
 
 (define (ident->type info o)
-  (and=> (ident->decl info o) car))
+  (let ((type (ident->decl info o)))
+    (cond ((global? type) (global:type type))
+          (else (car type)))))
 
 (define (ident->pointer info o)
   (let ((local (assoc-ref (.locals info) o)))
@@ -1379,14 +1377,14 @@
          (let ((type "int")) ;; FIXME
            (if (.function info)
                (clone info #:locals (add-local locals name type 0))
-               (clone info #:globals (append globals (list (ident->global name type 0 0)))))))
+               (clone info #:globals (append globals (list (ident->global-entry name type 0 0)))))))
 
          ;; char **p;
         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
          (if (.function info)
              (let ((locals (add-local locals name type 2)))
                (clone info #:locals locals))
-             (let ((globals (append globals (list (ident->global name type 2 0)))))
+             (let ((globals (append globals (list (ident->global-entry name type 2 0)))))
                (clone info #:globals globals))))
 
         ;; struct foo bar[2];
@@ -1404,7 +1402,7 @@
                (let* ((globals (.globals info))
                       (count (cstring->number count))
                       (size (type->size info type))
-                      (array (make-global name type -1 (string->list (make-string (* count size) #\nul))))
+                      (array (make-global-entry name type -1 (string->list (make-string (* count size) #\nul))))
                       (globals (append globals (list array))))
                  (clone info #:globals globals)))))
 
@@ -1422,7 +1420,7 @@
                (let* ((globals (.globals info))
                       (count (cstring->number count))
                       (size (type->size info type))
-                      (array (make-global name type 1 (string->list (make-string (* count size) #\nul))))
+                      (array (make-global-entry name type 1 (string->list (make-string (* count size) #\nul))))
                       (globals (append globals (list array))))
                  (clone info #:globals globals)))))
 
@@ -1449,7 +1447,7 @@
                       (info (clone info #:locals locals)))
                  (append-text info (append ((ident->accu info) value)
                                            ((accu->ident info) name))))
-               (let ((globals (append globals (list (ident->global name type 1 `(,value #f #f #f))))))
+               (let ((globals (append globals (list (ident->global-entry name type 1 `(,value #f #f #f))))))
                  (clone info #:globals globals)))))
 
         ;; enum foo { };
@@ -1513,7 +1511,7 @@
                       (global-names (map car globals))
                       (initzer-globals (filter (lambda (g) (and g (not (member (car g) global-names)))) initzer-globals))
                       (globals (append globals initzer-globals))
-                      (global (make-global name type 2 (append-map (initzer->data info) initzers)))
+                      (global (make-global-entry name type 2 (append-map (initzer->data info) initzers)))
                       (globals (append globals (list global))))
                  (clone info #:globals globals)))))
 
@@ -1535,8 +1533,8 @@
                 (initzers (map (initzer->non-const info) initzers)))
            (if (.function info)
                (error "TODO: <type> x[] = {};" o)
-               (let* ( ;;(global (make-global name type 2 (string->list (make-string size #\nul))))
-                      (global (make-global name type 2 (append-map (initzer->data info) initzers)))
+               (let* ( ;;(global (make-global-entry name type 2 (string->list (make-string size #\nul))))
+                      (global (make-global-entry name type 2 (append-map (initzer->data info) initzers)))
                       (global-names (map car globals))
                       (entries (filter (lambda (g) (and g (not (member (car g) global-names)))) entries))
                       (globals (append globals entries (list global))))
@@ -1551,7 +1549,7 @@
                           (local (make-local name type -1 (+ (local:id (cdr local)) -1 (quotient (+ size 3) 4))))
                           (locals (cons local locals)))
                      (clone info #:locals locals))))
-             (clone info #:globals (append globals (list (ident->global name type 0 0))))))
+             (clone info #:globals (append globals (list (ident->global-entry name type 0 0))))))
 
         ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr ,init . ,initzer)))
          (let* ((info (type->info info type))
@@ -1574,8 +1572,8 @@
                       (info (if (null? initzer) info (append-text info ((accu->ident info) name)))))
                  info)
                (let* ((pointer (if (and (pair? type) (equal? (car type) "struct")) 2 pointer))
-                      (global (make-global name type pointer (if (null? initzer) (string->list (make-string size #\nul))
-                                                                 (append-map (initzer->data info) initzer))))
+                      (global (make-global-entry name type pointer (if (null? initzer) (string->list (make-string size #\nul))
+                                                                       (append-map (initzer->data info) initzer))))
                       (globals (append globals (list global))))
                  (clone info #:globals globals)))))
 
@@ -1853,8 +1851,8 @@
       ((p-expr (string ,string))
        (let ((g `(#:string ,string)))
          (or (assoc g globals)
-             (string->global string))))
-      ;;((p-expr (fixed ,value)) (int->global (cstring->number value)))
+             (string->global-entry string))))
+      ;;((p-expr (fixed ,value)) (int->global-entry (cstring->number value)))
       (_ #f))))
 
 (define (initzer->globals globals)

diff --git a/module/language/c99/info.mes b/module/language/c99/info.mes
index 10c0366ab88d03fdb0aeba9b1ee2d94b92924ce3..4401bc9572f337c3a83428d16e2bae734a5a4195 100644 (file)
--- a/module/language/c99/info.mes
+++ b/module/language/c99/info.mes
@@ -102,3 +102,10 @@
 (define type:size cadr)
 (define type:pointer caddr)
 (define type:description cadddr)
+
+(define (make-global name type pointer value)
+  (cons name (list type pointer value)))
+
+(define global:type car)
+(define global:pointer cadr)
+(define global:value caddr)

diff --git a/module/language/c99/info.scm b/module/language/c99/info.scm
index 5ed5c06a030cdd47c2ff5bd53c01c20af662b012..129b89e6f5aaaedc3636627de3cb203cdf8e4840 100644 (file)
--- a/module/language/c99/info.scm
+++ b/module/language/c99/info.scm
@@ -30,7 +30,6 @@
   #:export (<info>
             make
             make-<info>
-            make-type
             info?
 
             .types
@@ -43,10 +42,18 @@
             .break
             .continue
 
+            make-type
+            type?
             type:type
             type:size
             type:pointer
-            type:description))
+            type:description
+
+            make-global
+            global?
+            global:type
+            global:pointer
+            global:value))
 
 (cond-expand
  (guile-2)
@@ -77,3 +84,10 @@
   (size type:size)
   (pointer type:pointer)
   (description type:description))
+
+(define-immutable-record-type <global>
+  (make-global type pointer value)
+  global?
+  (type global:type)
+  (pointer global:pointer)
+  (value global:value))