add some {-# LANGUAGE BangPatterns #-} to mollify GHC
[ghc-hetmet.git] / compiler / cmm / CmmParse.y
index ad388e5..f22977f 100644 (file)
@@ -8,7 +8,10 @@
 --
 -----------------------------------------------------------------------------
 
+-- TODO: Add support for interruptible/uninterruptible foreign call specification
+
 {
+{-# LANGUAGE BangPatterns #-} -- required for versions of Happy before 1.18.6
 {-# OPTIONS -Wwarn -w -XNoMonomorphismRestriction #-}
 -- The NoMonomorphismRestriction deals with a Happy infelicity
 --    With OutsideIn's more conservativ monomorphism restriction
@@ -409,7 +412,7 @@ stmt        :: { ExtCode }
         | 'return' maybe_actuals ';'
                { do e <- sequence $2; stmtEC (CmmReturn e) }
        | 'if' bool_expr '{' body '}' else      
-               { ifThenElse $2 $4 $6 }
+               { cmmIfThenElse $2 $4 $6 }
 
 opt_never_returns :: { CmmReturnInfo }
         :                               { CmmMayReturn }
@@ -734,6 +737,7 @@ callishMachOps = listToUFM $
 parseSafety :: String -> P CmmSafety
 parseSafety "safe"   = return (CmmSafe NoC_SRT)
 parseSafety "unsafe" = return CmmUnsafe
+parseSafety "interruptible" = return CmmInterruptible
 parseSafety str      = fail ("unrecognised safety: " ++ str)
 
 parseCmmHint :: String -> P ForeignHint
@@ -864,6 +868,9 @@ foreignCall conv_string results_code expr_code args_code vols safety ret
                 code (emitForeignCall' (PlaySafe unused) results 
                    (CmmCallee expr' convention) args vols NoC_SRT ret) where
                unused = panic "not used by emitForeignCall'"
+              CmmInterruptible ->
+                code (emitForeignCall' PlayInterruptible results 
+                   (CmmCallee expr' convention) args vols NoC_SRT ret)
 
 adjCallTarget :: CCallConv -> CmmExpr -> [CmmHinted CmmExpr] -> CmmExpr
 #ifdef mingw32_TARGET_OS
@@ -898,6 +905,9 @@ primCall results_code name args_code vols safety
                    code (emitForeignCall' (PlaySafe unused) results 
                      (CmmPrim p) args vols NoC_SRT CmmMayReturn) where
                    unused = panic "not used by emitForeignCall'"
+                 CmmInterruptible ->
+                   code (emitForeignCall' PlayInterruptible results 
+                     (CmmPrim p) args vols NoC_SRT CmmMayReturn)
 
 doStore :: CmmType -> ExtFCode CmmExpr  -> ExtFCode CmmExpr -> ExtCode
 doStore rep addr_code val_code
@@ -938,7 +948,7 @@ data BoolExpr
 
 -- ToDo: smart constructors which simplify the boolean expression.
 
-ifThenElse cond then_part else_part = do
+cmmIfThenElse cond then_part else_part = do
      then_id <- code newLabelC
      join_id <- code newLabelC
      c <- cond