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/src/absyn.sml
ViewVC logotype

Annotation of /sml/trunk/src/ml-yacc/src/absyn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 515 - (view) (download)

1 : monnier 249 (* ML-Yacc Parser Generator (c) 1991 Andrew W. Appel, David R. Tarditi
2 :     *
3 :     * $Log$
4 : blume 515 * Revision 1.2 2000/01/09 09:59:14 blume
5 :     * pickler bug fixes; some cosmetic changes
6 :     *
7 : monnier 249 * Revision 1.1.1.10 1999/04/17 18:56:11 monnier
8 :     * version 110.16
9 :     *
10 :     * Revision 1.1.1.1 1997/01/14 01:38:05 george
11 :     * Version 109.24
12 :     *
13 :     * Revision 1.3 1996/02/26 15:02:30 george
14 :     * print no longer overloaded.
15 :     * use of makestring has been removed and replaced with Int.toString ..
16 :     * use of IO replaced with TextIO
17 :     *
18 :     * Revision 1.2 1996/02/15 01:51:38 jhr
19 :     * Replaced character predicates (isalpha, isnum) with functions from Char.
20 :     *
21 :     * Revision 1.1.1.1 1996/01/31 16:01:44 george
22 :     * Version 109
23 :     *
24 :     *)
25 :    
26 :     structure Absyn : ABSYN =
27 :     struct
28 :     datatype exp
29 :     = CODE of string
30 :     | EAPP of exp * exp
31 :     | EINT of int
32 :     | ETUPLE of exp list
33 :     | EVAR of string
34 :     | FN of pat * exp
35 :     | LET of decl list * exp
36 :     | SEQ of exp * exp
37 :     | UNIT
38 :     and pat
39 :     = PVAR of string
40 :     | PAPP of string * pat
41 :     | PINT of int
42 :     | PLIST of pat list
43 :     | PTUPLE of pat list
44 :     | WILD
45 :     | AS of pat * pat
46 :     and decl = VB of pat * exp
47 :     and rule = RULE of pat * exp
48 :    
49 :     fun idchar #"'" = true
50 :     | idchar #"_" = true
51 :     | idchar c = Char.isAlpha c orelse Char.isDigit c
52 :    
53 :     fun code_to_ids s = let
54 :     fun g(nil,r) = r
55 :     | g(a as (h::t),r) = if Char.isAlpha h then f(t,[h],r) else g(t,r)
56 :     and f(nil,accum,r)= implode(rev accum)::r
57 :     | f(a as (h::t),accum,r) =
58 :     if idchar h then f(t,h::accum,r) else g(a,implode (rev accum) :: r)
59 :     in g(explode s,nil)
60 :     end
61 :    
62 :     val simplifyRule : rule -> rule = fn (RULE(p,e)) =>
63 :     let val used : (string -> bool) =
64 :     let fun f(CODE s) = code_to_ids s
65 :     | f(EAPP(a,b)) = f a @ f b
66 :     | f(ETUPLE l) = List.concat (map f l)
67 :     | f(EVAR s) = [s]
68 :     | f(FN(_,e)) = f e
69 :     | f(LET(dl,e)) =
70 :     (List.concat (map (fn VB(_,e) => f e) dl)) @ f e
71 :     | f(SEQ(a,b)) = f a @ f b
72 :     | f _ = nil
73 :     val identifiers = f e
74 :     in fn s => List.exists (fn a=>a=s) identifiers
75 :     end
76 :     val simplifyPat : pat -> pat =
77 :     let fun f a =
78 :     case a
79 :     of (PVAR s) => if used s then a else WILD
80 :     | (PAPP(s,pat)) =>
81 :     (case f pat
82 :     of WILD => WILD
83 :     | pat' => PAPP(s,pat'))
84 :     | (PLIST l) =>
85 :     let val l' = map f l
86 :     in if List.exists(fn WILD=>false | _ => true) l'
87 :     then PLIST l'
88 :     else WILD
89 :     end
90 :     | (PTUPLE l) =>
91 :     let val l' = map f l
92 :     in if List.exists(fn WILD=>false | _ => true) l'
93 :     then PTUPLE l'
94 :     else WILD
95 :     end
96 :     | (AS(a,b)) =>
97 :     let val a'=f a
98 :     val b'=f b
99 :     in case(a',b')
100 :     of (WILD,_) => b'
101 :     | (_,WILD) => a'
102 :     | _ => AS(a',b')
103 :     end
104 :     | _ => a
105 :     in f
106 :     end
107 :     val simplifyExp : exp -> exp =
108 :     let fun f(EAPP(a,b)) = EAPP(f a,f b)
109 :     | f(ETUPLE l) = ETUPLE(map f l)
110 :     | f(FN(p,e)) = FN(simplifyPat p,f e)
111 :     | f(LET(dl,e)) =
112 :     LET(map (fn VB(p,e) =>
113 :     VB(simplifyPat p,f e)) dl,
114 :     f e)
115 :     | f(SEQ(a,b)) = SEQ(f a,f b)
116 :     | f a = a
117 :     in f
118 :     end
119 :     in RULE(simplifyPat p,simplifyExp e)
120 :     end
121 :    
122 :     fun printRule (say : string -> unit, sayln:string -> unit) = let
123 :     val lp = ["("]
124 :     val rp = [")"]
125 :     val sp = [" "]
126 :     val sm = [";"]
127 :     val cm = [","]
128 :     val cr = ["\n"]
129 :     val unit = ["()"]
130 :     fun printExp c =
131 :     let fun f (CODE c) = ["(",c,")"]
132 :     | f (EAPP(EVAR a,UNIT)) = [a," ","()"]
133 :     | f (EAPP(EVAR a,EINT i)) = [a," ",Int.toString i]
134 :     | f (EAPP(EVAR a,EVAR b)) = [a," ",b]
135 :     | f (EAPP(EVAR a,b)) = List.concat[[a],lp,f b,rp]
136 :     | f (EAPP(a,b)) = List.concat [lp,f a,rp,lp,f b,rp]
137 :     | f (EINT i) = [Int.toString i]
138 :     | f (ETUPLE (a::r)) =
139 :     let fun scan nil = [rp]
140 :     | scan (h :: t) = cm :: f h :: scan t
141 :     in List.concat (lp :: f a :: scan r)
142 :     end
143 :     | f (ETUPLE _) = ["<bogus-tuple>"]
144 :     | f (EVAR s) = [s]
145 :     | f (FN (p,b)) = List.concat[["fn "],printPat p,[" => "],f b]
146 :     | f (LET (nil,body)) = f body
147 :     | f (LET (dl,body)) =
148 :     let fun scan nil = [[" in "],f body,[" end"],cr]
149 :     | scan (h :: t) = printDecl h :: scan t
150 :     in List.concat(["let "] :: scan dl)
151 :     end
152 :     | f (SEQ (a,b)) = List.concat [lp,f a,sm,f b,rp]
153 :     | f (UNIT) = unit
154 :     in f c
155 :     end
156 :     and printDecl (VB (pat,exp)) =
157 :     List.concat[["val "],printPat pat,["="],printExp exp,cr]
158 :     and printPat c =
159 :     let fun f (AS(PVAR a,PVAR b)) = [a," as ",b]
160 :     | f (AS(a,b)) = List.concat [lp,f a,[") as ("],f b,rp]
161 :     | f (PAPP(a,WILD)) = [a," ","_"]
162 :     | f (PAPP(a,PINT i)) = [a," ",Int.toString i]
163 :     | f (PAPP(a,PVAR b)) = [a," ",b]
164 :     | f (PAPP(a,b)) = List.concat [lp,[a],sp,f b,rp]
165 :     | f (PINT i) = [Int.toString i]
166 :     | f (PLIST l) =
167 : blume 515 let fun scan [h] = [f h]
168 : monnier 249 | scan (h :: t) = f h :: ["::"] :: scan t
169 : blume 515 | scan [] = [["<bogus-list>"]]
170 : monnier 249 in List.concat (scan l)
171 :     end
172 :     | f (PTUPLE (a::r)) =
173 :     let fun scan nil = [rp]
174 :     | scan (h :: t) = cm :: f h :: scan t
175 :     in List.concat (lp :: f a :: scan r)
176 :     end
177 :     | f (PTUPLE nil) = ["<bogus-pattern-tuple>"]
178 :     | f (PVAR a) = [a]
179 :     | f WILD = ["_"]
180 :     in f c
181 :     end
182 :     fun oursay "\n" = sayln ""
183 :     | oursay a = say a
184 :     in fn a =>
185 :     let val RULE(p,e) = simplifyRule a
186 :     in app oursay (printPat p);
187 :     say " => ";
188 :     app oursay (printExp e)
189 :     end
190 :     end
191 :     end;

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