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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 270 - (view) (download)

1 : blume 270 (*
2 :     * Parser for CM description files.
3 :     *
4 :     * (C) 1999 Lucent Technologies, Bell Laboratories
5 :     *
6 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7 :     *)
8 : blume 268 signature CMPARSE = sig
9 :     val parse : AbsPath.t -> CMSemant.group option
10 :     end
11 :    
12 :     structure CMParse :> CMPARSE = struct
13 :    
14 :     val lookAhead = 30
15 :    
16 :     structure S = GenericVC.Source
17 :     structure EM = GenericVC.ErrorMsg
18 :     structure SM = GenericVC.SourceMap
19 :     structure P = GenericVC.Control.Print
20 :    
21 :     structure CMLrVals = CMLrValsFun (structure Token = LrParser.Token)
22 :     structure CMLex = CMLexFun (structure Tokens = CMLrVals.Tokens)
23 :     structure CMParse =
24 :     JoinWithArg (structure ParserData = CMLrVals.ParserData
25 :     structure Lex = CMLex
26 :     structure LrParser = LrParser)
27 :    
28 : blume 270 fun parse group = let
29 :    
30 :     (* recParse returns a group (not an option)
31 :     * and re-raises LrParser.ParseError.
32 :     * This exception will be handled by the surrounding
33 :     * call to parse.
34 :     * This function is used to parse aliases and sub-groups. *)
35 :     fun recParse p =
36 :     case parse p of
37 :     NONE => raise LrParser.ParseError
38 :     | SOME res => res
39 :    
40 :     fun doMember (p, c) =
41 :     CMSemant.member recParse { sourcepath = p,
42 :     group = group,
43 :     class = c }
44 :    
45 :     val currentDir = AbsPath.dir group
46 :     val context = AbsPath.relativeContext (AbsPath.dir group)
47 :     val filename = AbsPath.name group
48 : blume 268 val stream = TextIO.openIn filename
49 :     val errcons =
50 :     { linewidth = !P.linewidth, flush = P.flush, consumer = P.say }
51 :     val source = S.newSource (filename, 1, stream, false, errcons)
52 :     val sourceMap = #sourceMap source
53 :     fun error region m =
54 :     EM.error source region EM.COMPLAIN m EM.nullErrorBody
55 :    
56 :     val lexarg = let
57 :     (* local state *)
58 :     val depth = ref 0
59 :     val curstring = ref []
60 :     val startpos = ref 0
61 :     val instring = ref NONE
62 :     (* handling comments *)
63 :     fun enterC () = depth := !depth + 1
64 :     fun leaveC () = let val d = !depth - 1 in depth := d; d = 0 end
65 :     (* handling strings *)
66 :     fun newS (pos, kind) =
67 :     (instring := SOME kind;
68 :     curstring := [];
69 :     startpos := pos)
70 :     fun addS c = curstring := c :: !curstring
71 :     fun addSC (s, offs) = addS (chr (ord (String.sub (s, 2)) - offs))
72 :     fun addSN (s, pos) = let
73 :     val ns = substring (s, 1, 3)
74 :     val n = Int.fromString ns
75 :     in
76 :     addS (chr (valOf n))
77 :     handle _ =>
78 :     error (pos, pos + size s)
79 :     ("illegal decimal char spec: " ^ ns)
80 :     end
81 :     fun getS (pos, tok) =
82 :     (instring := NONE;
83 :     tok (implode (rev (!curstring)), !startpos, pos))
84 :     (* handling EOF *)
85 :     fun handleEof () = let
86 :     val pos = SM.lastChange sourceMap
87 :     in
88 :     if !depth > 0 then
89 :     error (pos, pos) "unexpected end of input in comment"
90 :     else if isSome (!instring) then
91 :     error (pos, pos)
92 :     ("unexpected end of input in " ^ valOf (!instring))
93 :     else ();
94 :     pos
95 :     end
96 :     (* handling line breaks *)
97 :     fun newline pos = SM.newline sourceMap pos
98 :     in
99 :     { enterC = enterC,
100 :     leaveC = leaveC,
101 :     newS = newS,
102 :     addS = addS,
103 :     addSC = addSC,
104 :     addSN = addSN,
105 :     getS = getS,
106 :     handleEof = handleEof,
107 :     newline = newline,
108 :     error = error }
109 :     end
110 :    
111 :     fun inputc k =
112 :     TextIO.input stream
113 :    
114 :     val lexer = CMLex.makeLexer inputc lexarg
115 :     val tokenStream = LrParser.Stream.streamify lexer
116 :     val (parseResult, _) =
117 :     CMParse.parse (lookAhead, tokenStream,
118 :     fn (s,p1,p2) => error (p1, p2) s,
119 : blume 270 (context, error, recParse, doMember))
120 : blume 268 in
121 :     TextIO.closeIn stream;
122 :     SOME parseResult
123 :     end handle LrParser.ParseError => NONE
124 :     end

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