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 268 - (view) (download)

1 : blume 268 signature CMPARSE = sig
2 :     val parse : AbsPath.t -> CMSemant.group option
3 :     end
4 :    
5 :     structure CMParse :> CMPARSE = struct
6 :    
7 :     val lookAhead = 30
8 :    
9 :     structure S = GenericVC.Source
10 :     structure EM = GenericVC.ErrorMsg
11 :     structure SM = GenericVC.SourceMap
12 :     structure P = GenericVC.Control.Print
13 :    
14 :     structure CMLrVals = CMLrValsFun (structure Token = LrParser.Token)
15 :     structure CMLex = CMLexFun (structure Tokens = CMLrVals.Tokens)
16 :     structure CMParse =
17 :     JoinWithArg (structure ParserData = CMLrVals.ParserData
18 :     structure Lex = CMLex
19 :     structure LrParser = LrParser)
20 :    
21 :     fun parse filename = let
22 :     val currentDir = AbsPath.dir filename
23 :     val filename = AbsPath.name filename
24 :     val stream = TextIO.openIn filename
25 :     val errcons =
26 :     { linewidth = !P.linewidth, flush = P.flush, consumer = P.say }
27 :     val source = S.newSource (filename, 1, stream, false, errcons)
28 :     val sourceMap = #sourceMap source
29 :     fun error region m =
30 :     EM.error source region EM.COMPLAIN m EM.nullErrorBody
31 :    
32 :     val lexarg = let
33 :     (* local state *)
34 :     val depth = ref 0
35 :     val curstring = ref []
36 :     val startpos = ref 0
37 :     val instring = ref NONE
38 :     (* handling comments *)
39 :     fun enterC () = depth := !depth + 1
40 :     fun leaveC () = let val d = !depth - 1 in depth := d; d = 0 end
41 :     (* handling strings *)
42 :     fun newS (pos, kind) =
43 :     (instring := SOME kind;
44 :     curstring := [];
45 :     startpos := pos)
46 :     fun addS c = curstring := c :: !curstring
47 :     fun addSC (s, offs) = addS (chr (ord (String.sub (s, 2)) - offs))
48 :     fun addSN (s, pos) = let
49 :     val ns = substring (s, 1, 3)
50 :     val n = Int.fromString ns
51 :     in
52 :     addS (chr (valOf n))
53 :     handle _ =>
54 :     error (pos, pos + size s)
55 :     ("illegal decimal char spec: " ^ ns)
56 :     end
57 :     fun getS (pos, tok) =
58 :     (instring := NONE;
59 :     tok (implode (rev (!curstring)), !startpos, pos))
60 :     (* handling EOF *)
61 :     fun handleEof () = let
62 :     val pos = SM.lastChange sourceMap
63 :     in
64 :     if !depth > 0 then
65 :     error (pos, pos) "unexpected end of input in comment"
66 :     else if isSome (!instring) then
67 :     error (pos, pos)
68 :     ("unexpected end of input in " ^ valOf (!instring))
69 :     else ();
70 :     pos
71 :     end
72 :     (* handling line breaks *)
73 :     fun newline pos = SM.newline sourceMap pos
74 :     in
75 :     { enterC = enterC,
76 :     leaveC = leaveC,
77 :     newS = newS,
78 :     addS = addS,
79 :     addSC = addSC,
80 :     addSN = addSN,
81 :     getS = getS,
82 :     handleEof = handleEof,
83 :     newline = newline,
84 :     error = error }
85 :     end
86 :    
87 :     fun inputc k =
88 :     TextIO.input stream
89 :    
90 :     val lexer = CMLex.makeLexer inputc lexarg
91 :     val tokenStream = LrParser.Stream.streamify lexer
92 :     val (parseResult, _) =
93 :     CMParse.parse (lookAhead, tokenStream,
94 :     fn (s,p1,p2) => error (p1, p2) s,
95 :     (currentDir, error))
96 :     in
97 :     TextIO.closeIn stream;
98 :     SOME parseResult
99 :     end handle LrParser.ParseError => NONE
100 :     end

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