1 2 {------------------------------------------------------------------------} 3 {--- Generic stuff for all architectures. Generics.hs ---} 4 {------------------------------------------------------------------------} 5 6 {- 7 This file is part of Cacheprof, a profiling tool for finding 8 sources of cache misses in programs. 9 10 Copyright (C) 1999 Julian Seward (jseward@acm.org) 11 Home page: http://www.cacheprof.org 12 13 This program is free software; you can redistribute it and/or 14 modify it under the terms of the GNU General Public License as 15 published by the Free Software Foundation; either version 2 of the 16 License, or (at your option) any later version. 17 18 This program is distributed in the hope that it will be useful, but 19 WITHOUT ANY WARRANTY; without even the implied warranty of 20 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 21 General Public License for more details. 22 23 You should have received a copy of the GNU General Public License 24 along with this program; if not, write to the Free Software 25 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 26 02111-1307, USA. 27 28 The GNU General Public License is contained in the file LICENSE. 29 -} 30 31 module Generics where 32 33 internal msg 34 = error ("\ncacheann: Internal error: " ++ msg ++ "\n") 35 incomplete msg 36 = error ("\ncacheann: Unhandled instruction set artefact:\n " 37 ++ msg ++ "\n") 38 inputerr msg 39 = error ("\ncacheann: Bad input: " ++ msg ++ "\n") 40 41 {-----------------------------------------------------------} 42 {--- A data type for lexemes ---} 43 {-----------------------------------------------------------} 44 45 {- In here, LReg, LLiteral and LName are arch/syntax 46 specific, but I don't think this matters, so long 47 as the arch-specific lexer produces the Right Things. 48 Note that lexers themselves are arch/syntax 49 specific. 50 -} 51 data Lex 52 = LReg String -- a register name eg "%eax" 53 | LNum String -- a number "456" 54 | LLiteral String -- a literal value "$12" 55 | LName String -- a name "fprintf" 56 | LLabel String -- a label ".L3345" 57 | LComma 58 | LLParen 59 | LRParen 60 | LPlus 61 | LMinus 62 | LStar 63 | LDollar 64 deriving (Show, Eq) 65 66 67 unLReg (LReg s) = s 68 isLReg lx = case lx of { LReg _ -> True; _ -> False } 69 70 unLNum (LNum s) = s 71 isLNum lx = case lx of { LNum _ -> True; _ -> False } 72 73 unLLiteral (LLiteral s) = s 74 isLLiteral lx = case lx of { LLiteral _ -> True; _ -> False } 75 76 unLName (LName s) = s 77 isLName lx = case lx of { LName _ -> True; _ -> False } 78 79 unLLabel (LLabel s) = s 80 isLLabel lx = case lx of { LLabel _ -> True; _ -> False } 81 82 83 84 {-----------------------------------------------------------} 85 {--- Combinator parser generics -- building blocks for ---} 86 {--- parsers ---} 87 {-----------------------------------------------------------} 88 89 data PResult a 90 = PFail 91 | POk a [Lex] 92 deriving Show 93 94 type Parser a = [Lex] -> PResult a 95 96 pEmpty :: a -> Parser a 97 pEmpty x ts = POk x ts 98 99 pSat :: (Lex -> Bool) -> Parser Lex 100 pSat p [] = PFail 101 pSat p (t:ts) = if p t then POk t ts else PFail 102 103 pApply :: (a -> b) -> Parser a -> Parser b 104 pApply f p ts 105 = case p ts of 106 PFail -> PFail 107 POk x uu -> POk (f x) uu 108 109 110 pName :: String -> a -> Parser a 111 pName w x ((LName w2):lxs) 112 = if w == w2 then POk x lxs else PFail 113 pName w x _ = PFail 114 115 p2 :: (a -> b -> c) 116 -> Parser a -> Parser b -> Parser c 117 p2 f p1 p2 ts1 118 = case p1 ts1 of { PFail -> PFail ; POk x1 uu1 -> 119 case p2 uu1 of { PFail -> PFail ; POk x2 uu2 -> 120 POk (f x1 x2) uu2 121 }} 122 123 p3 :: (a -> b -> c -> d) 124 -> Parser a -> Parser b -> Parser c -> Parser d 125 p3 f p1 p2 p3 ts1 126 = case p1 ts1 of { PFail -> PFail ; POk x1 uu1 -> 127 case p2 uu1 of { PFail -> PFail ; POk x2 uu2 -> 128 case p3 uu2 of { PFail -> PFail ; POk x3 uu3 -> 129 POk (f x1 x2 x3) uu3 130 }}} 131 132 pStar :: Parser a -> Parser [a] 133 pStar p ts 134 = case p ts of 135 PFail -> POk [] ts 136 POk x uu1 -> case pStar p uu1 of 137 POk xs uu2 -> POk (x:xs) uu2 138 PFail -> internal "pStar failed" 139 140 pPlus :: Parser a -> Parser [a] 141 pPlus p = p2 (:) p (pStar p) 142 143 pAlt2 :: Parser a -> Parser a -> Parser a 144 pAlt2 p1 p2 ts 145 = case p1 ts of 146 POk x1 uu -> POk x1 uu 147 PFail -> p2 ts 148 149 pAlts :: [Parser a] -> Parser a 150 pAlts = foldl1 pAlt2 151 152 pOpt :: Parser a -> Parser (Maybe a) 153 pOpt p ts 154 = case p ts of 155 PFail -> POk Nothing ts 156 POk x uu -> POk (Just x) uu 157 158 pStarComma p 159 = pAlts [ 160 p2 (\xs y -> xs++[y]) (pPlus (p2 (\x y -> x) p pLComma)) p, 161 pApply (\x -> [x]) p, 162 pEmpty [] 163 ] 164 165 pLComma = pSat (== LComma) 166 pLMinus = pSat (== LMinus) 167 pLPlus = pSat (== LPlus) 168 pLLParen = pSat (== LLParen) 169 pLRParen = pSat (== LRParen) 170 pLStar = pSat (== LStar) 171 pLDollar = pSat (== LDollar) 172 173 pInParens p = p3 (\_ r _ -> r) pLLParen p pLRParen 174 pPreComma p = p2 (\_ r -> r) pLComma p 175 pPreCommaOpt p = p2 (\_ r -> r) (pOpt pLComma) p 176 177 178 179 {------------------------------------------------------------------------} 180 {--- end Generics.hs ---} 181 {------------------------------------------------------------------------}