1#include "share/atspre_staload.hats"
  2#define ATS_DYNLOADFLAG 0
  3staload "scan.sats"
  4staload "parse.sats"
  5
  6exception ParseErr of ()
  7
  8fun parts_free(p: List0_vt(stringpart)): void =
  9    case+ p of
 10    | ~nil_vt ()           => ()
 11    | ~cons_vt(part, rest) => (
 12        (case+ part of
 13        | ~Literal (text) => strptr_free(text)
 14        | ~Variable(text) => strptr_free(text) );
 15        parts_free(rest) )
 16
 17fun bindings_free(b: List0_vt(binding)): void =
 18    case+ b of 
 19    (* tilde means destroy the list wrapper*)
 20    | ~nil_vt()             => ()
 21    | ~cons_vt(entry, rest) =>
 22    let
 23        (* construct new local variables(k,v) from 
 24         * the entry record *)
 25        val @{key = k, value = v} = entry
 26    in
 27        strptr_free  (k);
 28        parts_free   (v);
 29        bindings_free(rest)
 30    end
 31
 32fun rule_free(r: List0_vt(rule)): void =
 33    case+ r of
 34    | ~nil_vt() => ()
 35    | ~cons_vt(rule, rest) =>
 36    let 
 37        val @{name = n, bindings = b} = rule
 38    in
 39        strptr_free  (n);
 40        bindings_free(b);
 41        rule_free    (rest)
 42    end
 43
 44fun paths_free(p: List0_vt(Strptr1)): void = 
 45    case+ p of 
 46    | ~nil_vt() => ()
 47    | ~cons_vt(path, rest) => (
 48    strptr_free(path);
 49    paths_free(rest)) 
 50
 51fun edge_free(e: List0_vt(edge)): void = 
 52    case+ e of 
 53    | ~nil_vt() => ()
 54    | ~cons_vt(edge, rest) =>
 55    let 
 56        val @{output = o, rule = r, input = i, bindings = b} = edge
 57    in
 58        paths_free(o);
 59        strptr_free(r);
 60        paths_free(i);
 61        bindings_free(b);
 62        edge_free(rest)
 63end
 64
 65implement manifest_free(m) =
 66let
 67    val @{rules = r, edges = e, variables = v} = m
 68in
 69    rule_free(r);
 70    edge_free(e);
 71    bindings_free(v)
 72end
 73
 74fun binding_val(s: &scanner): List0_vt(stringpart) = 
 75let
 76    val ()   = skipspace(s)
 77    val ()   = scanchar(s, char2int0('='))
 78    val text = scanvalue(s) 
 79in
 80    if s.cur = char2int0('\n') then (
 81        next(s);
 82        text)
 83    else(
 84        parts_free(text);
 85        prerrln!("expected newline after value at", s.line,":",s.col );
 86        $raise ParseErr )
 87end
 88
 89(* creates records if it sees indentation and adds them to a list, if it stops
 90 * seeing indentation, return the list *) 
 91fun parsebindings(s: &scanner, b: List0_vt(binding)): List0_vt(binding) = 
 92    if scanindent(s) then 
 93        let
 94            val key   = scanname(s)
 95            val value = binding_val(s)
 96            val entry: binding = @{key = key, value = value}
 97            val more = cons_vt(entry, b)
 98        in
 99            parsebindings(s, more)
100        end
101    else(list_vt_reverse(b))
102   
103fun variable(s: &scanner, name: Strptr1): binding = 
104let
105    val value = binding_val(s)
106in 
107    @{key = name, value = value}
108end
109
110
111(* does a list of bindings contain a "command" binding *)
112fun hascommand(bindings: !List0_vt(binding)): bool =
113    case+ bindings of 
114    | nil_vt() => false
115    | @cons_vt(entry, rest) =>
116    let 
117        val found = if list_vt_length(entry.value) > 0 && entry.key = "command" then true
118        else hascommand(rest)
119    in
120        fold@(bindings);
121        found
122    end
123 
124fun rule(s: &scanner): rule = 
125let
126        val ()       = skipspace(s)
127        val rulename = scanname (s)
128in 
129    skipspace(s);
130    if s.cur = char2int0('\n') then (
131        next(s);
132        let 
133            val bindings = parsebindings(s, nil_vt()) 
134        in
135            if hascommand(bindings) = true then
136                @{name = rulename, bindings = bindings} 
137            else (
138                prerrln!("rule is missing 'command' binding");
139                strptr_free(rulename);
140                bindings_free(bindings);
141                $raise ParseErr )
142        end
143    ) else (
144        strptr_free(rulename);
145        prerrln!("expected newline after rule name at", s.line, ":", s.col);
146        $raise ParseErr())
147end
148
149(* collect the outputs of a build stmt assuming the scanner already 
150 * consumed 'build' 
151 *
152 * The 'collected' list is list0 because it starts empty. the  returned
153 * list is list1 because it must contain atleast one thing. in ATS, list0 
154 * is allowed to be empty, but list1 isnt. *)
155fun outputs (s: &scanner, collected: List0_vt(Strptr1)): List1_vt(Strptr1) =
156let 
157     val () = skipspace(s)
158in 
159    if (s.cur < 0) || (s.cur = char2int0('\n')) then (
160        paths_free(collected);
161        $raise ParseErr 
162    ) else if (s.cur = char2int0(':')) then (
163        if list_vt_length(collected) > 0 then // we need to do this check so that the compiler knows that we
164            list_vt_reverse(collected)        // are satisfying List1_vt (atleast one thing in the list)
165        else (
166            paths_free(collected);
167            prerrln!("expected at least one output");
168            $raise ParseErr() ) )
169    else
170        let
171             val path = scanpath(s)
172             val more = cons_vt(path, collected)
173        in
174             outputs(s, more)
175        end
176end
177
178fun inputs (s: &scanner, collected: List0_vt(Strptr1)): List0_vt(Strptr1) =
179let 
180     val () = skipspace(s)
181in 
182    if (s.cur < 0) || (s.cur = char2int0('\n')) then
183        list_vt_reverse(collected)
184    else if s.cur = char2int0(':') then (
185        paths_free(collected);
186        prerrln!("unexpected ':' at", s.line, ":", s.col);
187        $raise ParseErr
188    ) else 
189        let
190             val path = scanpath(s)
191             val more = cons_vt(path, collected)
192        in
193             inputs(s, more)
194        end
195end
196
197fun build (s: &scanner): edge =
198let
199    (* build out: rule in *)
200    val o   = outputs (s, nil_vt())
201    val ()  = scanchar(s, char2int0(':'))
202    val r   = scanname(s)
203    val i   = inputs  (s, nil_vt()) 
204in
205    if (s.cur = char2int0('\n')) then (
206        next(s);
207        let val b = parsebindings(s, nil_vt())
208        in @{output = o, rule = r, input = i, bindings = b}
209        end
210    ) else (
211	paths_free (o);
212        paths_free (i);
213        strptr_free(r);
214        $raise ParseErr 
215    )
216end
217
218(* does the rule refrenced in a build edge exist?*)
219fun hasrule(rules: !List0_vt(rule), name: !Strptr1): bool =
220    case+ rules of 
221    | nil_vt() => false
222    (*here @ means we open the list without freeing it *)
223    | @cons_vt(entry, rest) => 
224    let 
225        val found = 
226            if compare_strptr_strptr(entry.name, name) = 0 then true
227            else hasrule(rest, name)
228    in
229        (* close the list *)
230        fold@(rules);
231        found
232    end
233
234fun printparts(parts: !List0_vt(stringpart)): void =
235    case+ parts of
236    | nil_vt()             => ()
237    | @cons_vt(part, rest) => (
238        (case+ part of
239         | @Literal(text) => (print!(text); fold@(part))
240         | @Variable(name) => (print!("${", name, "}"); fold@(part)));
241        printparts(rest);
242        fold@(parts)
243    )
244
245fun printbindings(bindings: !List0_vt(binding)): void =
246    case+ bindings of 
247    | nil_vt() => ()
248    | @cons_vt(entry, rest) => (
249    print!("  binding: ", entry.key," = ");
250    printparts(entry.value);
251    println!();
252    printbindings(rest);
253    fold@(bindings) )
254 
255implement printrule(rules) =
256     case+ rules of
257     | nil_vt() => ()
258     | @cons_vt(entry, rest) => (
259     println!("rule: ", entry.name);
260     printbindings(entry.bindings);
261     printrule(rest);
262     fold@(rules) )
263
264implement parse(s, rules, edges, variables) (*manifest*) = 
265let
266    val tok = scankeyword(s)
267in
268    (case+ tok of
269    | ~TOKrule (line,col)       => (let 
270                                        val r    = rule(s);
271                                        val more = cons_vt(r, rules)
272                                    in
273                                        parse(s, more, edges, variables)
274                                    end)
275    | ~TOKbuild(line,col)       => (println!("build at: ", line,":", col);
276                                    (let 
277                                        val b = build(s)
278                                    in
279                                        if hasrule(rules, b.rule) then (
280                                            let 
281                                                val more = cons_vt(b, edges)
282                                            in
283                                                parse(s, rules, more, variables)
284                                            end
285                                        ) else (
286                                            prerrln!("unknown rule ", b.rule, " at ", line,":",col);
287                                            edge_free(cons_vt(b, nil_vt()));
288                                            bindings_free(variables);
289                                            rule_free(rules);
290                                            edge_free(edges);
291                                            $raise ParseErr)
292                                    end))
293    | ~TOKvar  (text, line,col) => (println!("var ", text, " at ", line,":", col);
294                                    let 
295                                        val entry = variable(s, text);
296                                        val more  = cons_vt(entry, variables)
297                                    in
298                                        parse(s, rules, edges, more)
299                                    end)
300    | ~TOKeof(line,col)         => (println!("eof at: ", line,":", col);
301                                   @{
302                                       rules = list_vt_reverse(rules),
303                                       edges = list_vt_reverse(edges),
304                                       variables = list_vt_reverse(variables)
305                                   }))
306end
307