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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 8 - (view) (download)

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

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