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/ml-yacc/lib/parser1.sml
ViewVC logotype

Annotation of /sml/trunk/src/ml-yacc/lib/parser1.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 224 - (view) (download)

1 : monnier 2 (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi
2 :     *
3 :     * $Log$
4 : monnier 223 * Revision 1.1.1.7 1999/04/17 16:22:27 monnier
5 :     * version 110.11
6 : monnier 2 *
7 : monnier 223 * Revision 1.1.1.1 1998/04/08 18:40:16 george
8 :     * Version 110.5
9 :     *
10 : monnier 8 * Revision 1.2 1997/09/10 18:34:22 jhr
11 :     * Changed "abstraction" to ":>".
12 :     *
13 : monnier 2 # Revision 1.1.1.1 1997/01/14 01:38:04 george
14 :     # Version 109.24
15 :     #
16 :     * Revision 1.1.1.1 1996/01/31 16:01:42 george
17 :     * Version 109
18 :     *
19 :     *)
20 :    
21 :     (* drt (12/15/89) -- the functor should be used during development work,
22 :     but it is wastes space in the release version.
23 :    
24 :     functor ParserGen(structure LrTable : LR_TABLE
25 :     structure Stream : STREAM) : LR_PARSER =
26 :     *)
27 :    
28 : monnier 8 structure LrParser :> LR_PARSER =
29 : monnier 2 struct
30 :     val print = fn s => output(std_out,s)
31 :     val println = fn s => (print s; print "\n")
32 :     structure LrTable = LrTable
33 :     structure Stream = Stream
34 :     structure Token : TOKEN =
35 :     struct
36 :     structure LrTable = LrTable
37 :     datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b)
38 :     val sameToken = fn (TOKEN (t,_),TOKEN(t',_)) => t=t'
39 :     end
40 :    
41 :    
42 :     open LrTable
43 :     open Token
44 :    
45 :     val DEBUG = false
46 :     exception ParseError
47 :    
48 :     type ('a,'b) elem = (state * ('a * 'b * 'b))
49 :     type ('a,'b) stack = ('a,'b) elem list
50 :    
51 :     val showState = fn (STATE s) => ("STATE " ^ (makestring s))
52 :    
53 :     fun printStack(stack: ('a,'b) elem list, n: int) =
54 :     case stack
55 :     of (state, _) :: rest =>
56 :     (print(" " ^ makestring n ^ ": ");
57 :     println(showState state);
58 :     printStack(rest, n+1)
59 :     )
60 :     | nil => ()
61 :    
62 :     val parse = fn {arg : 'a,
63 :     table : LrTable.table,
64 :     lexer : ('_b,'_c) token Stream.stream,
65 :     saction : int * '_c * ('_b,'_c) stack * 'a ->
66 :     nonterm * ('_b * '_c * '_c) * ('_b,'_c) stack,
67 :     void : '_b,
68 :     ec = {is_keyword,preferred_change,
69 :     errtermvalue,showTerminal,
70 :     error,terms,noShift},
71 :     lookahead} =>
72 :     let fun prAction(stack as (state, _) :: _,
73 :     next as (TOKEN (term,_),_), action) =
74 :     (println "Parse: state stack:";
75 :     printStack(stack, 0);
76 :     print(" state="
77 :     ^ showState state
78 :     ^ " next="
79 :     ^ showTerminal term
80 :     ^ " action="
81 :     );
82 :     case action
83 :     of SHIFT s => println ("SHIFT " ^ showState s)
84 :     | REDUCE i => println ("REDUCE " ^ (makestring i))
85 :     | ERROR => println "ERROR"
86 :     | ACCEPT => println "ACCEPT";
87 :     action)
88 :     | prAction (_,_,action) = action
89 :    
90 :     val action = LrTable.action table
91 :     val goto = LrTable.goto table
92 :    
93 :     fun parseStep(next as (TOKEN (terminal, value as (_,leftPos,_)),lexer) :
94 :     ('_b,'_c) token * ('_b,'_c) token Stream.stream,
95 :     stack as (state,_) :: _ : ('_b ,'_c) stack) =
96 :     case (if DEBUG then prAction(stack, next,action(state, terminal))
97 :     else action(state, terminal))
98 :     of SHIFT s => parseStep(Stream.get lexer, (s,value) :: stack)
99 :     | REDUCE i =>
100 :     let val (nonterm,value,stack as (state,_) :: _ ) =
101 :     saction(i,leftPos,stack,arg)
102 :     in parseStep(next,(goto(state,nonterm),value)::stack)
103 :     end
104 :     | ERROR => let val (_,leftPos,rightPos) = value
105 :     in error("syntax error\n",leftPos,rightPos);
106 :     raise ParseError
107 :     end
108 :     | ACCEPT => let val (_,(topvalue,_,_)) :: _ = stack
109 :     val (token,restLexer) = next
110 :     in (topvalue,Stream.cons(token,lexer))
111 :     end
112 :     val next as (TOKEN (terminal,(_,leftPos,_)),_) = Stream.get lexer
113 :     in parseStep(next,[(initialState table,(void,leftPos,leftPos))])
114 :     end
115 :     end;
116 :    
117 :     (* drt (12/15/89) -- this needs to be used only when the parsing engine
118 :     (the code above) is functorized.
119 :    
120 :     structure LrParser = ParserGen(structure LrTable = LrTable
121 :     structure Stream = Stream);
122 :     *)

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