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