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