1 (* Copyright (C) 2017-2018 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 AstMLBs (S: AST_MLBS_STRUCTS): AST_MLBS =
15 structure AstPrograms = AstPrograms (S)
17 open AstPrograms Layout
19 fun mkCtxt (x, lay) () =
20 seq [str "in: ", lay x]
22 val layouts = List.map
23 structure Wrap = Region.Wrap
26 (*---------------------------------------------------*)
27 (* Basdecs and Basexps *)
28 (*---------------------------------------------------*)
32 | Let of basdec * basexp
35 Ann of string * Region.t * basdec
36 | Basis of {name: Basid.t, def: basexp} vector
38 | Local of basdec * basdec
39 | MLB of {fileAbs: File.t, fileUse: File.t} * basdec Promise.t
40 | Open of Basid.t vector
42 | Prog of {fileAbs: File.t, fileUse: File.t} * Program.t Promise.t
44 withtype basexp = basexpNode Wrap.t
45 and basdec = basdecNode Wrap.t
47 fun layoutBasexp exp =
49 Bas dec => align [str "bas", indent (layoutBasdec dec, 3), str "end"]
50 | Let (dec, exp) => Pretty.lett (layoutBasdec dec, layoutBasexp exp)
51 | Var basid => Basid.layout basid
52 and layoutBasdec dec =
56 indent (seq [str String.dquote, str anns, str String.dquote], 3),
58 indent (layoutBasdec dec, 3),
62 ("basis", "=", basbnds, fn {name, def} =>
63 (case node def of Var _ => OneLine | _ => Split 3,
64 Basid.layout name, layoutBasexp def))
65 | Defs def => ModIdBind.layout def
66 | Local (dec1, dec2) => Pretty.locall (layoutBasdec dec1, layoutBasdec dec2)
67 | MLB ({fileUse, ...}, _) => File.layout fileUse
68 | Open bs => seq [str "open ",
69 seq (separate (Vector.toListMap (bs, Basid.layout),
72 | Prog ({fileUse, ...}, _) => File.layout fileUse
73 | Seq decs => align (layoutBasdecs decs)
74 and layoutBasdecs decs = layouts (decs, layoutBasdec)
76 fun checkSyntaxBasexp (e: basexp): unit =
78 Bas dec => checkSyntaxBasdec dec
79 | Let (dec, exp) => (checkSyntaxBasdec dec
80 ; checkSyntaxBasexp exp)
82 and checkSyntaxBasdec (d: basdec): unit =
84 Ann (_, _, dec) => checkSyntaxBasdec dec
87 (basbnds, {ctxt = mkCtxt (d, layoutBasdec),
88 equals = (fn ({name = id, ...}, {name = id', ...}) =>
89 Basid.equals (id, id')),
90 layout = Basid.layout o #name,
91 name = "basis definition",
92 region = Basid.region o #name})
93 | Defs def => ModIdBind.checkSyntax def
94 | Local (dec1, dec2) =>
95 (checkSyntaxBasdec dec1
96 ; checkSyntaxBasdec dec2)
101 | Seq decs => List.foreach (decs, checkSyntaxBasdec)
103 fun sourceFiles (d: basdec): File.t vector =
105 val sourceFiles : File.t Buffer.t =
106 Buffer.new {dummy = "<dummy>"}
107 val psi : File.t -> bool ref =
108 String.memoize (fn _ => ref false)
110 fun sourceFilesBasexp (e: basexp): unit =
112 Bas dec => sourceFilesBasdec dec
113 | Let (dec, exp) => (sourceFilesBasdec dec
114 ; sourceFilesBasexp exp)
116 and sourceFilesBasdec (d: basdec): unit =
118 Ann (_, _, dec) => sourceFilesBasdec dec
121 (basbnds, fn {def, ...} =>
122 sourceFilesBasexp def)
124 | Local (dec1, dec2) => (sourceFilesBasdec dec1
125 ; sourceFilesBasdec dec2)
126 | MLB ({fileAbs, fileUse, ...}, dec) =>
135 Buffer.add (sourceFiles, fileUse)
136 ; sourceFilesBasdec (Promise.force dec)
141 | Prog ({fileUse, ...}, _) => Buffer.add (sourceFiles, fileUse)
142 | Seq decs => List.foreach (decs, sourceFilesBasdec)
143 val () = sourceFilesBasdec d
145 Buffer.toVector sourceFiles
149 ("AstMLBs.sourceFiles", Layout.ignore, Vector.layout File.layout)
158 datatype node = datatype basexpNode
162 val layout = layoutBasexp
169 datatype node = datatype basdecNode
173 fun make n = makeRegion (n, Region.bogus)
176 val checkSyntax = checkSyntaxBasdec
177 val layout = layoutBasdec
178 val sourceFiles = sourceFiles