1 graydon 1.2 (* camlp4 front-end for a simplified make(1) language
2 copyright (C) 2002 Graydon Hoare <graydon@pobox.com>
3 GPL 2.x + no warranty provided or implied *)
|
4 graydon 1.1
5 (* construct a new Pcaml grammar entry yielding a MLast.str_item *)
6
|
7 graydon 1.3 open List
8
|
9 graydon 1.1 let makefile : MLast.str_item Grammar.Entry.e =
10 Grammar.Entry.create Pcaml.gram "makefile"
11
12 (* generate a new lexer from our ocamllex function *)
13
14 let makefile_lexer = { Token.func = (Token.lexer_func_of_ocamllex
15 Mlex.token);
16 Token.using = (fun _ -> ());
17 Token.removing = (fun _ -> ());
18 Token.tparse = (fun _ -> None);
19 Token.text = Token.lexer_text }
20
21 (* clear out existing camlp4 ocaml grammar entries *)
22
23 let _ =
24 begin
25 Pcaml.no_constructors_arity := true;
26 Grammar.Unsafe.reinit_gram Pcaml.gram (makefile_lexer);
27 Grammar.Unsafe.clear_entry Pcaml.interf;
28 Grammar.Unsafe.clear_entry Pcaml.implem;
29 Grammar.Unsafe.clear_entry Pcaml.top_phrase;
30 graydon 1.1 Grammar.Unsafe.clear_entry Pcaml.use_file;
31 Grammar.Unsafe.clear_entry Pcaml.module_type;
32 Grammar.Unsafe.clear_entry Pcaml.module_expr;
33 Grammar.Unsafe.clear_entry Pcaml.sig_item;
34 Grammar.Unsafe.clear_entry Pcaml.str_item;
35 Grammar.Unsafe.clear_entry Pcaml.expr;
36 Grammar.Unsafe.clear_entry Pcaml.patt;
37 Grammar.Unsafe.clear_entry Pcaml.ctyp;
38 Grammar.Unsafe.clear_entry Pcaml.let_binding;
39 Grammar.Unsafe.clear_entry Pcaml.class_type;
40 Grammar.Unsafe.clear_entry Pcaml.class_expr;
41 Grammar.Unsafe.clear_entry Pcaml.class_sig_item;
42 Grammar.Unsafe.clear_entry Pcaml.class_str_item
43 end
44
|
45 graydon 1.5 (* convert a makefile token to a nice ocaml identifier *)
46
47 let tidy w =
48 let str = String.lowercase w in
49 for i = 0 to (String.length str) - 1 do
50 let c = Char.code (str.[i]) in
51 if not ((c > 47 && c < 58)
52 || (c > 64 && c < 61)
53 || (c > 96 && c < 123)) then
54 str.[i] <- '_'
55 done;
56 str
57
58
|
59 graydon 1.1 (* helper: build a list AST node out of a list of AST nodes *)
60
61 let mk_list vals loc =
62 let rec loop v =
63 match v with
64 x::xs -> (<:expr< [ $x$ :: $loop xs$ ] >>)
65 | [] -> (<:expr< [] >>)
66 in
67 loop vals
68
69 (* helper: pull maybes out of list *)
70 let some xs =
71 let t = ref [] in
|
72 graydon 1.3 iter (function None -> () | Some x -> t := x :: !t) xs;
73 rev !t
|
74 graydon 1.1
75 type item = ASSIGN | RULE
76
77 (* describe makefiles *)
78
79 EXTEND
80
81 GLOBAL: Pcaml.implem makefile;
82
83 Pcaml.implem:
|
84 graydon 1.4 [ [ res = makefile -> ([(res, loc)], false) ] ];
|
85 graydon 1.1
86 makefile:
87 [ [ maybe_items = LIST0 makefile_item; EOF ->
|
88 graydon 1.3 let items = some maybe_items in
89 let rule_p (_, _, x) = match x with RULE -> true | ASSIGN -> false in
90 let (rules, assigns) = partition rule_p items in
91 let dead_rule = (<:patt< x >>, None, <:expr< Mk.Rule (x, [], []) >>) in
92 let live_rules = map (fun (n,_,_) ->
|
93 graydon 1.5 let n1 = tidy n in
94 (<:patt< $str:n$ >> , None, <:expr< $lid:n1$ () >>)) rules
|
95 graydon 1.3 in
96 let resz = live_rules @ [dead_rule] in
97 let resolver = (<:patt< resolve >>, <:expr< fun [ $list:resz$ ] >>) in
|
98 graydon 1.5 let bind (n, e, _) =
99 let pwel = [<:patt< _ >>, None, e] in
100 let n1 = tidy n in
101 <:patt< $lid:n1$ >> , <:expr< fun [$list:pwel$] >>
|
102 graydon 1.3 in
103 let r_binds = map bind rules in
104 let a_binds = map bind assigns in
105 let funs = resolver :: (a_binds @ r_binds) in
|
106 graydon 1.6 let (topname,_,_) = hd rules in
107 let top = tidy topname in
|
108 graydon 1.3 let tree = <:expr< let rec $list:funs$ in $lid:top$ () >> in
109 let entry = [( <:patt< _ >>, <:expr< Be.trans $tree$ >> )] in
110 let recur = false in
111 let items = [ <:str_item< value $rec:recur$ $list:entry$ >> ] in
112 <:str_item< declare $list:items$ end >> ] ];
|
113 graydon 1.1
114 makefile_item:
115 [
116 [ EOL -> None
117 | s = WORD; "="; ws = words; EOL -> Some (s, <:expr< $ws$ >>, ASSIGN)
118
119 | t = WORD; ":"; ws = words; EOL; a = actions ->
120 let ex = <:expr<
121 let targ = $str:t$ in
122 let dep_names = $ws$ in
123 let deps = List.map resolve dep_names in
124 let actions = $a$ in
|
125 graydon 1.3 Mk.Rule (targ, deps, actions)
|
126 graydon 1.1 >>
|
127 graydon 1.5 in Some (t, ex, RULE) ]
|
128 graydon 1.1 ];
129
130
131 actions:
132 [ [ az = LIST0 action -> (mk_list az loc) ] ];
133
134 action:
135 [ [ TAB; ws = words; EOL -> <:expr< String.concat " " $ws$ >> ] ];
136
137
138 words:
139 [ [ ws = LIST0 word -> (let ls = mk_list ws loc in <:expr< List.flatten $ls$ >>) ] ];
140
141 word:
142 [
143 [ w = WORD -> <:expr< [$str:w$] >>
144 | "$"; "^" -> <:expr< dep_names >>
145 | "$"; "<" -> <:expr< [List.hd dep_names] >>
146 | "$"; "@" -> <:expr< [targ] >>
|
147 graydon 1.5 | "$"; "("; w = WORD; ")" -> let w2 = tidy w in <:expr< ($lid:w2$ ()) >> ]
|
148 graydon 1.1 ];
149
150 END
151 ;;
|
Return to
fe.ml
CVS log
Up to [venge] / src / mkc