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/branches/SMLNJ/src/ml-yacc/src/look.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/ml-yacc/src/look.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 167 - (view) (download)

1 : monnier 2 (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi
2 :     *
3 :     * $Log$
4 : monnier 167 * Revision 1.1.1.6 1998/11/07 20:11:15 monnier
5 :     * version $version
6 : monnier 2 *
7 : monnier 8 * Revision 1.1.1.1 1997/01/14 01:38:05 george
8 :     * Version 109.24
9 :     *
10 : monnier 2 * Revision 1.1.1.1 1996/01/31 16:01:46 george
11 :     * Version 109
12 :     *
13 :     *)
14 :    
15 :     functor mkLook (structure IntGrammar : INTGRAMMAR) : LOOK =
16 :     struct
17 :     open Array List
18 :     infix 9 sub
19 :     structure Grammar = IntGrammar.Grammar
20 :     structure IntGrammar = IntGrammar
21 :     open Grammar IntGrammar
22 :    
23 :     structure TermSet = ListOrdSet
24 :     (struct
25 :     type elem = term
26 :     val eq = eqTerm
27 :     val gt = gtTerm
28 :     end)
29 :    
30 :     val union = TermSet.union
31 :     val make_set = TermSet.make_set
32 :    
33 :     val prLook = fn (termToString,print) =>
34 :     let val printTerm = print o termToString
35 :     fun f nil = print " "
36 :     | f (a :: b) = (printTerm a; print " "; f b)
37 :     in f
38 :     end
39 :    
40 :     structure NontermSet = ListOrdSet
41 :     (struct
42 :     type elem = nonterm
43 :     val eq = eqNonterm
44 :     val gt = gtNonterm
45 :     end)
46 :    
47 :     val mkFuncs = fn {rules : rule list, nonterms : int,
48 :     produces : nonterm -> rule list} =>
49 :    
50 :     let
51 :    
52 :     (* nullable: create a function which tells if a nonterminal is nullable
53 :     or not.
54 :    
55 :     Method: Keep an array of booleans. The nth entry is true if
56 :     NT i is nullable. If is false if we don't know whether NT i
57 :     is nullable.
58 :    
59 :     Keep a list of rules whose remaining rhs we must prove to be
60 :     null. First, scan the list of rules and remove those rules
61 :     whose rhs contains a terminal. These rules are not nullable.
62 :    
63 :     Now iterate through the rules that were left:
64 :     (1) if there is no remaining rhs we have proved that
65 :     the rule is nullable, mark the nonterminal for the
66 :     rule as nullable
67 :     (2) if the first element of the remaining rhs is
68 :     nullable, place the rule back on the list with
69 :     the rest of the rhs
70 :     (3) if we don't know whether the nonterminal is nullable,
71 :     place it back on the list
72 :     (4) repeat until the list does not change.
73 :    
74 :     We have found all the possible nullable rules.
75 :     *)
76 :    
77 :     val nullable =
78 :     let fun ok_rhs nil = true
79 :     | ok_rhs ((TERM _)::_) = false
80 :     | ok_rhs ((NONTERM i)::r) = ok_rhs r
81 :     fun add_rule (RULE {lhs,rhs,...},r) =
82 :     if ok_rhs rhs then (lhs,map (fn (NONTERM (NT i)) => i) rhs)::r
83 :     else r
84 :     val items = List.foldr add_rule [] rules
85 :     val nullable = array(nonterms,false)
86 :     val f = fn ((NT i,nil),(l,_)) => (update(nullable,i,true);
87 :     (l,true))
88 :     | (a as (lhs,(h::t)),(l,change)) =>
89 :     case (nullable sub h)
90 :     of false => (a::l,change)
91 :     | true => ((lhs,t)::l,true)
92 :     fun prove(l,true) = prove(List.foldr f (nil,false) l)
93 :     | prove(_,false) = ()
94 :     in (prove(items,true); fn (NT i) => nullable sub i)
95 :     end
96 :    
97 :     (* scanRhs : look at a list of symbols, scanning past nullable
98 :     nonterminals, applying addSymbol to the symbols scanned *)
99 :    
100 :     fun scanRhs addSymbol =
101 :     let fun f (nil,result) = result
102 :     | f ((sym as NONTERM nt) :: rest,result) =
103 :     if nullable nt then f (rest,addSymbol(sym,result))
104 :     else addSymbol(sym,result)
105 :     | f ((sym as TERM _) :: _,result) = addSymbol(sym,result)
106 :     in f
107 :     end
108 :    
109 :     (* accumulate: look at the start of the right-hand-sides of rules,
110 :     looking past nullable nonterminals, applying addObj to the visible
111 :     symbols. *)
112 :    
113 :     fun accumulate(rules, empty, addObj) =
114 :     List.foldr (fn (RULE {rhs,...},r) =>(scanRhs addObj) (rhs,r)) empty rules
115 :    
116 :     val nontermMemo = fn f =>
117 :     let val lookup = array(nonterms,nil)
118 :     fun g i = if i=nonterms then ()
119 :     else (update(lookup,i,f (NT i)); g (i+1))
120 :     in (g 0; fn (NT j) => lookup sub j)
121 :     end
122 :    
123 :     (* first1: the FIRST set of a nonterminal in the grammar. Only looks
124 :     at other terminals, but it is clever enough to move past nullable
125 :     nonterminals at the start of a production. *)
126 :    
127 :     fun first1 nt = accumulate(produces nt, TermSet.empty,
128 :     fn (TERM t, set) => TermSet.insert (t,set)
129 :     | (_, set) => set)
130 :    
131 :     val first1 = nontermMemo(first1)
132 :    
133 :     (* starters1: given a nonterminal "nt", return the set of nonterminals
134 :     which can start its productions. Looks past nullables, but doesn't
135 :     recurse *)
136 :    
137 :     fun starters1 nt = accumulate(produces nt, nil,
138 :     fn (NONTERM nt, set) =>
139 :     NontermSet.insert(nt,set)
140 :     | (_, set) => set)
141 :    
142 :     val starters1 = nontermMemo(starters1)
143 :    
144 :     (* first: maps a nonterminal to its first-set. Get all the starters of
145 :     the nonterminal, get the first1 terminal set of each of these,
146 :     union the whole lot together *)
147 :    
148 :     fun first nt =
149 :     List.foldr (fn (a,r) => TermSet.union(r,first1 a))
150 :     [] (NontermSet.closure (NontermSet.singleton nt, starters1))
151 :    
152 :     val first = nontermMemo(first)
153 :    
154 :     (* prefix: all possible terminals starting a symbol list *)
155 :    
156 :     fun prefix symbols =
157 :     scanRhs (fn (TERM t,r) => TermSet.insert(t,r)
158 :     | (NONTERM nt,r) => TermSet.union(first nt,r))
159 :     (symbols,nil)
160 :    
161 :     fun nullable_string ((TERM t) :: r) = false
162 :     | nullable_string ((NONTERM nt) :: r) =
163 :     (case (nullable nt)
164 :     of true => nullable_string r
165 :     | f => f)
166 :     | nullable_string nil = true
167 :    
168 :     in {nullable = nullable, first = prefix}
169 :     end
170 :     end;

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