-- Compiler Toolkit: identifiers -- -- Author : Manuel M. T. Chakravarty -- Created: 14 February 95 -- -- Version $Revision: 1.2 $ from $Date: 2004/11/13 17:26:50 $ -- -- Copyright (c) [1995..1999] Manuel M. T. Chakravarty -- -- This file is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This file is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- --- DESCRIPTION --------------------------------------------------------------- -- -- This module provides an abstract notion of identifiers. -- --- DOCU ---------------------------------------------------------------------- -- -- language: Haskell 98 -- -- * We speed up the equality test between identifiers by assigning an -- identification number to each of them, and providing a special equality -- that compares the lexemes only if the identification numbers are equal. -- -- * The ordering relation on identifiers is also oriented at the -- identification number and, hence, does *not* follow the alphanumerical -- ordering of the lexemes of the identifiers. Instead, it provides a fast -- ordering when identifiers are used as keys in a `Map'. -- -- * The ambiguousness resolving number of an identifier is `-1' when no such -- number is present (so, such identifiers are distinguished from -- identifiers that share the front part of the lexeme while having an -- ambiguousness resolving number). -- -- The ambiguousness resolving number of primitive identifiers (`pid' in the -- grammar contained in the KCode definition) is `-2' (this gives primitive -- identifiers a distinct name space). -- -- * Attributes may be associated to identifiers, except with `OnlyPos' -- identifiers, which have a position as their only attribute (they do not -- carry an attribute identifier, which can be used to index attribute -- tables). -- -- * Internal identifiers that are forming a completely unique name space are -- supported. But note, they do not have a proper lexeme, i.e., they are not -- suited for code generation. -- --- TODO ---------------------------------------------------------------------- -- -- * Hashing is not 8bit clean. -- module Idents (Ident, noARNum, isLegalIdent, lexemeToIdent, internalIdent, onlyPosIdent, cloneIdent, identToLexeme, isIdentSimple, isIdentPrim, stripIdentARNum, getIdentARNum, newIdentARNum, getIdentAttrs, dumpIdent) where import Data.Char import Position (Position, Pos(posOf), nopos) import UNames (Name) import Errors (interr) import Attributes (Attrs, newAttrsOnlyPos, newAttrs, Attributed(attrsOf), posOfAttrsOf) import Binary (Binary(..), putSharedString, getSharedString) -- simple identifier representation (EXPORTED) -- -- identifiers without an ambiguousness resolving number get `noARNum' as -- number -- data Ident = Ident String -- lexeme !Int -- ambiguousness resolving number !Int -- id. number to speed up equality check !Attrs -- attributes of this ident. incl. position -- the definition of the equality allows identifiers to be equal that are -- defined at different source text positions, and aims at speeding up the -- equality test, by comparing the lexemes only if the two numbers are equal -- instance Eq Ident where (Ident s k id _) == (Ident s' k' id' _) = (k == k') && (id == id') && (s == s') -- this does *not* follow the alphanumerical ordering of the lexemes -- instance Ord Ident where (Ident s k id _) < (Ident s' k' id' _) = (k < k') || ((k == k') && (id < id')) || ((k == k') && (id == id') && (s < s')) id1 <= id2 = (id1 < id2) || (id1 == id2) -- for displaying identifiers -- instance Show Ident where showsPrec _ ide = showString ("`" ++ identToLexeme ide ++ "'") -- identifiers are attributed -- instance Attributed Ident where attrsOf (Ident _ _ _ at) = at -- identifiers have a canonical position -- instance Pos Ident where posOf = posOfAttrsOf -- to speed up the equality test we compute some hash-like value for each -- identifiers lexeme and store it in the identifiers representation -- hash function from the dragon book pp437; assumes 7 bit characters and needs -- the (nearly) full range of values guaranteed for `Int' by the Haskell -- language definition; can handle 8 bit characters provided we have 29 bit -- for the `Int's without sign -- quad :: String -> Int quad (c1:c2:c3:c4:s) = ((ord c4 * bits21 + ord c3 * bits14 + ord c2 * bits7 + ord c1) `mod` bits28) + (quad s `mod` bits28) quad (c1:c2:c3:[] ) = ord c3 * bits14 + ord c2 * bits7 + ord c1 quad (c1:c2:[] ) = ord c2 * bits7 + ord c1 quad (c1:[] ) = ord c1 quad ([] ) = 0 bits7 = 2^7 bits14 = 2^14 bits21 = 2^21 bits28 = 2^28 -- used as a substitute for the ambiguousness resolving number if it is not -- present (EXPORTED) -- noARNum :: Int noARNum = -1 -- used as the ambiguousness resolving number for primitive identifiers -- primARNum :: Int primARNum = -2 -- used as the ambiguousness resolving number for internal identifiers -- internARNum :: Int internARNum = -3 -- checks whether the given lexeme is a legal identifier (EXPORTED) -- isLegalIdent :: String -> Bool isLegalIdent [] = False isLegalIdent (c:cs) = if c == '`' then isQualIdent cs else (isAlpha c || c == '_') && isIdent (c:cs) where isIdent = checkTail . (dropWhile isAlphaNumOrUS) checkTail [] = True checkTail ("##") = True checkTail ('#':cs') = all isDigit cs' checkTail _ = False isAlphaNumOrUS c = isAlphaNum c || (c == '_') isAlphaNum c = isAlpha c || isNum c isAlpha c = c `elem` ['a'..'z'] ++ ['A'..'Z'] isNum c = c `elem` ['0'..'9'] isQualIdent cs = let cs' = skip cs in (not . null) cs' && (checkTail . tail) cs' skip [] = [] skip ('\'':cs) = '\'':cs skip ('\\':cs) = case cs of ('\'':cs') -> skip cs' ('\\':cs') -> skip cs' _ -> skip cs skip (c :cs) = skip cs -- given the lexeme of an identifier, yield the abstract identifier (EXPORTED) -- -- * the only attribute of the resulting identifier is its source text -- position; as provided in the first argument of this function -- -- * only minimal error checking, e.g., the characters of the identifier are -- not checked for being alphanumerical only; the correct lexis of the -- identifier should be ensured by the caller, e.g., the scanner or -- `isLegalIdent' -- -- * for reasons of simplicity the complete lexeme is hashed (with `quad') -- lexemeToIdent :: Position -> String -> Name -> Ident lexemeToIdent pos l name = Ident s k (quad s) (newAttrs pos name) where (s, k) = parseIdent pos l -- generate an internal identifier (has no position and cannot be asccociated -- with attributes) (EXPORTED) -- internalIdent :: String -> Ident internalIdent s = Ident s internARNum (quad s) (newAttrsOnlyPos nopos) -- generate a `only pos' identifier (may not be used to index attribute -- tables, but has a position value) (EXPORTED) -- onlyPosIdent :: Position -> String -> Ident onlyPosIdent pos l = Ident s k (quad s) (newAttrsOnlyPos pos) where (s, k) = parseIdent pos l -- Extract the name and ambiguousness resolving number from a lexeme. -- parseIdent :: Position -> String -> (String, Int) parseIdent pos l = if (null l) then interr $ "Idents: lexemeToIdent: Empty lexeme! " ++ show pos else if (head l == '\'') then parseQuoted (tail l) else parseNorm l where -- parse lexeme without quotes -- parseNorm [] = ([], noARNum) parseNorm ("##") = ([], primARNum) parseNorm ('#':cs) = ([], ((read . check) cs)::Int) parseNorm (c :cs) = let (cs', k) = parseNorm cs in (c:cs', k) check [] = interr "Idents: lexemeToIdent: Missing\ \ number!" check ('-':cs) = interr "Idents: lexemeToIdent: Illegal\ \ negative number!" check s = s -- parse lexeme with quotes -- parseQuoted [] = interr endInQuotes parseQuoted ('\\':cs) = parseSpecial cs parseQuoted ('\'':cs) = let (rmd, k) = parseNorm cs in if (null rmd) then ([], k) else interr afterQuotes parseQuoted (c :cs) = let (cs', k) = parseQuoted cs in (c:cs', k) endInQuotes = "Idents: lexemeToIdent: Unexpected end of\ \ lexeme (in quotes)!" afterQuotes = "Idents: lexemeToIdent: Superfluous\ \ characters after quotes!" endInSpecial = "Idents: lexemeToIdent: Unexpected end of\ \ lexeme (in escape sequence)!" illegalSpecial = "Idents: lexemeToIdent: Illegal escape\ \ sequence!" -- parse single escaped character, then continue with -- `parseQuoted' -- parseSpecial [] = interr endInSpecial parseSpecial (c1:c2:c3:cs) | isDigit c1 && isDigit c2 && isDigit c3 = let (cs', k) = parseQuoted cs ord0 = ord '0' d1 = ord c1 - ord0 d2 = ord c2 - ord0 d3 = ord c3 - ord0 in (chr (100*d1 + 10*d2 + d3) :cs', k) parseSpecial (c:cs) | c == '\\' = ('\\':cs', k) | c == '\"' = ('\"':cs', k) | c == '\'' = ('\'':cs', k) | c == 'n' = ('\n':cs', k) | c == 't' = ('\t':cs', k) | c == 'r' = ('\r':cs', k) where (cs', k) = parseQuoted cs parseSpecial _ = interr illegalSpecial -- create an identifier identical to the given one, but with its own set of -- attributes (EXPORTED) -- cloneIdent :: Ident -> Name -> Ident cloneIdent (Ident s k idnum at) name = Ident s k idnum (newAttrs (posOf at) name) -- given an abstract identifier, yield its lexeme (EXPORTED) -- identToLexeme :: Ident -> String identToLexeme (Ident s k _ _) = s ++ suffix where suffix = if (k == noARNum) then "" else if (k == primARNum) then "##" else if (k == internARNum) then "<internal>" else "#" ++ show k -- test if the given identifier is simple, i.e., has no ambiguousness -- resolving number and is not a primitive identifier (EXPORTED) -- isIdentSimple :: Ident -> Bool isIdentSimple (Ident _ k _ _) = k == noARNum -- test if the given identifier is a primitive identifier (EXPORTED) -- isIdentPrim :: Ident -> Bool isIdentPrim (Ident _ k _ _) = k == primARNum -- remove ambiguousness resolving of an identifier (EXPORTED) -- -- NOTE: The new identifier will not be equal (==) to the old one! -- stripIdentARNum :: Ident -> Ident stripIdentARNum (Ident s k id at) | k == primARNum || k == internARNum = interr "Idents: stripIdentARNum: \ \Not allowed!" | otherwise = Ident s noARNum id at -- get the ambiguousness resolving of an identifier (EXPORTED) -- getIdentARNum :: Ident -> Int getIdentARNum (Ident s k id at) | k == primARNum || k == internARNum = interr "Idents: getIdentARNum: \ \Not allowed!" | otherwise = k -- enter a new ambiguousness resolving into the identifier (EXPORTED) -- -- NOTE: The new identifier will not be equal (==) to the old one! -- newIdentARNum :: Ident -> Int -> Ident newIdentARNum (Ident s k id at) k' | k' < 0 = interr "Idents: newIdentARNum: \ \Negative number!" | k == primARNum || k == internARNum = interr "Idents: newIdentARNum: \ \Not allowed!" | otherwise = Ident s k' id at -- get the attribute identifier associated with the given identifier (EXPORTED) -- getIdentAttrs :: Ident -> Attrs getIdentAttrs (Ident _ _ _ as) = as -- dump the lexeme and its positions into a string for debugging purposes -- (EXPORTED) -- dumpIdent :: Ident -> String dumpIdent ide = identToLexeme ide ++ " at " ++ show (posOf ide) {-! for Ident derive : GhcBinary !-} {-* Generated by DrIFT : Look, but Don't Touch. *-} instance Binary Ident where put_ bh (Ident aa ab ac ad) = do putSharedString bh aa -- put_ bh aa put_ bh ab put_ bh ac put_ bh ad get bh = do aa <- getSharedString bh -- aa <- get bh ab <- get bh ac <- get bh ad <- get bh return (Ident aa ab ac ad)