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:
Jan Nieuwenhuizen 2017-07-15 10:40:31 +02:00
parent 5d54461f67
commit c0fb6d247d
3 changed files with 50 additions and 37 deletions

View file

@ -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)

View file

@ -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)

View file

@ -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))