--  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 String
s Int
k Int
id Attrs
_) == :: Ident -> Ident -> Bool
== (Ident String
s' Int
k' Int
id' Attrs
_) =    (Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k')
                                            Bool -> Bool -> Bool
&& (Int
id Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
id')
                                            Bool -> Bool -> Bool
&& (String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
s')

-- this does *not* follow the alphanumerical ordering of the lexemes
--
instance Ord Ident where
  (Ident String
s Int
k Int
id Attrs
_) < :: Ident -> Ident -> Bool
< (Ident String
s' Int
k' Int
id' Attrs
_) =    (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
k')
                                           Bool -> Bool -> Bool
|| ((Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k') Bool -> Bool -> Bool
&& (Int
id Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
id'))
                                           Bool -> Bool -> Bool
|| ((Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k') Bool -> Bool -> Bool
&& (Int
id Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
id')
                                               Bool -> Bool -> Bool
&& (String
s String -> String -> Bool
forall a. Ord a => a -> a -> Bool
< String
s'))
  Ident
id1 <= :: Ident -> Ident -> Bool
<= Ident
id2 = (Ident
id1 Ident -> Ident -> Bool
forall a. Ord a => a -> a -> Bool
< Ident
id2) Bool -> Bool -> Bool
|| (Ident
id1 Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
id2)

-- for displaying identifiers
--
instance Show Ident where
  showsPrec :: Int -> Ident -> ShowS
showsPrec Int
_ Ident
ide = String -> ShowS
showString (String
"`" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ident -> String
identToLexeme Ident
ide String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'")

-- identifiers are attributed
--
instance Attributed Ident where
  attrsOf :: Ident -> Attrs
attrsOf (Ident String
_ Int
_ Int
_ Attrs
at) = Attrs
at

-- identifiers have a canonical position
--
instance Pos Ident where
  posOf :: Ident -> Position
posOf = Ident -> Position
forall a. Attributed a => a -> Position
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 :: String -> Int
quad (Char
c1:Char
c2:Char
c3:Char
c4:String
s)  = ((Char -> Int
ord Char
c4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bits21
                          Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bits14
                          Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bits7
                          Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c1)
                         Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
bits28)
                        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (String -> Int
quad String
s Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
bits28)
quad (Char
c1:Char
c2:Char
c3:[]  )  = Char -> Int
ord Char
c3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bits14 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bits7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c1
quad (Char
c1:Char
c2:[]     )  = Char -> Int
ord Char
c2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bits7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c1
quad (Char
c1:[]        )  = Char -> Int
ord Char
c1
quad ([]           )  = Int
0

bits7 :: Int
bits7  = Int
2Int -> Integer -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
7
bits14 :: Int
bits14 = Int
2Int -> Integer -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
14
bits21 :: Int
bits21 = Int
2Int -> Integer -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
21
bits28 :: Int
bits28 = Int
2Int -> Integer -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
28

-- used as a substitute for the ambiguousness resolving number if it is not
-- present (EXPORTED)
--
noARNum :: Int
noARNum :: Int
noARNum  = -Int
1

-- used as the ambiguousness resolving number for primitive identifiers
--
primARNum :: Int
primARNum :: Int
primARNum  = -Int
2

-- used as the ambiguousness resolving number for internal identifiers
--
internARNum :: Int
internARNum :: Int
internARNum  = -Int
3

-- checks whether the given lexeme is a legal identifier (EXPORTED)
--
isLegalIdent        :: String -> Bool
isLegalIdent :: String -> Bool
isLegalIdent []      = Bool
False
isLegalIdent (Char
c:String
cs)  = if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`' then String -> Bool
isQualIdent String
cs
                       else (Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') Bool -> Bool -> Bool
&& String -> Bool
isIdent (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs)
                       where
                         isIdent :: String -> Bool
isIdent = String -> Bool
checkTail (String -> Bool) -> ShowS -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isAlphaNumOrUS)

                         checkTail :: String -> Bool
checkTail []        = Bool
True
                         checkTail (String
"##")    = Bool
True
                         checkTail (Char
'#':String
cs') = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
cs'
                         checkTail String
_         = Bool
False

                         isAlphaNumOrUS :: Char -> Bool
isAlphaNumOrUS Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
                         isAlphaNum :: Char -> Bool
isAlphaNum     Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
isNum Char
c
                         isAlpha :: Char -> Bool
isAlpha        Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'a'..Char
'z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'A'..Char
'Z']
                         isNum :: Char -> Bool
isNum          Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'0'..Char
'9']

                         isQualIdent :: String -> Bool
isQualIdent String
cs = let
                                            cs' :: String
cs' = ShowS
skip String
cs
                                          in
                                            (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) String
cs'
                                            Bool -> Bool -> Bool
&& (String -> Bool
checkTail (String -> Bool) -> ShowS -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
tail) String
cs'

                         skip :: ShowS
skip []        = []
                         skip (Char
'\'':String
cs) = Char
'\''Char -> ShowS
forall a. a -> [a] -> [a]
:String
cs
                         skip (Char
'\\':String
cs) = case String
cs of
                                            (Char
'\'':String
cs') -> ShowS
skip String
cs'
                                            (Char
'\\':String
cs') -> ShowS
skip String
cs'
                                            String
_          -> ShowS
skip String
cs
                         skip (Char
c  :String
cs)  = ShowS
skip String
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 :: Position -> String -> Name -> Ident
lexemeToIdent Position
pos String
l Name
name  = String -> Int -> Int -> Attrs -> Ident
Ident String
s Int
k (String -> Int
quad String
s) (Position -> Name -> Attrs
newAttrs Position
pos Name
name)
                            where
                              (String
s, Int
k) = Position -> String -> (String, Int)
parseIdent Position
pos String
l

-- generate an internal identifier (has no position and cannot be asccociated
-- with attributes) (EXPORTED)
--
internalIdent   :: String -> Ident
internalIdent :: String -> Ident
internalIdent String
s  = String -> Int -> Int -> Attrs -> Ident
Ident String
s Int
internARNum (String -> Int
quad String
s) (Position -> Attrs
newAttrsOnlyPos Position
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 :: Position -> String -> Ident
onlyPosIdent Position
pos String
l  = String -> Int -> Int -> Attrs -> Ident
Ident String
s Int
k (String -> Int
quad String
s) (Position -> Attrs
newAttrsOnlyPos Position
pos)
                      where
                        (String
s, Int
k) = Position -> String -> (String, Int)
parseIdent Position
pos String
l

-- Extract the name and ambiguousness resolving number from a lexeme.
--
parseIdent   :: Position -> String -> (String, Int)
parseIdent :: Position -> String -> (String, Int)
parseIdent Position
pos String
l
              = if (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
l)
                then
                  String -> (String, Int)
forall a. String -> a
interr (String -> (String, Int)) -> String -> (String, Int)
forall a b. (a -> b) -> a -> b
$ String
"Idents: lexemeToIdent: Empty lexeme! " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Position -> String
forall a. Show a => a -> String
show Position
pos
                else
                if (String -> Char
forall a. [a] -> a
head String
l Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'')
                then
                  String -> (String, Int)
parseQuoted (ShowS
forall a. [a] -> [a]
tail String
l)
                else
                  String -> (String, Int)
parseNorm String
l
                where
                -- parse lexeme without quotes
                --
                parseNorm :: String -> (String, Int)
parseNorm []        = ([], Int
noARNum)
                parseNorm (String
"##")    = ([], Int
primARNum)
                parseNorm (Char
'#':String
cs)  = ([], ((String -> Int
forall a. Read a => String -> a
read (String -> Int) -> ShowS -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
check) String
cs)::Int)
                parseNorm (Char
c  :String
cs)  = let
                                        (String
cs', Int
k) = String -> (String, Int)
parseNorm String
cs
                                      in
                                        (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs', Int
k)

                check :: ShowS
check []       = ShowS
forall a. String -> a
interr String
"Idents: lexemeToIdent: Missing\
                                        \ number!"
                check (Char
'-':String
cs) = ShowS
forall a. String -> a
interr String
"Idents: lexemeToIdent: Illegal\
                                        \ negative number!"
                check String
s        = String
s

                -- parse lexeme with quotes
                --
                parseQuoted :: String -> (String, Int)
parseQuoted []        = String -> (String, Int)
forall a. String -> a
interr String
endInQuotes
                parseQuoted (Char
'\\':String
cs) = String -> (String, Int)
parseSpecial String
cs
                parseQuoted (Char
'\'':String
cs) = let
                                          (String
rmd, Int
k) = String -> (String, Int)
parseNorm String
cs
                                        in
                                          if (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rmd) then ([], Int
k)
                                          else String -> (String, Int)
forall a. String -> a
interr String
afterQuotes
                parseQuoted (Char
c   :String
cs) = let
                                          (String
cs', Int
k) = String -> (String, Int)
parseQuoted String
cs
                                        in
                                          (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs', Int
k)

                endInQuotes :: String
endInQuotes  = String
"Idents: lexemeToIdent: Unexpected end of\
                               \ lexeme (in quotes)!"

                afterQuotes :: String
afterQuotes  = String
"Idents: lexemeToIdent: Superfluous\
                               \ characters after quotes!"

                endInSpecial :: String
endInSpecial = String
"Idents: lexemeToIdent: Unexpected end of\
                               \ lexeme (in escape sequence)!"

                illegalSpecial :: String
illegalSpecial = String
"Idents: lexemeToIdent: Illegal escape\
                                 \ sequence!"

                -- parse single escaped character, then continue with
                -- `parseQuoted'
                --
                parseSpecial :: String -> (String, Int)
parseSpecial []              = String -> (String, Int)
forall a. String -> a
interr String
endInSpecial
                parseSpecial (Char
c1:Char
c2:Char
c3:String
cs)
                             | Char -> Bool
isDigit Char
c1
                               Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
c2
                               Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
c3 = let
                                                 (String
cs', Int
k) = String -> (String, Int)
parseQuoted String
cs
                                                 ord0 :: Int
ord0     = Char -> Int
ord Char
'0'
                                                 d1 :: Int
d1       = Char -> Int
ord Char
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ord0
                                                 d2 :: Int
d2       = Char -> Int
ord Char
c2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ord0
                                                 d3 :: Int
d3       = Char -> Int
ord Char
c3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ord0
                                               in
                                                 (Int -> Char
chr (Int
100Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
d1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
d2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d3)
                                                  Char -> ShowS
forall a. a -> [a] -> [a]
:String
cs', Int
k)
                parseSpecial (Char
c:String
cs)
                             | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\'     = (Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:String
cs', Int
k)
                             | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\"'     = (Char
'\"'Char -> ShowS
forall a. a -> [a] -> [a]
:String
cs', Int
k)
                             | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''     = (Char
'\''Char -> ShowS
forall a. a -> [a] -> [a]
:String
cs', Int
k)
                             | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'n'      = (Char
'\n'Char -> ShowS
forall a. a -> [a] -> [a]
:String
cs', Int
k)
                             | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
't'      = (Char
'\t'Char -> ShowS
forall a. a -> [a] -> [a]
:String
cs', Int
k)
                             | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'r'      = (Char
'\r'Char -> ShowS
forall a. a -> [a] -> [a]
:String
cs', Int
k)
                                               where
                                                 (String
cs', Int
k) = String -> (String, Int)
parseQuoted String
cs
                parseSpecial String
_               = String -> (String, Int)
forall a. String -> a
interr String
illegalSpecial

-- create an identifier identical to the given one, but with its own set of
-- attributes (EXPORTED)
--
cloneIdent                           :: Ident -> Name -> Ident
cloneIdent :: Ident -> Name -> Ident
cloneIdent (Ident String
s Int
k Int
idnum Attrs
at) Name
name  =
  String -> Int -> Int -> Attrs -> Ident
Ident String
s Int
k Int
idnum (Position -> Name -> Attrs
newAttrs (Attrs -> Position
forall a. Pos a => a -> Position
posOf Attrs
at) Name
name)

-- given an abstract identifier, yield its lexeme (EXPORTED)
--
identToLexeme                 :: Ident -> String
identToLexeme :: Ident -> String
identToLexeme (Ident String
s Int
k Int
_ Attrs
_)  = String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
suffix
                                 where
                                   suffix :: String
suffix = if      (Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noARNum)
                                            then String
""
                                            else if (Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
primARNum)
                                            then String
"##"
                                            else if (Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
internARNum)
                                            then String
"<internal>"
                                            else String
"#" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
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 -> Bool
isIdentSimple (Ident String
_ Int
k Int
_ Attrs
_)  = Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noARNum

-- test if the given identifier is a primitive identifier (EXPORTED)
--
isIdentPrim                 :: Ident -> Bool
isIdentPrim :: Ident -> Bool
isIdentPrim (Ident String
_ Int
k Int
_ Attrs
_)  = Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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 -> Ident
stripIdentARNum (Ident String
s Int
k Int
id Attrs
at)
  | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
primARNum Bool -> Bool -> Bool
|| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
internARNum  = String -> Ident
forall a. String -> a
interr String
"Idents: stripIdentARNum: \
                                                 \Not allowed!"
  | Bool
otherwise                           = String -> Int -> Int -> Attrs -> Ident
Ident String
s Int
noARNum Int
id Attrs
at

-- get the ambiguousness resolving of an identifier (EXPORTED)
--
getIdentARNum                        :: Ident -> Int
getIdentARNum :: Ident -> Int
getIdentARNum (Ident String
s Int
k Int
id Attrs
at)
  | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
primARNum Bool -> Bool -> Bool
|| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
internARNum  = String -> Int
forall a. String -> a
interr String
"Idents: getIdentARNum: \
                                                 \Not allowed!"
  | Bool
otherwise                           = Int
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 -> Int -> Ident
newIdentARNum (Ident String
s Int
k Int
id Attrs
at) Int
k'
  | Int
k' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0                              = String -> Ident
forall a. String -> a
interr String
"Idents: newIdentARNum: \
                                                 \Negative number!"
  | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
primARNum Bool -> Bool -> Bool
|| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
internARNum  = String -> Ident
forall a. String -> a
interr String
"Idents: newIdentARNum: \
                                                 \Not allowed!"
  | Bool
otherwise                           = String -> Int -> Int -> Attrs -> Ident
Ident String
s Int
k' Int
id Attrs
at

-- get the attribute identifier associated with the given identifier (EXPORTED)
--
getIdentAttrs                  :: Ident -> Attrs
getIdentAttrs :: Ident -> Attrs
getIdentAttrs (Ident String
_ Int
_ Int
_ Attrs
as)  = Attrs
as

-- dump the lexeme and its positions into a string for debugging purposes
-- (EXPORTED)
--
dumpIdent     :: Ident -> String
dumpIdent :: Ident -> String
dumpIdent Ident
ide  = Ident -> String
identToLexeme Ident
ide String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Position -> String
forall a. Show a => a -> String
show (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide)


{-! for Ident derive : GhcBinary !-}
{-* Generated by DrIFT : Look, but Don't Touch. *-}
instance Binary Ident where
    put_ :: BinHandle -> Ident -> IO ()
put_ BinHandle
bh (Ident String
aa Int
ab Int
ac Attrs
ad) = do
            BinHandle -> String -> IO ()
putSharedString BinHandle
bh String
aa
--            put_ bh aa
            BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
ab
            BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
ac
            BinHandle -> Attrs -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Attrs
ad
    get :: BinHandle -> IO Ident
get BinHandle
bh = do
    String
aa <- BinHandle -> IO String
getSharedString BinHandle
bh
--    aa <- get bh
    Int
ab <- BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Int
ac <- BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Attrs
ad <- BinHandle -> IO Attrs
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Ident -> IO Ident
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Int -> Int -> Attrs -> Ident
Ident String
aa Int
ab Int
ac Attrs
ad)