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 293, Tue May 25 03:04:50 1999 UTC revision 294, Tue May 25 09:06:06 1999 UTC
# Line 39  Line 39 
39                         fnpolicy = fnpolicy,                         fnpolicy = fnpolicy,
40                         primconf = primconf }                         primconf = primconf }
41    
42          fun parse' (group, groupstack) = let          val gc = ref AbsPathMap.empty   (* the "group cache" *)
43    
44              val currentDir = AbsPath.dir group          fun mparse (group, groupstack) =
45              val context = AbsPath.relativeContext (AbsPath.dir group)              case AbsPathMap.find (!gc, group) of
46              val filename = AbsPath.name group                  SOME g => g
47              val _ = Say.vsay (concat ["[scanning ", filename, "]\n"])                | NONE => let
48              val stream = TextIO.openIn filename                      val g = parse' (group, groupstack)
             val errcons =  
                 { linewidth = !P.linewidth, flush = P.flush, consumer = P.say }  
             val source = S.newSource (filename, 1, stream, false, errcons)  
             val sourceMap = #sourceMap source  
             val _ = GroupReg.register groupreg (group, source)  
             fun error' region m b = let  
                 val src = GroupReg.lookup groupreg group  
49              in              in
50                  EM.error src region EM.COMPLAIN m b                      gc := AbsPathMap.insert (!gc, group, g);
51                        g
52              end              end
             fun error region m = error' region m EM.nullErrorBody  
   
             (* recParse returns a group (not an option)  
              * and re-raises LrParser.ParseError.  
              * This exception will be handled by the surrounding  
              * call to parse.  
              * This function is used to parse aliases and sub-groups. *)  
             fun recParse (p1, p2) p =  
                 (case parse' (p, (group, (source, p1, p2)) :: groupstack) of  
                      NONE => (#anyErrors source := true;  
                               CMSemant.emptyGroup group)  
                    | SOME res => res)  
                      handle exn as IO.Io _ =>  
                          (error (p1, p2) (General.exnMessage exn);  
                           CMSemant.emptyGroup group)  
   
             fun doMember (p, p1, p2, c, e) =  
                 CMSemant.member (params, recParse (p1, p2))  
                                 { sourcepath = p,  
                                   group = group,  
                                   class = c,  
                                   error = e }  
53    
54            and parse' (group, groupstack) = let
55              (* checking for cycles among groups and printing them nicely *)              (* checking for cycles among groups and printing them nicely *)
             val _ = let  
56                  fun findCycle ([], _) = []                  fun findCycle ([], _) = []
57                    | findCycle ((h as (g, (s, p1, p2))) :: t, cyc) =                    | findCycle ((h as (g, (s, p1, p2))) :: t, cyc) =
58                      if AbsPath.compare (g, group) = EQUAL then rev (h :: cyc)                      if AbsPath.compare (g, group) = EQUAL then rev (h :: cyc)
# Line 105  Line 77 
77                      EM.error s (p1, p2) EM.COMPLAIN                      EM.error s (p1, p2) EM.COMPLAIN
78                               ("group hierarchy forms a cycle with " ^                               ("group hierarchy forms a cycle with " ^
79                                AbsPath.spec group)                                AbsPath.spec group)
80                           pphist;                             pphist
                     raise LrParser.ParseError  
81                  end                  end
82    
83                (* normal processing -- used when there is no cycle to report *)
84                fun normal_processing () = let
85                    val currentDir = AbsPath.dir group
86                    val context = AbsPath.relativeContext (AbsPath.dir group)
87                    val filename = AbsPath.name group
88                    val _ = Say.vsay (concat ["[scanning ", filename, "]\n"])
89                    val stream = TextIO.openIn filename
90                    val errcons = { linewidth = !P.linewidth,
91                                    flush = P.flush,
92                                    consumer = P.say }
93                    val source = S.newSource (filename, 1, stream, false, errcons)
94                    val sourceMap = #sourceMap source
95                    val _ = GroupReg.register groupreg (group, source)
96                    fun error' region sev m b = let
97                        val src = GroupReg.lookup groupreg group
98              in              in
99                  case findCycle (groupstack, []) of                      EM.error src region sev m b
                     [] => ()  
                   | h :: t => report (h, t)  
100              end              end
101                    fun error region m =
102                        error' region EM.COMPLAIN m EM.nullErrorBody
103    
104                    (* recParse returns a group (not an option).
105                     * This function is used to parse aliases and sub-groups.
106                     * Errors are propagated by explicitly setting the
107                     * "anyErrors" flag of the parent group. *)
108                    fun recParse (p1, p2) p = let
109                        val groupstack' = (group, (source, p1, p2)) :: groupstack
110                    in
111                        case mparse (p, groupstack') of
112                            NONE => (#anyErrors source := true;
113                                     CMSemant.emptyGroup group)
114                          | SOME res => res
115                    end
116                    handle exn as IO.Io _ =>
117                        (error (p1, p2) (General.exnMessage exn);
118                         CMSemant.emptyGroup group)
119    
120                    fun doMember (p, p1, p2, c, e) =
121                        CMSemant.member (params, recParse (p1, p2))
122                                        { sourcepath = p, group = group,
123                                          class = c, error = e }
124    
125              val lexarg = let              val lexarg = let
126                  (* local state *)                  (* local state *)
127                  val depth = ref 0                  val depth = ref 0
128                  val curstring = ref []                  val curstring = ref []
129                  val startpos = ref 0                  val startpos = ref 0
130                  val instring = ref NONE                      val instring = ref false
131                  (* handling comments *)                  (* handling comments *)
132                  fun enterC () = depth := !depth + 1                  fun enterC () = depth := !depth + 1
133                  fun leaveC () = let val d = !depth - 1 in depth := d; d = 0 end                      fun leaveC () = let
134                            val d = !depth - 1
135                        in
136                            depth := d;
137                            d = 0
138                        end
139                  (* handling strings *)                  (* handling strings *)
140                  fun newS (pos, kind) =                      fun newS pos =
141                      (instring := SOME kind;                          (instring := true; curstring := []; startpos := pos)
                      curstring := [];  
                      startpos := pos)  
142                  fun addS c = curstring := c :: !curstring                  fun addS c = curstring := c :: !curstring
143                  fun addSC (s, offs) =                  fun addSC (s, offs) =
144                      addS (chr (ord (String.sub (s, 2)) - offs))                      addS (chr (ord (String.sub (s, 2)) - offs))
# Line 141  Line 152 
152                                ("illegal decimal char spec: " ^ ns)                                ("illegal decimal char spec: " ^ ns)
153                  end                  end
154                  fun getS (pos, tok) =                  fun getS (pos, tok) =
155                      (instring := NONE;                          (instring := false;
156                       tok (implode (rev (!curstring)), !startpos, pos))                       tok (implode (rev (!curstring)), !startpos, pos))
157                  (* handling EOF *)                  (* handling EOF *)
158                  fun handleEof () = let                  fun handleEof () = let
159                      val pos = SM.lastChange sourceMap                      val pos = SM.lastChange sourceMap
160                  in                  in
161                      if !depth > 0 then                      if !depth > 0 then
                         error (pos, pos) "unexpected end of input in comment"  
                     else if isSome (!instring) then  
162                          error (pos, pos)                          error (pos, pos)
163                              ("unexpected end of input in " ^ valOf (!instring))                                    "unexpected end of input in comment"
164                            else if !instring then
165                                error (pos, pos)
166                                      "unexpected end of input in string"
167                      else ();                      else ();
168                      pos                      pos
169                  end                  end
# Line 186  Line 198 
198          end          end
199          handle LrParser.ParseError => NONE          handle LrParser.ParseError => NONE
200      in      in
201          parse' (group, [])              case findCycle (groupstack, []) of
202                    h :: t => (report (h, t); NONE)
203                  | [] => normal_processing ()
204            end
205    
206        in
207            mparse (group, [])
208      end      end
209  end  end

Legend:
Removed from v.293  
changed lines
  Added in v.294

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