X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=utils%2Fext-core%2FInterp.hs;h=2c3f65e41ecf3de536b5a15852686d3debd4e70b;hp=3f07922ac04e740f97364ae0049e0ad9fa21d87a;hb=8bfeb25ae78e99c7014113468b0057342db4208f;hpb=c287bea94592fffe63f85831ab651c28d64e4d6e

diff --git a/utils/ext-core/Interp.hs b/utils/ext-core/Interp.hs
index 3f07922..2c3f65e 100644
--- a/utils/ext-core/Interp.hs
+++ b/utils/ext-core/Interp.hs
@@ -437,6 +437,7 @@ evalPrimop "negateIntzh" = primIntUnop     (\ i -> -i)
 evalPrimop "quotIntzh"   = primIntBinop    quot
 evalPrimop "remIntzh"    = primIntBinop    rem
 evalPrimop "subIntCzh"   = primSubIntC
+evalPrimop "addIntCzh"   = primAddIntC
 evalPrimop "mulIntMayOflozh" = primIntBinop
   (\ i j ->
      case (fromIntegral i, fromIntegral j) of
@@ -489,14 +490,20 @@ primCharCmpOp op [Vimm (PCharzh c), Vimm (PCharzh d)] = mkBool (c `op` d)
 primCharCmpOp _ _ = error "primCharCmpOp: wrong number of arguments"
 
 primSubIntC :: [Value] -> Eval Value
-primSubIntC [Vimm (PIntzh i1), Vimm (PIntzh i2)] =
+primSubIntC vs = carryOp subIntC# vs
+
+primAddIntC :: [Value] -> Eval Value
+primAddIntC vs = carryOp addIntC# vs
+
+carryOp :: (Int# -> Int# -> (# Int#, Int# #)) -> [Value] -> Eval Value
+carryOp op [Vimm (PIntzh i1), Vimm (PIntzh i2)] =
   case (fromIntegral i1, fromIntegral i2) of
     (I# int1, I# int2) -> 
-       case (int1 `subIntC#` int2) of
+       case (int1 `op` int2) of
         (# res1, res2 #) -> 
            return $ Vutuple [Vimm (PIntzh (fromIntegral (I# res1))),
                              Vimm (PIntzh (fromIntegral (I# res2)))]
-primSubIntC _ = error "primSubIntC: wrong number of arguments"
+carryOp _ _ = error "carryOp: wrong number of arguments"
 
 primInt2Double :: [Value] -> Eval Value
 primInt2Double [Vimm (PIntzh i)] =