1 (* Copyright (C) 2017 Matthew Fluet.
2 * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
3 * Jagannathan, and Stephen Weeks.
4 * Copyright (C) 1997-2000 NEC Research Institute.
6 * MLton is released under a BSD-style license.
7 * See the file MLton-LICENSE for details.
10 functor AstPrograms (S: AST_PROGRAMS_STRUCTS): AST_PROGRAMS =
15 structure AstModules = AstModules (S)
17 open AstModules Layout
21 datatype t = T of Topdec.t list list
26 Layout.align (List.map (dss, fn ds =>
28 (Layout.align (List.map (ds, Topdec.layout)))))
30 fun checkSyntax (T dss) =
31 List.foreach (dss, fn ds => List.foreach (ds, Topdec.checkSyntax))
33 fun coalesce (T dss): t =
35 fun finish (sds, ac) =
42 (Topdec.Strdec (Strdec.makeRegion
43 (Strdec.Seq (rev sds), Region.bogus)),
48 fun loop (ds, sds, ac) =
50 [] => finish (sds, ac)
53 Topdec.Strdec d => loop (ds, d :: sds, ac)
54 | _ => loop (ds, [], d :: finish (sds, ac))
56 T (List.map (dss, fn ds => rev (loop (ds, [], []))))
60 Trace.trace ("AstPrograms.Program.coalesce", layout, layout) coalesce
62 fun size (T dss): int =
65 fun inc () = n := 1 + !n
66 fun dec (d: Dec.t): unit =
68 datatype z = datatype Dec.node
71 Abstype {body, ...} => dec body
72 | Exception cs => Vector.foreach (cs, fn _ => inc ())
74 Vector.foreach (fbs, fn clauses =>
75 Vector.foreach (clauses, exp o #body))
76 | Local (d, d') => (dec d; dec d')
77 | SeqDec ds => Vector.foreach (ds, dec)
78 | Val {vbs, rvbs, ...} =>
79 (Vector.foreach (vbs, exp o #exp)
80 ; Vector.foreach (rvbs, match o #match))
83 and exp (e: Exp.t): unit =
86 datatype z = datatype Exp.node
89 Andalso (e1, e2) => (exp e1; exp e2)
90 | App (e, e') => (exp e; exp e')
91 | Case (e, m) => (exp e; match m)
92 | Constraint (e, _) => exp e
93 | FlatApp es => exps es
95 | Handle (e, m) => (exp e; match m)
96 | If (e1, e2, e3) => (exp e1; exp e2; exp e3)
97 | Let (d, e) => (dec d; exp e)
98 | List es => Vector.foreach (es, exp)
99 | Orelse (e1, e2) => (exp e1; exp e2)
100 | Raise exn => exp exn
101 | Record r => Record.foreach (r, exp o #2)
103 | While {test, expr} => (exp test; exp expr)
106 and exps es = Vector.foreach (es, exp)
109 val Match.T rules = Match.node m
111 Vector.foreach (rules, exp o #2)
115 datatype z = datatype Strdec.node
117 case Strdec.node d of
119 | Local (d, d') => (strdec d; strdec d')
120 | Seq ds => List.foreach (ds, strdec)
123 Vector.foreach (ds, fn {def, ...} => strexp def)
127 datatype z = datatype Strexp.node
129 case Strexp.node e of
131 | Constrained (e, _) => strexp e
132 | App (_, e) => strexp e
133 | Let (d, e) => (strdec d; strexp e)
139 datatype z = datatype Topdec.node
141 case Topdec.node d of
143 Vector.foreach (ds, fn {body, ...} => strexp body)
144 | Strdec d => strdec d
147 val _ = List.foreach (dss, fn ds => List.foreach (ds, topdec))
151 (* quell unused warning *)