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