module GBMonad (
TransFun, transTabToTransFun,
HsObject(..), GB, HsPtrRep, initialGBState, setContext, getLibrary,
getPrefix, getLock, delayCode, getDelayedCode, ptrMapsTo, queryPtr, objIs,
queryObj, queryClass, queryPointer, mergeMaps, dumpMaps
) where
import Data.Char (toUpper, toLower, isSpace)
import Data.List (find)
import Data.Maybe (fromMaybe)
import Position (Position, Pos(posOf), nopos, builtinPos)
import Errors (interr)
import Idents (Ident, identToLexeme, onlyPosIdent)
import Map (Map)
import qualified Map as Map (empty, insert, lookup, fromList, toList, union)
import C (CT, readCT, transCT, raiseErrorCTExc)
import CHS (CHSModule(..), CHSFrag(..), CHSHook(..), CHSTrans(..),
CHSAccess(..), CHSAPath(..), CHSPtrType(..))
type TransFun = Ident -> String
underscoreToCase :: TransFun
underscoreToCase :: TransFun
underscoreToCase Ident
ide = let lexeme :: String
lexeme = TransFun
identToLexeme Ident
ide
ps :: [String]
ps = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (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] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
parts (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
lexeme
in
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
adjustCase ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
ps
where
parts :: String -> [String]
parts String
s = let (String
l, String
s') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') String
s
in
String
l String -> [String] -> [String]
forall a. a -> [a] -> [a]
: case String
s' of
[] -> []
(Char
_:String
s'') -> String -> [String]
parts String
s''
adjustCase :: String -> String
adjustCase (Char
c:String
cs) = Char -> Char
toUpper Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
cs
transTabToTransFun :: String -> CHSTrans -> TransFun
transTabToTransFun :: String -> CHSTrans -> TransFun
transTabToTransFun String
prefix (CHSTrans Bool
_2Case [(Ident, Ident)]
table) =
\Ident
ide -> let
lexeme :: String
lexeme = TransFun
identToLexeme Ident
ide
dft :: String
dft = if Bool
_2Case
then TransFun
underscoreToCase Ident
ide
else String
lexeme
in
case Ident -> [(Ident, Ident)] -> Maybe Ident
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Ident
ide [(Ident, Ident)]
table of
Just Ident
ide' -> TransFun
identToLexeme Ident
ide'
Maybe Ident
Nothing ->
case String -> String -> Maybe String
eat String
prefix String
lexeme of
Maybe String
Nothing -> String
dft
Just String
eatenLexeme ->
let
eatenIde :: Ident
eatenIde = Position -> String -> Ident
onlyPosIdent (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide) String
eatenLexeme
eatenDft :: String
eatenDft = if Bool
_2Case
then TransFun
underscoreToCase Ident
eatenIde
else String
eatenLexeme
in
case Ident -> [(Ident, Ident)] -> Maybe Ident
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Ident
eatenIde [(Ident, Ident)]
table of
Maybe Ident
Nothing -> String
eatenDft
Just Ident
ide' -> TransFun
identToLexeme Ident
ide'
where
eat :: String -> String -> Maybe String
eat [] (Char
'_':String
cs) = String -> String -> Maybe String
eat [] String
cs
eat [] String
cs = String -> Maybe String
forall a. a -> Maybe a
Just String
cs
eat (Char
p:String
prefix) (Char
c:String
cs) | Char -> Char
toUpper Char
p Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Char
toUpper Char
c = String -> String -> Maybe String
eat String
prefix String
cs
| Bool
otherwise = Maybe String
forall a. Maybe a
Nothing
eat String
_ String
_ = Maybe String
forall a. Maybe a
Nothing
type PointerMap = Map (Bool, Ident) HsPtrRep
type HsPtrRep = (Bool, CHSPtrType, Maybe String, String)
data HsObject = Pointer {
HsObject -> CHSPtrType
ptrTypeHO :: CHSPtrType,
HsObject -> Bool
isNewtypeHO :: Bool
}
| Class {
HsObject -> Maybe Ident
superclassHO :: (Maybe Ident),
HsObject -> Ident
ptrHO :: Ident
}
deriving (Int -> HsObject -> String -> String
[HsObject] -> String -> String
HsObject -> String
(Int -> HsObject -> String -> String)
-> (HsObject -> String)
-> ([HsObject] -> String -> String)
-> Show HsObject
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [HsObject] -> String -> String
$cshowList :: [HsObject] -> String -> String
show :: HsObject -> String
$cshow :: HsObject -> String
showsPrec :: Int -> HsObject -> String -> String
$cshowsPrec :: Int -> HsObject -> String -> String
Show, ReadPrec [HsObject]
ReadPrec HsObject
Int -> ReadS HsObject
ReadS [HsObject]
(Int -> ReadS HsObject)
-> ReadS [HsObject]
-> ReadPrec HsObject
-> ReadPrec [HsObject]
-> Read HsObject
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HsObject]
$creadListPrec :: ReadPrec [HsObject]
readPrec :: ReadPrec HsObject
$creadPrec :: ReadPrec HsObject
readList :: ReadS [HsObject]
$creadList :: ReadS [HsObject]
readsPrec :: Int -> ReadS HsObject
$creadsPrec :: Int -> ReadS HsObject
Read)
type HsObjectMap = Map Ident HsObject
instance Read Ident where
readsPrec :: Int -> ReadS Ident
readsPrec Int
_ (Char
'`':String
lexeme) = let (String
ideChars, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\'') String
lexeme
in
if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ideChars
then []
else [(Position -> String -> Ident
onlyPosIdent Position
nopos String
ideChars, String -> String
forall a. [a] -> [a]
tail String
rest)]
readsPrec Int
p (Char
c:String
cs)
| Char -> Bool
isSpace Char
c = Int -> ReadS Ident
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
cs
readsPrec Int
_ String
_ = []
data GBState = GBState {
GBState -> String
lib :: String,
GBState -> String
prefix :: String,
GBState -> Maybe String
mLock :: Maybe String,
GBState -> [(CHSHook, CHSFrag)]
frags :: [(CHSHook, CHSFrag)],
GBState -> PointerMap
ptrmap :: PointerMap,
GBState -> HsObjectMap
objmap :: HsObjectMap
}
type GB a = CT GBState a
initialGBState :: Maybe String -> GBState
initialGBState :: Maybe String -> GBState
initialGBState Maybe String
mLock = GBState :: String
-> String
-> Maybe String
-> [(CHSHook, CHSFrag)]
-> PointerMap
-> HsObjectMap
-> GBState
GBState {
lib :: String
lib = String
"",
prefix :: String
prefix = String
"",
mLock :: Maybe String
mLock = Maybe String
mLock,
frags :: [(CHSHook, CHSFrag)]
frags = [],
ptrmap :: PointerMap
ptrmap = PointerMap
forall k a. Map k a
Map.empty,
objmap :: HsObjectMap
objmap = HsObjectMap
forall k a. Map k a
Map.empty
}
setContext :: (Maybe String) -> (Maybe String) -> (Maybe String) ->
GB ()
setContext :: Maybe String -> Maybe String -> Maybe String -> GB ()
setContext Maybe String
lib Maybe String
prefix Maybe String
newMLock =
(GBState -> (GBState, ())) -> GB ()
forall s a. (s -> (s, a)) -> CT s a
transCT ((GBState -> (GBState, ())) -> GB ())
-> (GBState -> (GBState, ())) -> GB ()
forall a b. (a -> b) -> a -> b
$ \GBState
state -> (GBState
state {lib :: String
lib = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
lib,
prefix :: String
prefix = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
prefix,
mLock :: Maybe String
mLock = case Maybe String
newMLock of
Maybe String
Nothing -> GBState -> Maybe String
mLock GBState
state
Just String
_ -> Maybe String
newMLock },
())
getLibrary :: GB String
getLibrary :: GB String
getLibrary = (GBState -> String) -> GB String
forall s a. (s -> a) -> CT s a
readCT GBState -> String
lib
getPrefix :: GB String
getPrefix :: GB String
getPrefix = (GBState -> String) -> GB String
forall s a. (s -> a) -> CT s a
readCT GBState -> String
prefix
getLock :: GB (Maybe String)
getLock :: GB (Maybe String)
getLock = (GBState -> Maybe String) -> GB (Maybe String)
forall s a. (s -> a) -> CT s a
readCT GBState -> Maybe String
mLock
delayCode :: CHSHook -> String -> GB ()
delayCode :: CHSHook -> String -> GB ()
delayCode CHSHook
hook String
str =
do
[(CHSHook, CHSFrag)]
frags <- (GBState -> [(CHSHook, CHSFrag)])
-> CT GBState [(CHSHook, CHSFrag)]
forall s a. (s -> a) -> CT s a
readCT GBState -> [(CHSHook, CHSFrag)]
frags
[(CHSHook, CHSFrag)]
frags' <- CHSHook -> [(CHSHook, CHSFrag)] -> CT GBState [(CHSHook, CHSFrag)]
delay CHSHook
hook [(CHSHook, CHSFrag)]
frags
(GBState -> (GBState, ())) -> GB ()
forall s a. (s -> (s, a)) -> CT s a
transCT (\GBState
state -> (GBState
state {frags :: [(CHSHook, CHSFrag)]
frags = [(CHSHook, CHSFrag)]
frags'}, ()))
where
newEntry :: (CHSHook, CHSFrag)
newEntry = (CHSHook
hook, (String -> Position -> CHSFrag
CHSVerb (String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str) (CHSHook -> Position
forall a. Pos a => a -> Position
posOf CHSHook
hook)))
delay :: CHSHook -> [(CHSHook, CHSFrag)] -> CT GBState [(CHSHook, CHSFrag)]
delay hook :: CHSHook
hook@(CHSCall Bool
isFun Bool
isUns Bool
_ Ident
ide Maybe Ident
oalias Position
_) [(CHSHook, CHSFrag)]
frags =
case ((CHSHook, CHSFrag) -> Bool)
-> [(CHSHook, CHSFrag)] -> Maybe (CHSHook, CHSFrag)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(CHSHook
hook', CHSFrag
_) -> CHSHook
hook' CHSHook -> CHSHook -> Bool
forall a. Eq a => a -> a -> Bool
== CHSHook
hook) [(CHSHook, CHSFrag)]
frags of
Just (CHSCall Bool
isFun' Bool
isUns' Bool
_ Ident
ide' Maybe Ident
_ Position
_, CHSFrag
_)
| Bool
isFun Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
isFun'
Bool -> Bool -> Bool
&& Bool
isUns Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
isUns'
Bool -> Bool -> Bool
&& Ident
ide Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
ide' -> [(CHSHook, CHSFrag)] -> CT GBState [(CHSHook, CHSFrag)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(CHSHook, CHSFrag)]
frags
| Bool
otherwise -> Position -> Position -> CT GBState [(CHSHook, CHSFrag)]
forall a. Position -> Position -> GB a
err (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide) (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide')
Maybe (CHSHook, CHSFrag)
Nothing -> [(CHSHook, CHSFrag)] -> CT GBState [(CHSHook, CHSFrag)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(CHSHook, CHSFrag)] -> CT GBState [(CHSHook, CHSFrag)])
-> [(CHSHook, CHSFrag)] -> CT GBState [(CHSHook, CHSFrag)]
forall a b. (a -> b) -> a -> b
$ [(CHSHook, CHSFrag)]
frags [(CHSHook, CHSFrag)]
-> [(CHSHook, CHSFrag)] -> [(CHSHook, CHSFrag)]
forall a. [a] -> [a] -> [a]
++ [(CHSHook, CHSFrag)
newEntry]
delay CHSHook
_ [(CHSHook, CHSFrag)]
_ =
String -> CT GBState [(CHSHook, CHSFrag)]
forall a. String -> a
interr String
"GBMonad.delayCode: Illegal delay!"
err :: Position -> Position -> GB a
err = Position -> Position -> GB a
forall a. Position -> Position -> GB a
incompatibleCallHooksErr
getDelayedCode :: GB [CHSFrag]
getDelayedCode :: GB [CHSFrag]
getDelayedCode = (GBState -> [CHSFrag]) -> GB [CHSFrag]
forall s a. (s -> a) -> CT s a
readCT (((CHSHook, CHSFrag) -> CHSFrag)
-> [(CHSHook, CHSFrag)] -> [CHSFrag]
forall a b. (a -> b) -> [a] -> [b]
map (CHSHook, CHSFrag) -> CHSFrag
forall a b. (a, b) -> b
snd ([(CHSHook, CHSFrag)] -> [CHSFrag])
-> (GBState -> [(CHSHook, CHSFrag)]) -> GBState -> [CHSFrag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GBState -> [(CHSHook, CHSFrag)]
frags)
ptrMapsTo :: (Bool, Ident) -> HsPtrRep -> GB ()
(Bool
isStar, Ident
cName) ptrMapsTo :: (Bool, Ident) -> HsPtrRep -> GB ()
`ptrMapsTo` HsPtrRep
hsRepr =
(GBState -> (GBState, ())) -> GB ()
forall s a. (s -> (s, a)) -> CT s a
transCT (\GBState
state -> (GBState
state {
ptrmap :: PointerMap
ptrmap = (Bool, Ident) -> HsPtrRep -> PointerMap -> PointerMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Bool
isStar, Ident
cName) HsPtrRep
hsRepr (GBState -> PointerMap
ptrmap GBState
state)
}, ()))
queryPtr :: (Bool, Ident) -> GB (Maybe HsPtrRep)
queryPtr :: (Bool, Ident) -> GB (Maybe HsPtrRep)
queryPtr (Bool, Ident)
pcName = do
PointerMap
fm <- (GBState -> PointerMap) -> CT GBState PointerMap
forall s a. (s -> a) -> CT s a
readCT GBState -> PointerMap
ptrmap
Maybe HsPtrRep -> GB (Maybe HsPtrRep)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe HsPtrRep -> GB (Maybe HsPtrRep))
-> Maybe HsPtrRep -> GB (Maybe HsPtrRep)
forall a b. (a -> b) -> a -> b
$ (Bool, Ident) -> PointerMap -> Maybe HsPtrRep
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Bool, Ident)
pcName PointerMap
fm
objIs :: Ident -> HsObject -> GB ()
Ident
hsName objIs :: Ident -> HsObject -> GB ()
`objIs` HsObject
obj =
(GBState -> (GBState, ())) -> GB ()
forall s a. (s -> (s, a)) -> CT s a
transCT (\GBState
state -> (GBState
state {
objmap :: HsObjectMap
objmap = Ident -> HsObject -> HsObjectMap -> HsObjectMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Ident
hsName HsObject
obj (GBState -> HsObjectMap
objmap GBState
state)
}, ()))
queryObj :: Ident -> GB (Maybe HsObject)
queryObj :: Ident -> GB (Maybe HsObject)
queryObj Ident
hsName = do
HsObjectMap
fm <- (GBState -> HsObjectMap) -> CT GBState HsObjectMap
forall s a. (s -> a) -> CT s a
readCT GBState -> HsObjectMap
objmap
Maybe HsObject -> GB (Maybe HsObject)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe HsObject -> GB (Maybe HsObject))
-> Maybe HsObject -> GB (Maybe HsObject)
forall a b. (a -> b) -> a -> b
$ Ident -> HsObjectMap -> Maybe HsObject
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
hsName HsObjectMap
fm
queryClass :: Ident -> GB HsObject
queryClass :: Ident -> GB HsObject
queryClass Ident
hsName = do
let pos :: Position
pos = Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
hsName
Maybe HsObject
oobj <- Ident -> GB (Maybe HsObject)
queryObj Ident
hsName
case Maybe HsObject
oobj of
Just obj :: HsObject
obj@(Class Maybe Ident
_ Ident
_) -> HsObject -> GB HsObject
forall (m :: * -> *) a. Monad m => a -> m a
return HsObject
obj
Just HsObject
_ -> Ident -> GB HsObject
forall a. Ident -> GB a
classExpectedErr Ident
hsName
Maybe HsObject
Nothing -> Ident -> GB HsObject
forall a. Ident -> GB a
hsObjExpectedErr Ident
hsName
queryPointer :: Ident -> GB HsObject
queryPointer :: Ident -> GB HsObject
queryPointer Ident
hsName = do
let pos :: Position
pos = Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
hsName
Maybe HsObject
oobj <- Ident -> GB (Maybe HsObject)
queryObj Ident
hsName
case Maybe HsObject
oobj of
Just obj :: HsObject
obj@(Pointer CHSPtrType
_ Bool
_) -> HsObject -> GB HsObject
forall (m :: * -> *) a. Monad m => a -> m a
return HsObject
obj
Just HsObject
_ -> Ident -> GB HsObject
forall a. Ident -> GB a
pointerExpectedErr Ident
hsName
Maybe HsObject
Nothing -> Ident -> GB HsObject
forall a. Ident -> GB a
hsObjExpectedErr Ident
hsName
mergeMaps :: String -> GB ()
mergeMaps :: String -> GB ()
mergeMaps String
str =
(GBState -> (GBState, ())) -> GB ()
forall s a. (s -> (s, a)) -> CT s a
transCT (\GBState
state -> (GBState
state {
ptrmap :: PointerMap
ptrmap = PointerMap -> PointerMap -> PointerMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (GBState -> PointerMap
ptrmap GBState
state) PointerMap
readPtrMap,
objmap :: HsObjectMap
objmap = HsObjectMap -> HsObjectMap -> HsObjectMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (GBState -> HsObjectMap
objmap GBState
state) HsObjectMap
readObjMap
}, ()))
where
([((Bool, String), HsPtrRep)]
ptrAssoc, [(String, HsObject)]
objAssoc) = String -> ([((Bool, String), HsPtrRep)], [(String, HsObject)])
forall a. Read a => String -> a
read String
str
readPtrMap :: PointerMap
readPtrMap = [((Bool, Ident), HsPtrRep)] -> PointerMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((Bool
isStar, Position -> String -> Ident
onlyPosIdent Position
nopos String
ide), HsPtrRep
repr)
| ((Bool
isStar, String
ide), HsPtrRep
repr) <- [((Bool, String), HsPtrRep)]
ptrAssoc]
readObjMap :: HsObjectMap
readObjMap = [(Ident, HsObject)] -> HsObjectMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Position -> String -> Ident
onlyPosIdent Position
nopos String
ide, HsObject
obj)
| (String
ide, HsObject
obj) <- [(String, HsObject)]
objAssoc]
dumpMaps :: GB String
dumpMaps :: GB String
dumpMaps = do
PointerMap
ptrFM <- (GBState -> PointerMap) -> CT GBState PointerMap
forall s a. (s -> a) -> CT s a
readCT GBState -> PointerMap
ptrmap
HsObjectMap
objFM <- (GBState -> HsObjectMap) -> CT GBState HsObjectMap
forall s a. (s -> a) -> CT s a
readCT GBState -> HsObjectMap
objmap
let dumpable :: ([((Bool, String), HsPtrRep)], [(String, HsObject)])
dumpable = ([((Bool
isStar, TransFun
identToLexeme Ident
ide), HsPtrRep
repr)
| ((Bool
isStar, Ident
ide), HsPtrRep
repr) <- PointerMap -> [((Bool, Ident), HsPtrRep)]
forall k a. Map k a -> [(k, a)]
Map.toList PointerMap
ptrFM],
[(TransFun
identToLexeme Ident
ide, HsObject
obj)
| (Ident
ide, HsObject
obj) <- HsObjectMap -> [(Ident, HsObject)]
forall k a. Map k a -> [(k, a)]
Map.toList HsObjectMap
objFM])
String -> GB String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> GB String) -> String -> GB String
forall a b. (a -> b) -> a -> b
$ ([((Bool, String), HsPtrRep)], [(String, HsObject)]) -> String
forall a. Show a => a -> String
show ([((Bool, String), HsPtrRep)], [(String, HsObject)])
dumpable
incompatibleCallHooksErr :: Position -> Position -> GB a
incompatibleCallHooksErr :: Position -> Position -> GB a
incompatibleCallHooksErr Position
here Position
there =
Position -> [String] -> GB a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc Position
here
[String
"Incompatible call hooks!",
String
"There is a another call hook for the same C function at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Position -> String
forall a. Show a => a -> String
show Position
there,
String
"The flags and C function name of the two hooks should be identical,",
String
"but they are not."]
classExpectedErr :: Ident -> GB a
classExpectedErr :: Ident -> GB a
classExpectedErr Ident
ide =
Position -> [String] -> GB a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide)
[String
"Expected a class name!",
String
"Expected `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TransFun
identToLexeme Ident
ide String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' to refer to a class introduced",
String
"by a class hook."]
pointerExpectedErr :: Ident -> GB a
pointerExpectedErr :: Ident -> GB a
pointerExpectedErr Ident
ide =
Position -> [String] -> GB a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide)
[String
"Expected a pointer name!",
String
"Expected `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TransFun
identToLexeme Ident
ide String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' to be a type name introduced by",
String
"a pointer hook."]
hsObjExpectedErr :: Ident -> GB a
hsObjExpectedErr :: Ident -> GB a
hsObjExpectedErr Ident
ide =
Position -> [String] -> GB a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide)
[String
"Unknown name!",
String
"`" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TransFun
identToLexeme Ident
ide String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' is unknown; it has *not* been defined by",
String
"a previous hook."]