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 270, Tue May 11 07:45:42 1999 UTC revision 277, Mon May 17 09:13:26 1999 UTC
# Line 25  Line 25 
25                       structure Lex = CMLex                       structure Lex = CMLex
26                       structure LrParser = LrParser)                       structure LrParser = LrParser)
27    
28      fun parse group = let      fun parse' (group, groupstack) = let
29    
30            val currentDir = AbsPath.dir group
31            val context = AbsPath.relativeContext (AbsPath.dir group)
32            val filename = AbsPath.name group
33            val _ = Say.vsay (concat ["[scanning ", filename, "]\n"])
34            val stream = TextIO.openIn filename
35            val errcons =
36                { linewidth = !P.linewidth, flush = P.flush, consumer = P.say }
37            val source = S.newSource (filename, 1, stream, false, errcons)
38            val sourceMap = #sourceMap source
39            fun error' region m b = EM.error source region EM.COMPLAIN m b
40            fun error region m = error' region m EM.nullErrorBody
41    
42          (* recParse returns a group (not an option)          (* recParse returns a group (not an option)
43           * and re-raises LrParser.ParseError.           * and re-raises LrParser.ParseError.
44           * This exception will be handled by the surrounding           * This exception will be handled by the surrounding
45           * call to parse.           * call to parse.
46           * This function is used to parse aliases and sub-groups. *)           * This function is used to parse aliases and sub-groups. *)
47          fun recParse p =          fun recParse (p1, p2) p =
48              case parse p of              case parse' (p, (group, (source, p1, p2)) :: groupstack) of
49                  NONE => raise LrParser.ParseError                  NONE => (#anyErrors source := true; CMSemant.emptyGroup)
50                | SOME res => res                | SOME res => res
51    
52          fun doMember (p, c) =          fun doMember (p, p1, p2, c, e) =
53              CMSemant.member recParse { sourcepath = p,              CMSemant.member (recParse (p1, p2))
54                                { sourcepath = p,
55                                         group = group,                                         group = group,
56                                         class = c }                                class = c,
57                                  error = e }
58    
59          val currentDir = AbsPath.dir group          (* checking for cycles among groups and printing them nicely *)
60          val context = AbsPath.relativeContext (AbsPath.dir group)          val _ = let
61          val filename = AbsPath.name group              fun findCycle ([], _) = []
62          val stream = TextIO.openIn filename                | findCycle ((h as (g, (s, p1, p2))) :: t, cyc) =
63          val errcons =                  if AbsPath.compare (g, group) = EQUAL then rev (h :: cyc)
64              { linewidth = !P.linewidth, flush = P.flush, consumer = P.say }                  else findCycle (t, h :: cyc)
65          val source = S.newSource (filename, 1, stream, false, errcons)              fun report ((g, (s, p1, p2)), hist) = let
66          val sourceMap = #sourceMap source                  fun pphist pps = let
67          fun error region m =                      fun loop (_, []) = ()
68              EM.error source region EM.COMPLAIN m EM.nullErrorBody                        | loop (g0, (g, (s, p1, p2)) :: t) = let
69                                val s = EM.matchErrorString s (p1, p2)
70                            in
71                                PrettyPrint.add_string pps s;
72                                PrettyPrint.add_string pps ": ";
73                                PrettyPrint.add_string pps (AbsPath.spec g0);
74                                PrettyPrint.add_newline pps;
75                                loop (g, t)
76                            end
77                    in
78                        PrettyPrint.add_newline pps;
79                        loop (g, hist)
80                    end
81                in
82                    EM.error s (p1, p2) EM.COMPLAIN
83                       ("group hierarchy forms a cycle with " ^ AbsPath.spec group)
84                       pphist;
85                    raise LrParser.ParseError
86                end
87            in
88                case findCycle (groupstack, []) of
89                    [] => ()
90                  | h :: t => report (h, t)
91            end
92    
93          val lexarg = let          val lexarg = let
94              (* local state *)              (* local state *)
# Line 116  Line 153 
153          val (parseResult, _) =          val (parseResult, _) =
154              CMParse.parse (lookAhead, tokenStream,              CMParse.parse (lookAhead, tokenStream,
155                             fn (s,p1,p2) => error (p1, p2) s,                             fn (s,p1,p2) => error (p1, p2) s,
156                             (context, error, recParse, doMember))                             (context, error', error, recParse, doMember))
157      in      in
158          TextIO.closeIn stream;          TextIO.closeIn stream;
159          SOME parseResult          if !(#anyErrors source) then NONE
160      end handle LrParser.ParseError => NONE          else SOME parseResult
161        end
162        handle LrParser.ParseError => NONE
163             | Cycle => NONE
164    
165        fun parse group = parse' (group, [])
166  end  end

Legend:
Removed from v.270  
changed lines
  Added in v.277

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