(define (make-local-entry name type pointer id)
(cons name (make-local type pointer id)))
+(define* (mescc:trace name #:optional (type ""))
+ (format (current-error-port) " :~a~a\n" name type))
+
(define (push-ident info)
(lambda (o)
(let ((local (assoc-ref (.locals info) o)))
(ptr-b (expr->pointer info b))
(size-a (expr->size info a))
(size-b (expr->size info b))
- ;; (foo (stderr "assign ~s\n"(with-output-to-string (lambda () (pretty-print-c99 o)))))
- ;; (foo (stderr " size-a: ~a, ptr=~a\n" size-a ptr-a))
- ;; (foo (stderr " size-b: ~a, ptr=~a\n" size-b ptr-b))
(info ((expr->accu info) b))
(info (if (equal? op "=") info
(let* ((ptr (expr->pointer info a))
(locals (cons local locals))
(info (clone info #:locals locals)))
info)
- (let* ((globals (.globals info))
+ (let* ((foo (mescc:trace name " <g>"))
+ (globals (.globals info))
(count (expr->number info count))
(size (ast-type->size info type))
(pointer (expr->pointer info `(type-spec ,type)))
(locals (cons local locals))
(info (clone info #:locals locals)))
info)
- (let* ((globals (.globals info))
+ (let* ((foo (mescc:trace name " <g>"))
+ (globals (.globals info))
(count (expr->number info count))
(size 4)
(pointer (expr->pointer info `(type-spec ,type)))
(globals (append globals (list global))))
(clone info #:globals globals)))))
- ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (array-of (ident ,array) (p-expr (fixed ,size))) (initzer (p-expr (string ,string))))))
+ ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (array-of (ident ,name) (p-expr (fixed ,size))) (initzer (p-expr (string ,string))))))
(if (.function info)
(error "TODO: " o)
- (let* ((globals (.globals info))
+ (let* ((foo (mescc:trace name " <g>"))
+ (globals (.globals info))
;; (count (cstring->number count))
;; (size (ast-type->size info type))
- (array (make-global-entry array type -1 (string->list string)))
+ (array (make-global-entry name type -1 (string->list string)))
(globals (append globals (list array))))
(clone info #:globals globals))))
;; struct f = {...};
;; LOCALS!
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ident ,name) (initzer (initzer-list . ,initzers)))))
+ (if (not (.function info)) (mescc:trace name " <g>"))
(let* ((info (append-text info (ast->comment o)))
(type (decl->ast-type type))
(fields (ast-type->description info type))
;; DECL
;; char *bla[] = {"a", "b"};
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr (pointer) (array-of (ident ,name))) (initzer (initzer-list . ,initzers)))))
+ (if (not (.function info)) (mescc:trace name " <g>"))
(let* ((type (decl->ast-type type))
(pointer (pke "2pointer: " (expr->pointer info `(type-spec ,type))))
(pointer (pke "pointer: " (- -3 pointer)))
;; int foo[2] = { ... }
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (array-of (ident ,name) ,count) (initzer (initzer-list . ,initzers)))))
+ (if (not (.function info)) (mescc:trace name " <g>"))
(let* ((info (type->info info type))
(xtype type)
(type (decl->ast-type type))
(xtype type)
(type (decl->ast-type type))
(name (init-declr->name init))
- (pointer (pke "pointer:" (init-declr->pointer init)))
+ (foo (if (not (.function info)) (mescc:trace name " <g>")))
+ (pointer (init-declr->pointer init))
(initzer-globals (if (null? initzer) '()
(filter identity (append-map (initzer->globals globals) initzer))))
(global-names (map car globals))
(initzer-globals (filter (lambda (g) (and g (not (member (car g) global-names)))) initzer-globals))
(initzer (if (null? initzer) '() ((initzer->non-const info) initzer)))
+ ;;FIXME: ridiculous performance hit with mes
(info (append-text info (ast->comment o)))
(globals (append globals initzer-globals))
(info (clone info #:globals globals))
(define (enum-def-list->constants constants fields)
(let loop ((fields fields) (i 0) (constants constants))
+ (if (pair? fields)
+ (let ((field (car fields)))
+ (mescc:trace (cadr (cadr field)) " <e>")))
(if (null? fields) constants
(let* ((field (car fields))
(name (pmatch field
(define (type->info info o)
(pmatch o
((struct-def (ident ,name) (field-list . ,fields))
+ (mescc:trace name " <t>")
(let ((type-entry (struct->type-entry name (map (struct-field info) fields))))
(clone info #:types (cons type-entry (.types info)))))
(_ info)))
(formals (.formals o))
(text (formals->text formals))
(locals (formals->locals formals)))
- (format (current-error-port) " :~a\n" name)
+ (mescc:trace name)
(let loop ((statements (.statements o))
(info (clone info #:locals locals #:function (.name o) #:text text)))
(if (null? statements) (let* ((locals (.locals info))