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

nyacc: fixed some c99/util2 items

Browse source
This commit is contained in:
Matt Wette 2017-02-18 17:06:50 -08:00 committed by Jan Nieuwenhuizen
parent 5bf49dfb54
commit bed639f680
2 changed files with 6 additions and 57 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
module/nyacc/lang/c99/cpp.scm
View file

@ -243,41 +243,7 @@
;; @deffn rtokl->string tokl => string
;; Convert reverse token-list to string.
(define (x-rtokl->string tokl)
;;(let iter ((stl '()) (chl '()) (nxt #f) (tkl tokl)) ;; more efficient
(let iter ((stl '()) (tkl tokl))
(match tkl
('()
(apply string-append stl))
((('arg . arg) 'dhash (key . val) . rest)
(iter stl (acons key (string-append val arg) (list-tail tkl 3))))
(((key . val) 'dhash ('arg . arg) . rest)
(iter stl (acons 'arg (string-append arg val) (list-tail tkl 3))))
((('arg . arg) 'hash . rest)
(iter (cons (string-append "\"" arg "\"") stl) (list-tail tkl 2)))
((('comm . val) . rest)
(iter (cons (string-append "/*" val " */") stl) (cdr tkl)))
((('ident . rval) ('ident . lval) . rest)
(iter (cons* " " rval stl) (cdr tkl)))
(((key . val) . rest)
(iter (cons val stl) (cdr tkl)))
(('space . rest)
(iter (cons " " stl) rest))
(((? char? ch) . rest)
(iter (cons (string ch) stl) rest))
(otherwise
(error "no match" tkl)))))
(define (y-rtokl->string tokl)
(define (rtokl->string tokl)
;; Turn reverse chl into a string and insert it into the string list stl.
(define (add-chl chl stl)
@ -320,8 +286,6 @@
(otherwise
(error "no match" tkl)))))))
(define rtokl->string y-rtokl->string)
;; @deffn scan-cpp-input argd used dict end-tok => string
;; Process replacement text from the input port and generate a (reversed)
;; token-list. If end-tok, stop at, and push back, @code{,} or @code{)}.

25
module/nyacc/lang/c99/util2.scm
View file

@ -151,7 +151,6 @@
;; ("union" ("bar" . decl) ..)
(define (tree->udict tree)
(if (pair? tree)
;;(reverse (fold match-decl '() (cdr tree)))
(fold match-decl '() (cdr tree))
'()))
@ -367,15 +366,13 @@
;; @example
;; typedef const int (*foo_t)(int a, double b);
;; extern foo_t fctns[2];
;; @noindent
;; This routine should create an init-declarator associated with
;; @end example
;; extern {const int} (*{fctns[2]})(int a, double b);
;; =>
;; extern const int (*fctns[2])(int a, double b);
;; @end example
;; @noindent
;; Cool. Eh? (but is it done?)
(define* (expand-decl-typerefs udecl udecl-dict #:key (keep '()))
(display "FIXME: some decls have no init-declr-list\n")
;;(display "FIXME: some decls have no init-declr-list\n")
;; between adding (init-declr-list) to those or having predicate
;; (has-init-declr? decl)
(let* ((tag (sx-tag udecl)) ; decl or comp-decl
@ -390,19 +387,8 @@
(case (car tspec)
((typename)
(cond
((member (cadr tspec) keep)
udecl)
#;((member (cadr tspec) fixed-width-int-names)
;; Convert it to @code{fixed-type}.
(let* ((name (cadr tspec))
(fixd-tspec `(type-spec (fixed-type ,name)))
(fixd-specl (repl-typespec specl fixd-tspec))
;; TODO add attr
(fixed-udecl (cons* tag fixd-specl declr tail)))
;;(expand-decl-typerefs fixed-udecl udecl-dict))) ; not needed ?
fixed-udecl))
(else
;; splice in the typedef
((member (cadr tspec) keep) udecl)
(else ;; splice in the typedef
(let* ((name (sx-ref tspec 1))
(decl (assoc-ref udecl-dict name)) ; decl for typename
(tdef-specl (sx-ref decl 1)) ; decl-spec-list for typename
@ -555,7 +541,6 @@
(define (udecl->mspec decl . rest)
(define (cnvt-array-size size-spec)
(simple-format #t "cnvt-array-size\n")
(with-output-to-string (lambda () (pretty-print-c99 size-spec))))
(define (unwrap-specl specl)