[project @ 2003-08-19 22:04:54 by krc]
[ghc-hetmet.git] / ghc / compiler / parser / ParserCore.y
index af591fa..dd438b1 100644 (file)
@@ -1,6 +1,8 @@
 {
 module ParserCore ( parseCore ) where
 
+import ForeignCall
+
 import HsCore
 import RdrHsSyn
 import HsSyn
@@ -68,7 +70,7 @@ import Outputable
 
 module :: { RdrNameHsModule }
        : '%module' modid tdefs vdefgs
-               { HsModule (mkHomeModule $2) Nothing Nothing 
+               { HsModule (Just (mkHomeModule $2)) Nothing 
                           [] ($3 ++ concat $4) Nothing noSrcLoc}
 
 tdefs  :: { [RdrNameHsDecl] }
@@ -199,8 +201,10 @@ exp        :: { UfExpr RdrName }
               "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 }
@@ -263,6 +267,8 @@ convIntLit :: Integer -> RdrNameHsType -> Literal
 convIntLit i (HsTyVar n)
   | 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) 
 
@@ -274,11 +280,13 @@ convRatLit i aty
   = 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
+addrPrimRdrName   = nameRdrName addrPrimTyConName
 
 happyError :: P a 
 happyError s l = failP (show l ++ ": Parse error\n") (take 100 s) l