Added correct parsing of external calls. External calls are assumed to be
static C calls, but this assumption should always hold since compiling to
External Core will fail for programs that contain any other kind of
external call.
Added correct parsing of the null-pointer literal (0::GHCziPrim.Addrzh) --
this caused an "unknown integer literal type" error before.
{
module ParserCore ( parseCore ) where
{
module ParserCore ( parseCore ) where
import HsCore
import RdrHsSyn
import HsSyn
import HsCore
import RdrHsSyn
import HsSyn
"InlineCall" -> UfNote UfInlineCall $3
"InlineMe" -> UfNote UfInlineMe $3
}
"InlineCall" -> UfNote UfInlineCall $3
"InlineMe" -> UfNote UfInlineMe $3
}
--- | '%external' STRING aty { External $2 $3 }
-
+ | '%external' STRING aty { UfFCall (ForeignCall.CCall
+ (CCallSpec (StaticTarget
+ (mkFastString $2))
+ CCallConv (PlaySafe False))) $3 }
alts1 :: { [UfAlt RdrName] }
: alt { [$1] }
| alt ';' alts1 { $1:$3 }
alts1 :: { [UfAlt RdrName] }
: alt { [$1] }
| alt ';' alts1 { $1:$3 }
| n == intPrimRdrName = MachInt i
| n == wordPrimRdrName = MachWord i
| n == charPrimRdrName = MachChar (fromInteger i)
| n == intPrimRdrName = MachInt i
| n == wordPrimRdrName = MachWord i
| n == charPrimRdrName = MachChar (fromInteger i)
+ | n == addrPrimRdrName && i == 0 = MachNullAddr
convIntLit i aty
= pprPanic "Unknown integer literal type" (ppr aty $$ ppr intPrimRdrName)
convIntLit i aty
= pprPanic "Unknown integer literal type" (ppr aty $$ ppr intPrimRdrName)
= pprPanic "Unknown rational literal type" (ppr aty $$ ppr intPrimRdrName)
= pprPanic "Unknown rational literal type" (ppr aty $$ ppr intPrimRdrName)
-wordPrimRdrName, intPrimRdrName, floatPrimRdrName, doublePrimRdrName :: RdrName
+wordPrimRdrName, intPrimRdrName, floatPrimRdrName, doublePrimRdrName, addrPrimRdrName :: RdrName
wordPrimRdrName = nameRdrName wordPrimTyConName
intPrimRdrName = nameRdrName intPrimTyConName
charPrimRdrName = nameRdrName charPrimTyConName
floatPrimRdrName = nameRdrName floatPrimTyConName
doublePrimRdrName = nameRdrName doublePrimTyConName
wordPrimRdrName = nameRdrName wordPrimTyConName
intPrimRdrName = nameRdrName intPrimTyConName
charPrimRdrName = nameRdrName charPrimTyConName
floatPrimRdrName = nameRdrName floatPrimTyConName
doublePrimRdrName = nameRdrName doublePrimTyConName
+addrPrimRdrName = nameRdrName addrPrimTyConName
happyError :: P a
happyError s l = failP (show l ++ ": Parse error\n") (take 100 s) l
happyError :: P a
happyError s l = failP (show l ++ ": Parse error\n") (take 100 s) l