From 69e997047aa891f10d3566ec413131acee0b8737 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sat, 15 Jul 2017 11:46:13 +0200 Subject: [PATCH] mescc: Use records for Guile: . * module/language/c99/info.scm (): 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 | 29 ++++++++++++++--------------- module/language/c99/info.mes | 6 ++++++ module/language/c99/info.scm | 15 ++++++++++++++- 3 files changed, 34 insertions(+), 16 deletions(-) diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes index e1fd50b4..4d15b89c 100644 --- a/module/language/c99/compiler.mes +++ b/module/language/c99/compiler.mes @@ -215,11 +215,8 @@ (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) @@ -448,9 +445,9 @@ (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) @@ -1130,7 +1127,9 @@ (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))) @@ -1161,7 +1160,7 @@ (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) @@ -1234,9 +1233,9 @@ (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 @@ -1395,7 +1394,7 @@ (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) @@ -1413,7 +1412,7 @@ (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) @@ -1546,7 +1545,7 @@ (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)))))) @@ -1909,7 +1908,7 @@ (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) diff --git a/module/language/c99/info.mes b/module/language/c99/info.mes index 4401bc95..933a4ed5 100644 --- a/module/language/c99/info.mes +++ b/module/language/c99/info.mes @@ -109,3 +109,9 @@ (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) diff --git a/module/language/c99/info.scm b/module/language/c99/info.scm index 129b89e6..35e68c82 100644 --- a/module/language/c99/info.scm +++ b/module/language/c99/info.scm @@ -53,7 +53,13 @@ global? global:type global:pointer - global:value)) + global:value + + make-local + local? + local:type + local:pointer + local:id)) (cond-expand (guile-2) @@ -91,3 +97,10 @@ (type global:type) (pointer global:pointer) (value global:value)) + +(define-immutable-record-type + (make-local type pointer id) + local? + (type local:type) + (pointer local:pointer) + (id local:id))