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

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

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