(ctl cpi-ctl set-cpi-ctl!) ; current typename list
)
-;;.@deffn split-cppdef defstr => (<name> . <repl>)|((<name> <args> . <repl>)|#f
+;;.@deffn Procedure split-cppdef defstr => (<name> . <repl>)| \
+;; ((<name> <args> . <repl>)|#f
;; Convert define string to a dict item. Examples:
;; @example
;; "ABC=123" => '("ABC" . "123")
;; "MAX(X,Y)=((X)>(Y)?(X):(Y))" => ("MAX" ("X" "Y") . "((X)>(Y)?(X):(Y))")
;; @end example
+;; @end deffn
(define split-cppdef
(let ((rx1 (make-regexp "^([A-Za-z0-9_]+)\\([^)]*\\)=(.*)$"))
(rx2 (make-regexp "^([A-Za-z0-9_]+)=(.*)$")))
(cons s1 s2))))
(else #f))))))
-;; @deffn make-cpi debug defines incdirs inchelp
+;; @deffn Procedure make-cpi debug defines incdirs inchelp
+;; @end deffn
(define (make-cpi debug defines incdirs inchelp)
;; convert inchelp into inc-file->typenames and inc-file->defines
;; Any entry for an include file which contains `=' is considered
(define *info* (make-fluid #f))
-;; @deffn typename? name
+;; @deffn {Procedure} typename? name
;; Called by lexer to determine if symbol is a typename.
;; Check current sibling for each generation.
+;; @end deffn
(define (typename? name)
(let ((cpi (fluid-ref *info*)))
(if (member name (cpi-ctl cpi)) #t
(if (member name (car ptl)) #t
(iter (cdr ptl))))))))
-;; @deffn add-typename name
+;; @deffn {Procedure} add-typename name
;; Helper for @code{save-typenames}.
+;; @end deffn
(define (add-typename name)
(let ((cpi (fluid-ref *info*)))
(set-cpi-ctl! cpi (cons name (cpi-ctl cpi)))))
(set-cpi-ctl! cpi (append (cpi-ctl cpi) (car (cpi-ptl cpi))))
(set-cpi-ptl! cpi (cdr (cpi-ptl cpi)))))
-;; @deffn find-new-typenames decl
+;; @deffn {Procedure} find-new-typenames decl
;; Helper for @code{save-typenames}.
;; Given declaration return a list of new typenames (via @code{typedef}).
+;; @end deffn
(define (find-new-typenames decl)
;; like declr->ident in util2.scm
(cdr idl))))
'())))
-;; @deffn save-typenames decl
+;; @deffn {Procedure} save-typenames decl
;; Save the typenames for the lexical analyzer and return the decl.
+;; @end deffn
(define (save-typenames decl)
;; This finds typenames using @code{find-new-typenames} and adds via
;; @code{add-typename}. Then return the decl.
(define (p-err . args)
(apply throw 'c99-error args))
-;; @deffn read-cpp-line ch => #f | (cpp-xxxx)??
+;; @deffn {Procedure} read-cpp-line ch => #f | (cpp-xxxx)??
;; Given if ch is #\# read a cpp-statement.
;; The standard implies that comments are tossed here but we keep them
;; so that they can end up in the pretty-print output.
+;; @end deffn
(define (read-cpp-line ch)
(if (not (eq? ch #\#)) #f
(let iter ((cl '()) (ch (read-char)))
(iter (cons #\/ cl) c2)))))
(else (iter (cons ch cl) (read-char)))))))
-;; @deffn find-file-in-dirl file dirl => path
+;; @deffn {Procedure} find-file-in-dirl file dirl => path
+;; @end deffn
(define (find-file-in-dirl file dirl)
(let iter ((dirl dirl))
(if (null? dirl) #f
(define (def-xdef? name mode)
(eqv? mode 'code))
-;; @deffn gen-c-lexer [#:mode mode] [#:xdef? proc] => procedure
+;; @deffn {Procedure} gen-c-lexer [#:mode mode] [#:xdef? proc] => procedure
;; Generate a context-sensitive lexer for the C99 language. The generated
;; lexical analyzer reads and passes comments and optionally CPP statements
;; to the parser. The keyword argument @var{mode} will determine if CPP
;; @example
;; (define (def-xdef? mode name) (eqv? mode 'code))
;; @end example
+;; @end deffn
(define gen-c-lexer
;; This gets ugly in order to handle cpp.
;;.need to add support for num's w/ letters like @code{14L} and @code{1.3f}.
("wctype.h" "wctrans_t" "wctype_t" "wint_t")
))
-;; @deffn gen-gcc-defs args [#:CC "clang"] => '(("ABC" . "123") ...)
+;; @deffn {Procedure} gen-gcc-defs args [#:CC "clang"] => '(("ABC" . "123") ...)
;; Generate a list of default defines produced by gcc (or clang).
+;; @end deffn
(define gen-gcc-defs
;; @code{"gcc -dM -E"} will generate lines like @code{"#define ABC 123"}.
;; We generate and return a list like @code{'(("ABC" . "123") ...)}.
(if (eof-object? line) lines
(iter (cons line lines) (read-line ip 'trim)))))))))
-;; @item remove-inc-trees tree
+;; @deffn {Procedure} remove-inc-trees tree
;; Remove the trees included with cpp-include statements.
;; @example
;; '(... (cpp-stmt (include "<foo.h>" (trans-unit ...))) ...)
;; => '(... (cpp-stmt (include "<foo.h>")) ...)
;; @end example
+;; @end deffn
(define (remove-inc-trees tree)
(if (not (eqv? 'trans-unit (car tree))) (error "expecting c-tree"))
(let iter ((rslt (make-tl 'trans-unit))
(cdr tree)))
(else (iter (tl-append rslt (car tree)) (cdr tree))))))
-;; @item merge-inc-trees tree
+;; @deffn {Procedure} merge-inc-trees tree
;; Remove the trees included with cpp-include statements.
;; @example
;; '(... (cpp-stmt (include "<foo.h>" (trans-unit (stmt ...))) ...)
;; => '(... (stmt...) ...)
;; @end example
+;; @end deffn
#;(define (Xmerge-inc-trees tree)
(if (not (eqv? 'trans-unit (car tree))) (error "expecting c-tree"))
(let iter ((rslt (make-tl 'trans-unit))
(else (iter (tl-append rslt (car tree)) (cdr tree))))))
-;; @item merge-inc-trees! tree => tree
+;; @deffn {Procedure} merge-inc-trees! tree => tree
;; This will (recursively) merge code from cpp-includes into the tree.
;; @example
;; (trans-unit
;; =>
;; (trans-unit (decl (a)) (decl (b)) (decl (c)))
;; @end example
+;; @end deffn
(define (merge-inc-trees! tree)
;; @item find-span (trans-unit a b c) => ((a . +->) . (c . '())
tree)
-;; @deffn elifify tree => tree
+;; @deffn {Procedure} elifify tree => tree
;; This procedure will find patterns of
;; @example
;; (if cond-1 then-part-1
;; (elif cond-2 then-part-2)
;; else-part-2
;; @end example
+;; @end deffn
(define (elifify tree)
(define (fU tree)
(sxml-match tree
;; may need to replace (typename "int32_t") with (fixed-type "int32_t")
-;; @deffn declr->ident declr => (ident "name")
+;; @deffn {Procedure} declr->ident declr => (ident "name")
;; just match the declarator
;; (init-declr <declr> [<initzer>])
;; See also: declr->id-name in body.scm.
+;; @end deffn
(define (declr->ident declr)
(sxml-match declr
((init-declr ,declr . ,rest) (declr->ident declr))
((scope ,declr) (declr->ident declr))
(,otherwise (throw 'util-error "c99/util2: unknown declarator: " declr))))
-;; @deffn unwrap-decl decl seed => seed
+;; @deffn {Procedure} unwrap-decl decl seed => seed
;; This is a fold to break up multiple declarators.
;; @example
;; (decl (decl-spec-list ...) (init-declr-list (init-declr ...) ...))
;; (decl (decl-spec-list ...) (init-declr ...))
;; ...)
;; @end example
+;; @end deffn
(define (unwrap-decl decl seed)
(cond
((not (eqv? 'decl (car decl))) seed)
(cdr idl)))))))))
-;; @deffn tree->udict tree => udict
+;; @deffn {Procedure} tree->udict tree => udict
;; Turn a C parse tree into a assoc-list of names and definitions.
;; This will unwrap @code{init-declr-list} into list of decls w/
;; @code{init-declr}.
;; solution: match-decl => '(struct . "foo") then filter to generate
;; ("struct" ("foo" . decl) ..)
;; ("union" ("bar" . decl) ..)
+;; @end deffn
(define (tree->udict tree)
(if (pair? tree)
(fold match-decl '() (cdr tree))
'()))
-;; @deffn match-decl decl seed
+;; @deffn {Procedure} match-decl decl seed
;; This procedure is intended to be used with @code{fold}. It breaks up
;; up the init-declr-list into individual init-declr items and associates
;; with the identifier being declared. So this is a fold iterator to
;; @end example
;; TODO: add enums because they are global!!
;; turn enum { ABC = 123 }; into '(ABC . (enum .. "ABC" "123" .. )
+;; @end deffn
(define (match-decl decl seed)
(let* ((tag (sx-ref decl 0)) (attr (sx-attr decl)))
(case tag
(cdr idl))))))))))
(else seed))))
-;; @deffn match-comp-decl decl seed
+;; @deffn {Procedure} match-comp-decl decl seed
;; This will turn
;; @example
;; (comp-decl (decl-spec-list (type-spec "int"))
;; @noindent
;; This is coded to be used with fold-right in order to preserve order
;; in @code{struct} and @code{union} field lists.
+;; @end deffn
(define (match-comp-decl decl seed)
(if (not (eqv? 'comp-decl (car decl))) seed
(let* ((tag (sx-ref decl 0))
(cons* tag spec (car idl) tail))
(iter res (cdr idl)))))))))
-;; @deffn match-param-decl param-decl seed
+;; @deffn {Procedure} match-param-decl param-decl seed
;; This will turn
;; @example
;; (param-decl (decl-spec-list (type-spec "int")) (param-declr (ident "a")))
;; @noindent
;; This is coded to be used with fold-right in order to preserve order
;; in @code{struct} and @code{union} field lists.
+;; @end deffn
(define (match-param-decl decl seed)
(if (not (eqv? 'param-decl (car decl))) seed
(let* ((tag (sx-ref decl 0))
;; (enum . ("bar" ...) ...)
;; seed)
;; @end example
+;; @end deffn
(define (find-special udecl-alist seed)
(let iter ((struct '()) (union '()) (enum '()) (udal udecl-alist))
(if (null? udal) (cons* (cons 'struct struct)
'("int8_t" "uint8_t" "int16_t" "uint16_t"
"int32_t" "uint32_t" "int64_t" "uint64_t"))
-;; @deffn typedef-decl? decl)
+;; @deffn {Procedure} typedef-decl? decl)
+;; @end deffn
(define (typedef-decl? decl)
(sxml-match decl
((decl (decl-spec-list (stor-spec (typedef)) . ,r1) . ,r2) #t)
(,otherwise #f)))
-;; @deffn splice-declarators orig-declr tdef-declr =>
+;; @deffn {Procedure} splice-declarators orig-declr tdef-declr =>
;; Splice the original declarator into the typedef declarator.
;; This is a helper for @code{expand-*-typename-ref} procecures.
+;; @end deffn
(define (splice-declarators orig-declr tdef-declr)
(define (fD seed tree) ; => (values seed tree)
(cdr (foldts* fD fU fH '() tdef-declr)))) ; always init-declr
-;; @deffn repl-typespec decl-spec-list replacement
+;; @deffn {Procedure} repl-typespec decl-spec-list replacement
;; This is a helper for expand-decl-typerefs
+;; @end deffn
(define (repl-typespec decl-spec-list replacement)
(fold-right
(lambda (item seed)
(else (cons item seed))))
'() decl-spec-list))
-;; @deffn expand-decl-typerefs udecl udecl-dict => udecl
+;; @deffn {Procedure} expand-decl-typerefs udecl udecl-dict => udecl
;; Given a declaration or component-declaration, expand all typename,
;; struct, union and enum refs.
;; @example
;; @end example
;; @noindent
;; Cool. Eh? (but is it done?)
+;; @end deffn
(define* (expand-decl-typerefs udecl udecl-dict #:key (keep '()))
;;(display "FIXME: some decls have no init-declr-list\n")
;; between adding (init-declr-list) to those or having predicate
(else udecl))))
-;; @deffn canize-enum-def-list
+;; @deffn {Procedure} canize-enum-def-list
;; Fill in constants for all entries of an enum list.
+;; @end deffn
(define (canize-enum-def-list enum-def-list)
(define (get-used edl)
(let iter ((uzd '()) (edl edl))
;; =>
;; [TO BE DOCUMENTED]
;; @end example
+;; @end deffn
(define* (stripdown udecl decl-dict #:key (keep '()))
;;(define strip-list '(stor-spec type-qual comment))
))
-;; @deffn udecl->mspec sudecl
+;; @deffn {Procedure} udecl->mspec sudecl
;; Turn a stripped-down unit-declaration into an m-spec.
;; This assumes decls have been run through @code{stripdown}.
+;; @end deffn
(define (udecl->mspec decl . rest)
(define (cnvt-array-size size-spec)
(m-decl (reverse (cons m-specl m-declr))))
m-decl))
-;; @deffn udecl->mspec/comm decl [dict] [#:def-comm ""]
+;; @deffn {Procedure} udecl->mspec/comm decl [dict] [#:def-comm ""]
;; Convert declaration tree to an mspec
;; @example
;; (decl ... (comment "state vector")
;; =>
;; ("x" "state vector" (array-of 10) (float "double")
;; @end example
+;; @end deffn
(define* (udecl->mspec/comm decl #:optional (dict '()) #:key (def-comm ""))
(let* ((comm (or (and=> (sx-ref decl 3) cadr) def-comm))
(spec (udecl->mspec decl dict)))
(cons* (car spec) comm (cdr spec))))
-;; @deffn fix-fields flds => flds
+;; @deffn {Procedure} fix-fields flds => flds
;; This will take a list of fields from a struct and remove lone comments.
;; If a field following a lone comment has no code-comment, the lone comment
;; will be used. For example,
;; int x; /* foo */
;; @end example
;; @noindent
+;; @end deffn
(define (fix-fields flds)
(let iter ((rz '()) (cl '()) (fl flds))
;;(pretty-print fl)
projects / mes.git / commitdiff