mescc: Use records for Guile: <type>.
* module/language/c99/info.scm (<type>): New record. * module/language/c99/compiler.mes (make-type-entry): Rename from make-type. Update-callers. * module/language/c99/info.mes (make-type, type:type, type:size, type:pointer, type:description): Move from compiler.mes.
This commit is contained in:
parent
5d54461f67
commit
c0fb6d247d
|
@ -893,33 +893,25 @@
|
||||||
(define (ident->constant name value)
|
(define (ident->constant name value)
|
||||||
(cons name value))
|
(cons name value))
|
||||||
|
|
||||||
(define (make-type name type size pointer description)
|
(define (enum->type-entry name fields)
|
||||||
(cons name (list type size pointer description)))
|
(cons name (make-type 'enum 4 0 fields)))
|
||||||
|
|
||||||
(define type:type car)
|
(define (struct->type-entry name fields)
|
||||||
(define type:size cadr)
|
(cons (list "struct" name) (make-type 'struct (apply + (map field:size fields)) 0 fields)))
|
||||||
(define type:pointer caddr)
|
|
||||||
(define type:description cadddr)
|
|
||||||
|
|
||||||
(define (enum->type name fields)
|
|
||||||
(make-type name 'enum 4 0 fields))
|
|
||||||
|
|
||||||
(define (struct->type name fields)
|
|
||||||
(make-type name 'struct (apply + (map field:size fields)) 0 fields))
|
|
||||||
|
|
||||||
(define i386:type-alist
|
(define i386:type-alist
|
||||||
'(("char" . (builtin 1 0 #f))
|
`(("char" . ,(make-type 'builtin 1 0 #f))
|
||||||
("short" . (builtin 2 0 #f))
|
("short" . ,(make-type 'builtin 2 0 #f))
|
||||||
("int" . (builtin 4 0 #f))
|
("int" . ,(make-type 'builtin 4 0 #f))
|
||||||
("long" . (builtin 4 0 #f))
|
("long" . ,(make-type 'builtin 4 0 #f))
|
||||||
("long long" . (builtin 8 0 #f))
|
("long long" . ,(make-type 'builtin 8 0 #f))
|
||||||
;; FIXME sign
|
;; FIXME sign
|
||||||
("unsigned char" . (builtin 1 0 #f))
|
("unsigned char" . ,(make-type 'builtin 1 0 #f))
|
||||||
("unsigned short" . (builtin 2 0 #f))
|
("unsigned short" . ,(make-type 'builtin 2 0 #f))
|
||||||
("unsigned" . (builtin 4 0 #f))
|
("unsigned" . ,(make-type 'builtin 4 0 #f))
|
||||||
("unsigned int" . (builtin 4 0 #f))
|
("unsigned int" . ,(make-type 'builtin 4 0 #f))
|
||||||
("unsigned long" . (builtin 4 0 #f))
|
("unsigned long" . ,(make-type 'builtin 4 0 #f))
|
||||||
("unsigned long long" . (builtin 8 0 #f))))
|
("unsigned long long" . ,(make-type 'builtin 8 0 #f))))
|
||||||
|
|
||||||
(define (field:size o)
|
(define (field:size o)
|
||||||
(pmatch o
|
(pmatch o
|
||||||
|
@ -1350,12 +1342,12 @@
|
||||||
|
|
||||||
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
|
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
|
||||||
(let* ((type (get-type types type))
|
(let* ((type (get-type types type))
|
||||||
(type (make-type name
|
(type (make-type (type:type type)
|
||||||
(type:type type)
|
|
||||||
(type:size type)
|
(type:size type)
|
||||||
(1+ (type:pointer type))
|
(1+ (type:pointer type))
|
||||||
(type:description type))))
|
(type:description type)))
|
||||||
(clone info #:types (cons type types))))
|
(type-entry (cons name type)))
|
||||||
|
(clone info #:types (cons type-entry types))))
|
||||||
|
|
||||||
|
|
||||||
;; struct foo* bar = expr;
|
;; struct foo* bar = expr;
|
||||||
|
@ -1370,8 +1362,8 @@
|
||||||
|
|
||||||
;; struct
|
;; struct
|
||||||
((decl (decl-spec-list (type-spec (struct-def (ident ,name) (field-list . ,fields)))))
|
((decl (decl-spec-list (type-spec (struct-def (ident ,name) (field-list . ,fields)))))
|
||||||
(let ((type (struct->type (list "struct" name) (map struct-field fields))))
|
(let ((type-entry (struct->type-entry name (map struct-field fields))))
|
||||||
(clone info #:types (cons type types))))
|
(clone info #:types (cons type-entry types))))
|
||||||
|
|
||||||
;; ;; struct foo {} bar;
|
;; ;; struct foo {} bar;
|
||||||
((decl (decl-spec-list (type-spec (struct-def (ident ,type) (field-list . ,fields))))
|
((decl (decl-spec-list (type-spec (struct-def (ident ,type) (field-list . ,fields))))
|
||||||
|
@ -1462,10 +1454,10 @@
|
||||||
|
|
||||||
;; enum foo { };
|
;; enum foo { };
|
||||||
((decl (decl-spec-list (type-spec (enum-def (ident ,name) (enum-def-list . ,fields)))))
|
((decl (decl-spec-list (type-spec (enum-def (ident ,name) (enum-def-list . ,fields)))))
|
||||||
(let ((type (enum->type name fields))
|
(let ((type-entry (enum->type-entry name fields))
|
||||||
(constants (enum-def-list->constants constants fields)))
|
(constants (enum-def-list->constants constants fields)))
|
||||||
(clone info
|
(clone info
|
||||||
#:types (append types (list type))
|
#:types (cons type-entry types)
|
||||||
#:constants (append constants (.constants info)))))
|
#:constants (append constants (.constants info)))))
|
||||||
|
|
||||||
;; enum {};
|
;; enum {};
|
||||||
|
@ -1477,8 +1469,8 @@
|
||||||
;; FIXME TCC/Nyacc madness here: extra parentheses around struct name?!?
|
;; FIXME TCC/Nyacc madness here: extra parentheses around struct name?!?
|
||||||
;; struct (FOO) WTF?
|
;; struct (FOO) WTF?
|
||||||
((decl (decl-spec-list (type-spec (struct-def (ident (,name)) (field-list . ,fields)))))
|
((decl (decl-spec-list (type-spec (struct-def (ident (,name)) (field-list . ,fields)))))
|
||||||
(let ((type (struct->type (list "struct" name) (map struct-field fields))))
|
(let ((type-entry (struct->type-entry name (map struct-field fields))))
|
||||||
(clone info #:types (append types (list type)))))
|
(clone info #:types (cons type-entry types))))
|
||||||
|
|
||||||
((decl (decl-spec-list (type-spec (struct-def (ident (,type)) (field-list . ,fields))))
|
((decl (decl-spec-list (type-spec (struct-def (ident (,type)) (field-list . ,fields))))
|
||||||
(init-declr-list (init-declr (ident ,name))))
|
(init-declr-list (init-declr (ident ,name))))
|
||||||
|
@ -1875,8 +1867,8 @@
|
||||||
(define (type->info info o)
|
(define (type->info info o)
|
||||||
(pmatch o
|
(pmatch o
|
||||||
((struct-def (ident ,name) (field-list . ,fields))
|
((struct-def (ident ,name) (field-list . ,fields))
|
||||||
(let ((type (struct->type (list "struct" name) (map struct-field fields))))
|
(let ((type-entry (struct->type-entry name (map struct-field fields))))
|
||||||
(clone info #:types (cons type (.types info)))))
|
(clone info #:types (cons type-entry (.types info)))))
|
||||||
(_ info)))
|
(_ info)))
|
||||||
|
|
||||||
(define (.formals o)
|
(define (.formals o)
|
||||||
|
|
|
@ -94,3 +94,11 @@
|
||||||
(cons <text> text)
|
(cons <text> text)
|
||||||
(cons <break> break)
|
(cons <break> break)
|
||||||
(cons <continue> continue)))))
|
(cons <continue> continue)))))
|
||||||
|
|
||||||
|
(define (make-type type size pointer description)
|
||||||
|
(list type size pointer description))
|
||||||
|
|
||||||
|
(define type:type car)
|
||||||
|
(define type:size cadr)
|
||||||
|
(define type:pointer caddr)
|
||||||
|
(define type:description cadddr)
|
||||||
|
|
|
@ -30,9 +30,9 @@
|
||||||
#:export (<info>
|
#:export (<info>
|
||||||
make
|
make
|
||||||
make-<info>
|
make-<info>
|
||||||
|
make-type
|
||||||
info?
|
info?
|
||||||
|
|
||||||
.info
|
|
||||||
.types
|
.types
|
||||||
.constants
|
.constants
|
||||||
.functions
|
.functions
|
||||||
|
@ -41,7 +41,12 @@
|
||||||
.function
|
.function
|
||||||
.text
|
.text
|
||||||
.break
|
.break
|
||||||
.continue))
|
.continue
|
||||||
|
|
||||||
|
type:type
|
||||||
|
type:size
|
||||||
|
type:pointer
|
||||||
|
type:description))
|
||||||
|
|
||||||
(cond-expand
|
(cond-expand
|
||||||
(guile-2)
|
(guile-2)
|
||||||
|
@ -64,3 +69,11 @@
|
||||||
|
|
||||||
(define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (locals '()) (function #f) (text '()) (break '()) (continue '()))
|
(define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (locals '()) (function #f) (text '()) (break '()) (continue '()))
|
||||||
(make-<info> types constants functions globals locals function text break continue))
|
(make-<info> types constants functions globals locals function text break continue))
|
||||||
|
|
||||||
|
(define-immutable-record-type <type>
|
||||||
|
(make-type type size pointer description)
|
||||||
|
type?
|
||||||
|
(type type:type)
|
||||||
|
(size type:size)
|
||||||
|
(pointer type:pointer)
|
||||||
|
(description type:description))
|
||||||
|
|
Loading…
Reference in a new issue