mescc: Use records for Guile: <local>.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sat, 15 Jul 2017 09:46:13 +0000 (11:46 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Wed, 26 Jul 2017 09:36:08 +0000 (11:36 +0200)
* module/language/c99/info.scm (<local>): New record.
* module/language/c99/compiler.mes (make-local-entry): Rename from
  make-local.  Update callers.
  (local-var?): Rename from local?. Update callers.
* module/language/c99/info.mes (make-local, local:type, local:pointer,
  local:id): Move from compiler.mes.

module/language/c99/compiler.mes
module/language/c99/info.mes
module/language/c99/info.scm

index e1fd50b4138d10275210ffbed691f824e518ba47..4d15b89c15e884bcb6a05551bfdfe20853fc7e4b 100644 (file)
 (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)))
-(define local:type car)
-(define local:pointer cadr)
-(define local:id caddr)
+(define (make-local-entry name type pointer id)
+  (cons name (make-local type pointer id)))
 
 (define (push-ident info)
   (lambda (o)
           (text (.text info))
           (globals (.globals info)))
       (define (add-local locals name type pointer)
-        (let* ((id (if (or (null? locals) (not (local? (cdar locals)))) 1
+        (let* ((id (if (or (null? locals) (not (local-var? (cdar locals)))) 1
                        (1+ (local:id (cdar locals)))))
-               (locals (cons (make-local name type pointer id) locals)))
+               (locals (cons (make-local-entry name type pointer id) locals)))
           locals))
       (pmatch o
         ((expr) info)
 (define (ident->type info o)
   (let ((type (ident->decl info o)))
     (cond ((global? type) (global:type type))
-          (else (car type)))))
+          ((local? type) (local:type type))
+          (else (stderr "ident->type ~s => ~s\n" o type)
+                (car type)))))
 
 (define (ident->pointer info o)
   (let ((local (assoc-ref (.locals info) o)))
          (if type (type:description type)
              (error "type->description: unsupported:" o))))))
 
-(define (local? o) ;; formals < 0, locals > 0
+(define (local-var? o) ;; formals < 0, locals > 0
   (positive? (local:id o)))
 
 (define (ptr-declr->pointer o)
           (types (.types info))
           (text (.text info)))
       (define (add-local locals name type pointer)
-        (let* ((id (if (or (null? locals) (not (local? (cdar locals)))) 1
+        (let* ((id (if (or (null? locals) (not (local-var? (cdar locals)))) 1
                        (1+ (local:id (cdar locals)))))
-               (locals (cons (make-local name type pointer id) locals)))
+               (locals (cons (make-local-entry name type pointer id) locals)))
           locals))
       (define (declare name)
         (if (member name functions) info
                (let* ((local (car (add-local locals name type -1)))
                       (count (string->number count))
                       (size (type->size info type))
-                      (local (make-local name type -1 (+ (local:id (cdr local)) -1 (quotient (+ (* count size) 3) 4))))                      
+                      (local (make-local-entry name type -1 (+ (local:id (cdr local)) -1 (quotient (+ (* count size) 3) 4))))                      
                       (locals (cons local locals))
                       (info (clone info #:locals locals)))
                  info)
                (let* ((local (car (add-local locals name type -1)))
                       (count (string->number count))
                       (size (type->size info type))
-                      (local (make-local name type 1 (+ (local:id (cdr local)) -1 (quotient (+ (* count size) 3) 4))))
+                      (local (make-local-entry name type 1 (+ (local:id (cdr local)) -1 (quotient (+ (* count size) 3) 4))))
                       (locals (cons local locals))
                       (info (clone info #:locals locals)))
                  info)
              (let ((size (type->size info type)))
                (if (<= size 4) (clone info #:locals (add-local locals name type 0))
                    (let* ((local (car (add-local locals name type 1)))
-                          (local (make-local name type -1 (+ (local:id (cdr local)) -1 (quotient (+ size 3) 4))))
+                          (local (make-local-entry 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-entry name type 0 0))))))
   (pmatch o
     ((param-list . ,formals)
      (let ((n (length formals)))
-       (map make-local (map .name formals) (map .type formals) (map formal:ptr formals) (iota n -2 -1))))
+       (map make-local-entry (map .name formals) (map .type formals) (map formal:ptr formals) (iota n -2 -1))))
     (_ (error "formals->locals: unsupported: " o))))
 
 (define (function->info info)
index 4401bc9572f337c3a83428d16e2bae734a5a4195..933a4ed59771aa96bcaed82a3c02c5077c33a447 100644 (file)
 (define global:type car)
 (define global:pointer cadr)
 (define global:value caddr)
+
+(define (make-local type pointer id)
+  (list type pointer id))
+(define local:type car)
+(define local:pointer cadr)
+(define local:id caddr)
index 129b89e6f5aaaedc3636627de3cb203cdf8e4840..35e68c82e15eb0552bf64f538e47f6a737d719b9 100644 (file)
             global?
             global:type
             global:pointer
-            global:value))
+            global:value
+
+            make-local
+            local?
+            local:type
+            local:pointer
+            local:id))
 
 (cond-expand
  (guile-2)
   (type global:type)
   (pointer global:pointer)
   (value global:value))
+
+(define-immutable-record-type <local>
+  (make-local type pointer id)
+  local?
+  (type local:type)
+  (pointer local:pointer)
+  (id local:id))