6 |
* Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp) |
* Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp) |
7 |
*) |
*) |
8 |
signature CMPARSE = sig |
signature CMPARSE = sig |
9 |
val parse : AbsPath.t -> CMSemant.group option |
val parse : Primitive.configuration -> AbsPath.t -> CMSemant.group option |
10 |
end |
end |
11 |
|
|
12 |
structure CMParse :> CMPARSE = struct |
structure CMParse :> CMPARSE = struct |
31 |
* function will get cached in SmlInfo.info but the source will change |
* function will get cached in SmlInfo.info but the source will change |
32 |
* when one re-runs the analysis. *) |
* when one re-runs the analysis. *) |
33 |
|
|
34 |
|
fun parse primconf group = let |
35 |
|
|
36 |
|
val groupreg = GroupReg.new () |
37 |
|
val fnpolicy = FilenamePolicy.default |
38 |
|
val params = { groupreg = groupreg, |
39 |
|
fnpolicy = fnpolicy, |
40 |
|
primconf = primconf } |
41 |
|
|
42 |
fun parse' (group, groupstack) = let |
fun parse' (group, groupstack) = let |
43 |
|
|
44 |
val currentDir = AbsPath.dir group |
val currentDir = AbsPath.dir group |
50 |
{ linewidth = !P.linewidth, flush = P.flush, consumer = P.say } |
{ linewidth = !P.linewidth, flush = P.flush, consumer = P.say } |
51 |
val source = S.newSource (filename, 1, stream, false, errcons) |
val source = S.newSource (filename, 1, stream, false, errcons) |
52 |
val sourceMap = #sourceMap source |
val sourceMap = #sourceMap source |
53 |
val _ = GroupReg.register (group, source) |
val _ = GroupReg.register groupreg (group, source) |
54 |
fun error' region m b = let |
fun error' region m b = let |
55 |
val src = GroupReg.lookup group |
val src = GroupReg.lookup groupreg group |
56 |
in |
in |
57 |
EM.error src region EM.COMPLAIN m b |
EM.error src region EM.COMPLAIN m b |
58 |
end |
end |
65 |
* This function is used to parse aliases and sub-groups. *) |
* This function is used to parse aliases and sub-groups. *) |
66 |
fun recParse (p1, p2) p = |
fun recParse (p1, p2) p = |
67 |
(case parse' (p, (group, (source, p1, p2)) :: groupstack) of |
(case parse' (p, (group, (source, p1, p2)) :: groupstack) of |
68 |
NONE => (#anyErrors source := true; CMSemant.emptyGroup group) |
NONE => (#anyErrors source := true; |
69 |
|
CMSemant.emptyGroup group) |
70 |
| SOME res => res) |
| SOME res => res) |
71 |
handle exn as IO.Io _ => (error (p1, p2) (General.exnMessage exn); |
handle exn as IO.Io _ => |
72 |
|
(error (p1, p2) (General.exnMessage exn); |
73 |
CMSemant.emptyGroup group) |
CMSemant.emptyGroup group) |
74 |
|
|
75 |
fun doMember (p, p1, p2, c, e) = |
fun doMember (p, p1, p2, c, e) = |
76 |
CMSemant.member (recParse (p1, p2)) |
CMSemant.member (params, recParse (p1, p2)) |
77 |
{ sourcepath = p, |
{ sourcepath = p, |
78 |
group = group, |
group = group, |
79 |
class = c, |
class = c, |
103 |
end |
end |
104 |
in |
in |
105 |
EM.error s (p1, p2) EM.COMPLAIN |
EM.error s (p1, p2) EM.COMPLAIN |
106 |
("group hierarchy forms a cycle with " ^ AbsPath.spec group) |
("group hierarchy forms a cycle with " ^ |
107 |
|
AbsPath.spec group) |
108 |
pphist; |
pphist; |
109 |
raise LrParser.ParseError |
raise LrParser.ParseError |
110 |
end |
end |
129 |
curstring := []; |
curstring := []; |
130 |
startpos := pos) |
startpos := pos) |
131 |
fun addS c = curstring := c :: !curstring |
fun addS c = curstring := c :: !curstring |
132 |
fun addSC (s, offs) = addS (chr (ord (String.sub (s, 2)) - offs)) |
fun addSC (s, offs) = |
133 |
|
addS (chr (ord (String.sub (s, 2)) - offs)) |
134 |
fun addSN (s, pos) = let |
fun addSN (s, pos) = let |
135 |
val ns = substring (s, 1, 3) |
val ns = substring (s, 1, 3) |
136 |
val n = Int.fromString ns |
val n = Int.fromString ns |
170 |
error = error } |
error = error } |
171 |
end |
end |
172 |
|
|
173 |
fun inputc k = |
fun inputc k = TextIO.input stream |
|
TextIO.input stream |
|
174 |
|
|
175 |
val lexer = CMLex.makeLexer inputc lexarg |
val lexer = CMLex.makeLexer inputc lexarg |
176 |
val tokenStream = LrParser.Stream.streamify lexer |
val tokenStream = LrParser.Stream.streamify lexer |
177 |
val (parseResult, _) = |
val (parseResult, _) = |
178 |
CMParse.parse (lookAhead, tokenStream, |
CMParse.parse (lookAhead, tokenStream, |
179 |
fn (s,p1,p2) => error (p1, p2) s, |
fn (s,p1,p2) => error (p1, p2) s, |
180 |
(group, context, error', error, recParse, doMember)) |
(group, context, error', error, recParse, |
181 |
|
doMember)) |
182 |
in |
in |
183 |
TextIO.closeIn stream; |
TextIO.closeIn stream; |
184 |
if !(#anyErrors source) then NONE |
if !(#anyErrors source) then NONE |
185 |
else SOME parseResult |
else SOME parseResult |
186 |
end |
end |
187 |
handle LrParser.ParseError => NONE |
handle LrParser.ParseError => NONE |
188 |
|
in |
189 |
fun parse group = (GroupReg.clear (); parse' (group, [])) |
parse' (group, []) |
190 |
|
end |
191 |
end |
end |