Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/cm/parse/parse.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/parse/parse.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 275, Sat May 15 09:54:52 1999 UTC revision 283, Wed May 19 08:20:58 1999 UTC
# Line 25  Line 25 
25                       structure Lex = CMLex                       structure Lex = CMLex
26                       structure LrParser = LrParser)                       structure LrParser = LrParser)
27    
28        (* The error function must look for the source using the GroupReg
29         * group register because the source must not be hard-wired into it
30         * (via closure creation).  The reason for this is that the error
31         * function will get cached in SmlInfo.info but the source will change
32         * when one re-runs the analysis. *)
33    
34      fun parse' (group, groupstack) = let      fun parse' (group, groupstack) = let
35    
36          val currentDir = AbsPath.dir group          val currentDir = AbsPath.dir group
# Line 36  Line 42 
42              { linewidth = !P.linewidth, flush = P.flush, consumer = P.say }              { linewidth = !P.linewidth, flush = P.flush, consumer = P.say }
43          val source = S.newSource (filename, 1, stream, false, errcons)          val source = S.newSource (filename, 1, stream, false, errcons)
44          val sourceMap = #sourceMap source          val sourceMap = #sourceMap source
45          fun error region m =          val _ = GroupReg.register (group, source)
46              EM.error source region EM.COMPLAIN m EM.nullErrorBody          fun error' region m b = let
47                val src = GroupReg.lookup group
48            in
49                EM.error src region EM.COMPLAIN m b
50            end
51            fun error region m = error' region m EM.nullErrorBody
52    
53          (* recParse returns a group (not an option)          (* recParse returns a group (not an option)
54           * and re-raises LrParser.ParseError.           * and re-raises LrParser.ParseError.
# Line 45  Line 56 
56           * call to parse.           * call to parse.
57           * This function is used to parse aliases and sub-groups. *)           * This function is used to parse aliases and sub-groups. *)
58          fun recParse (p1, p2) p =          fun recParse (p1, p2) p =
59              case parse' (p, (group, (source, p1, p2)) :: groupstack) of              (case parse' (p, (group, (source, p1, p2)) :: groupstack) of
60                  NONE => (#anyErrors source := true; CMSemant.emptyGroup)                   NONE => (#anyErrors source := true; CMSemant.emptyGroup group)
61                | SOME res => res                 | SOME res => res)
62                handle exn as IO.Io _ => (error (p1, p2) (General.exnMessage exn);
63                                          CMSemant.emptyGroup group)
64    
65          fun doMember (p, p1, p2, c, e) =          fun doMember (p, p1, p2, c, e) =
66              CMSemant.member (recParse (p1, p2)) { sourcepath = p,              CMSemant.member (recParse (p1, p2))
67                                { sourcepath = p,
68                                                    group = group,                                                    group = group,
69                                                    class = c,                                                    class = c,
70                                                    error = e }                                                    error = e }
# Line 68  Line 82 
82                              val s = EM.matchErrorString s (p1, p2)                              val s = EM.matchErrorString s (p1, p2)
83                          in                          in
84                              PrettyPrint.add_string pps s;                              PrettyPrint.add_string pps s;
85                              PrettyPrint.add_string pps ": ";                              PrettyPrint.add_string pps ": importing ";
86                              PrettyPrint.add_string pps (AbsPath.spec g0);                              PrettyPrint.add_string pps (AbsPath.spec g0);
87                              PrettyPrint.add_newline pps;                              PrettyPrint.add_newline pps;
88                              loop (g, t)                              loop (g, t)
# Line 152  Line 166 
166          val (parseResult, _) =          val (parseResult, _) =
167              CMParse.parse (lookAhead, tokenStream,              CMParse.parse (lookAhead, tokenStream,
168                             fn (s,p1,p2) => error (p1, p2) s,                             fn (s,p1,p2) => error (p1, p2) s,
169                             (context, error, recParse, doMember))                             (group, context, error', error, recParse, doMember))
170      in      in
171          TextIO.closeIn stream;          TextIO.closeIn stream;
172          if !(#anyErrors source) then NONE          if !(#anyErrors source) then NONE
173          else SOME parseResult          else SOME parseResult
174      end      end
175      handle LrParser.ParseError => NONE      handle LrParser.ParseError => NONE
          | Cycle => NONE  
176    
177      fun parse group = parse' (group, [])      fun parse group = (GroupReg.clear (); parse' (group, []))
178  end  end

Legend:
Removed from v.275  
changed lines
  Added in v.283

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0