1 -- -*- Mode: Haskell -*- 2 -- Copyright 1994 by Peter Thiemann 3 -- GrammarTransform.hs --- some transformations on parse trees 4 -- Author : Peter Thiemann 5 -- Created On : Thu Oct 21 16:44:17 1993 6 -- Last Modified By: Peter Thiemann 7 -- Last Modified On: Mon Dec 27 17:41:16 1993 8 -- Update Count : 14 9 -- Status : Unknown, Use with caution! 10 -- 11 -- $Locker: $ 12 -- $Log: GrammarTransform.hs,v $ 13 -- Revision 1.2 1997/03/14 08:08:06 simonpj 14 -- Major update to more-or-less 2.02 15 -- 16 -- Revision 1.1 1996/01/08 20:02:35 partain 17 -- Initial revision 18 -- 19 -- Revision 1.1 1994/03/15 15:34:53 thiemann 20 -- Initial revision 21 -- 22 -- 23 24 module GrammarTransform (simplify) where 25 26 import AbstractSyntax 27 28 simplify :: [Production] -> [Production] 29 simplify = map simplify' . simp3 30 31 -- simp1 gets the body of a ProdFactor as an argument 32 -- and provides the transformations 33 -- beta { X } X gamma ---> beta (X)+ gamma 34 -- beta X { X } gamma ---> beta (X)+ gamma 35 -- beta { X Y } X gamma ---> beta (X)/ (Y) gamma 36 -- beta X { Y X } gamma ---> beta (X)/ (Y) gamma 37 38 simp1 [] = [] 39 simp1 [p] = [p] 40 simp1 (ProdRepeat p:p':prods) 41 | p `eqProduction` p' = ProdRepeat1 p: simp1 prods 42 simp1 (p:ProdRepeat p':prods) 43 | p `eqProduction` p' = ProdRepeat1 p: simp1 prods 44 simp1 (ProdRepeat (ProdFactor [p1, p2]):p:prods) 45 | p1 `eqProduction` p = ProdRepeatWithAtom p p2: simp1 prods 46 simp1 (p:ProdRepeat (ProdFactor [p1, p2]):prods) 47 | p `eqProduction` p2 = ProdRepeatWithAtom p p1: simp1 prods 48 simp1 (p:prods) = p: simp1 prods 49 50 -- simp2 gets the body of a ProdTerm as an argument 51 -- and provides the transformations 52 -- X gamma | X delta ---> X (gamma | delta) 53 -- X gamma | X ---> X [ gamma ] 54 55 simp2 (ProdFactor (p:rest): ProdFactor (p':rest'): more) 56 | p `eqProduction` p' = case (rest, rest') of 57 ([], []) -> simp2 (ProdFactor [p]: more) 58 ([], _) -> simp2 (ProdFactor [p, ProdOption (ProdFactor rest')]: more) 59 (_, []) -> simp2 (ProdFactor [p, ProdOption (ProdFactor rest)]: more) 60 (_, _) -> simp2 (ProdFactor [p, ProdTerm (simp2 [ProdFactor rest, ProdFactor rest'])]: more) 61 | otherwise = ProdFactor (p:rest): simp2 (ProdFactor (p':rest'):more) 62 simp2 [p] = [p] 63 simp2 [] = [] 64 65 -- simp3 gets a list of ProdProductions and looks for left and right recursive productions 66 -- it executes the transformations 67 -- A -> A gamma_1 | ... | A gamma_k | delta 68 -- ---> 69 -- A -> delta { gamma_1 | ... | gamma_k } 70 -- and 71 -- A -> gamma_1 A | ... | gamma_k A | delta 72 -- ---> 73 -- A -> { gamma_1 | ... | gamma_k } delta 74 75 leftParty nt (ProdTerm ps) = foldr f ([], []) ps 76 where f (ProdFactor (ProdNonterminal nt':rest)) (yes, no) 77 | nt == nt' = (ProdFactor rest:yes, no) 78 f p (yes, no) = (yes, p:no) 79 80 simp3'l prod@(ProdProduction nt nts p@(ProdTerm _)) 81 = case leftParty nt p of 82 (lefties@(_:_), others@(_:_)) -> 83 ProdProduction nt nts 84 (ProdFactor [ProdTerm others, ProdRepeat (ProdTerm lefties)]) 85 _ -> prod 86 simp3'l prod = prod 87 88 rightParty nt (ProdTerm ps) = foldr f ([], []) ps 89 where f (ProdFactor ps) (yes, no) 90 | length ps > 1 && rightmost nt ps = (ProdFactor (init ps):yes, no) 91 f p (yes, no) = (yes, p:no) 92 93 rightmost nt [ProdNonterminal nt'] = nt == nt' 94 rightmost nt [p] = False 95 rightmost nt (p:ps) = rightmost nt ps 96 97 simp3'r prod@(ProdProduction nt nts p@(ProdTerm _)) 98 = case rightParty nt p of 99 (righties@(_:_), others@(_:_)) -> 100 ProdProduction nt nts 101 (ProdFactor [ProdRepeat (ProdTerm righties), ProdTerm others]) 102 _ -> prod 103 simp3'r prod = prod 104 105 simp3 = map (simp3'r . simp3'l) 106 107 -- compute the set of all nonterminals in a Production 108 freents :: Production -> [String] 109 freents (ProdTerm prods) = concat (map freents prods) 110 freents (ProdFactor prods) = concat (map freents prods) 111 freents (ProdNonterminal s) = [s] 112 freents (ProdTerminal s) = [] 113 freents (ProdOption p) = freents p 114 freents (ProdRepeat p) = freents p 115 freents (ProdRepeat1 p) = freents p 116 freents (ProdRepeatWithAtom p1 p2) = freents p1 ++ freents p2 117 freents (ProdPlus) = [] 118 freents (ProdSlash p) = freents p 119 -- 120 121 simplify' (ProdProduction s1 s2 prod) = ProdProduction s1 s2 (simplify' prod) 122 simplify' (ProdTerm prods) = ProdTerm ((simp2 . map simplify') prods) 123 simplify' (ProdFactor prods) = ProdFactor (simp1 (map simplify' prods)) 124 simplify' (ProdNonterminal s) = ProdNonterminal s 125 simplify' (ProdTerminal s) = ProdTerminal s 126 simplify' (ProdOption prod) = ProdOption (simplify' prod) 127 simplify' (ProdRepeat prod) = ProdRepeat (simplify' prod) 128 simplify' (ProdRepeat1 prod) = ProdRepeat1 (simplify' prod) 129 simplify' (ProdRepeatWithAtom prod1 prod2) = ProdRepeatWithAtom (simplify' prod1) (simplify' prod2) 130 simplify' (ProdPlus) = ProdPlus 131 simplify' (ProdSlash prod) = ProdSlash (simplify' prod) 132 133 -- Goferisms: 134 135 eqList [] [] = True 136 eqList (x:xs) (y:ys) = eqProduction x y && eqList xs ys 137 eqList _ _ = False 138 139 eqProduction (ProdFile ps) (ProdFile ps') = eqList ps ps' 140 eqProduction (ProdProduction str ostr p) (ProdProduction str' ostr' p') = str == str' && ostr == ostr' && eqProduction p p' 141 eqProduction (ProdTerm ps) (ProdTerm ps') = eqList ps ps' 142 eqProduction (ProdFactor ps) (ProdFactor ps') = eqList ps ps' 143 eqProduction (ProdNonterminal str) (ProdNonterminal str') = str == str' 144 eqProduction (ProdTerminal str) (ProdTerminal str') = str == str' 145 eqProduction (ProdOption p) (ProdOption p') = eqProduction p p' 146 eqProduction (ProdRepeat p) (ProdRepeat p') = eqProduction p p' 147 eqProduction (ProdRepeatWithAtom p1 p2) (ProdRepeatWithAtom p1' p2') = eqProduction p1 p1' && eqProduction p2 p2' 148 eqProduction (ProdRepeat1 p) (ProdRepeat1 p') = eqProduction p p' 149 eqProduction (ProdPlus) (ProdPlus) = True 150 eqProduction (ProdSlash p) (ProdSlash p') = eqProduction p p' 151 eqProduction _ _ = False