;; @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)
(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{)}.
;; ("union" ("bar" . decl) ..)
(define (tree->udict tree)
(if (pair? tree)
- ;;(reverse (fold match-decl '() (cdr tree)))
(fold match-decl '() (cdr tree))
'()))
;; @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
(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
(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)