artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mescc: Handle comments anywhere.

Browse source 
* module/language/c99/compiler.mes (c99-input->full-ast): Rename from c99-input->full-ast.
  (ast-strip-comment, c99-input->ast): New functions.
  (ast->info): Remove comment exceptions.
This commit is contained in:
Jan Nieuwenhuizen 2017-05-25 19:48:26 +02:00
parent 92a330ff07
commit 3b4e7cd8a8
1 changed files with 14 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
module/language/c99/compiler.mes
View file

@ -53,7 +53,7 @@
(define mes? (pair? (current-module))) (define mes? (pair? (current-module)))
(define* (c99-input->ast #:key (defines '()) (includes '())) (define* (c99-input->full-ast #:key (defines '()) (includes '()))
(let ((include (if (equal? %prefix "") "libc/include" (string-append %prefix "/include")))) (let ((include (if (equal? %prefix "") "libc/include" (string-append %prefix "/include"))))
(parse-c99 (parse-c99
#:inc-dirs (append includes (cons* "." "libc" "src" "out" "out/src" include (string-split (getenv "C_INCLUDE_PATH") #\:))) #:inc-dirs (append includes (cons* "." "libc" "src" "out" "out/src" include (string-split (getenv "C_INCLUDE_PATH") #\:)))
@ -85,6 +85,19 @@
) )
#:mode 'code))) #:mode 'code)))
(define (ast-strip-comment o)
(pmatch o
((comment . ,comment) #f)
(((comment . ,comment) . ,t) (filter-map ast-strip-comment t))
(((comment . ,comment) . ,cdr) cdr)
((,car . (comment . ,comment)) car)
((,h . ,t) (if (list? o) (filter-map ast-strip-comment o)
(cons (ast-strip-comment h) (ast-strip-comment t))))
(_ o)))
(define* (c99-input->ast #:key (defines '()) (includes '()))
(ast-strip-comment (c99-input->full-ast #:defines defines #:includes includes)))
(define (ast:function? o) (define (ast:function? o)
(and (pair? o) (eq? (car o) 'fctn-defn))) (and (pair? o) (eq? (car o) 'fctn-defn)))
@ -1245,7 +1258,6 @@
((trans-unit . ,elements) ((trans-unit . ,elements)
((ast-list->info info) elements)) ((ast-list->info info) elements))
((fctn-defn . _) ((function->info info) o)) ((fctn-defn . _) ((function->info info) o))
((comment . _) info)
((cpp-stmt (define (name ,name) (repl ,value))) ((cpp-stmt (define (name ,name) (repl ,value)))
info) info)
@ -1699,10 +1711,6 @@
(let ((globals (append globals (list (ident->global name type 0 value))))) (let ((globals (append globals (list (ident->global name type 0 value)))))
(clone info #:globals globals))))) (clone info #:globals globals)))))
;; SCM g_stack = 0; // comment
((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident _) (initzer (p-expr (fixed _))))) (comment _))
((ast->info info) (list-head o (- (length o) 1))))
;; SCM i = argc; ;; SCM i = argc;
((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (ident ,local)))))) ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (ident ,local))))))
(if (.function info) (if (.function info)
@ -1962,9 +1970,6 @@
((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list))))) ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))))
(declare name)) (declare name))
((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))) (comment ,comment))
(declare name))
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name)))) ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name))))
(let ((types (.types info))) (let ((types (.types info)))
(clone info #:types (cons (cons name (assoc-ref types type)) types)))) (clone info #:types (cons (cons name (assoc-ref types type)) types))))