blob: 3ca12590506576239bf2da45d23f12c616c1f449 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
;; -*- lisp -*-
;; file tmatch-3.melt
#| run in buildir/gcc
./cc1 -fmelt=translatefile -fmelt-dynlibdir=. \
-fmelt-compile-script=./built-melt-cc-script \
-fmelt-gensrcdir=. -fmelt-tempdir=/tmp -fmelt-init=@warmelt2 \
-fmelt-arg=..../tmatch-3.melt -fmelt-debug
|#
(defprimitive tree_content (v) :tree
"(basilys_tree_content((basilys_ptr_t)(" v ")))")
;; pattern (tree_function_decl <funame>) match a tree for a function
;; declaration
(defcmatcher tree_function_decl
(:tree tr) ;matched
;; output
(:cstring funame
:tree initialdcl
)
treefun ;state symbol
(; test expansion
"((" tr ") && TREECODE(" tr ") == FUNCTION_DECL)"
)
(;; fill expansion
funame "=NULL; "
initialdcl "=NULL; "
"if (DECL_NAME(" tr ")) "
funame "= IDENTIFIER_POINTER(DECL_NAME(" tr ")); "
initialdcl "=DECL_INITIAL(" tr "); "
)
)
(defprimitive debugtree (:cstring msg :tree tr) :void
" do{debugeprintf(\"debugtree %s @%p\", " msg ", (void*)" tr ");"
"if (flag_basilys_debug) debug_tree(" tr ");}while(0) "
)
(defun tmatch_tree (declv)
(match
(tree_content declv)
( ?(tree_function_decl ?funam ?initree)
(debugtree "tmatchinitree" initree)
)
))
|
