epic thing

gistfile1.txt

Epic/CodegenC.lhs:100:6:
    Could not deduce (Num a0) arising from the ambiguity check for `cg'
    from the context (Num a, MonadState Int m)
      bound by the inferred type for `cg':
                 (Num a, MonadState Int m) => ByteOp -> m [Char]
      at Epic/CodegenC.lhs:(100,6)-(215,64)
    The type variable `a0' is ambiguous
    Possible fix: add a type signature that fixes these type variable(s)
    Note: there are several potential instances:
      instance Num Double -- Defined in `GHC.Float'
      instance Num Float -- Defined in `GHC.Float'
      instance Integral a => Num (GHC.Real.Ratio a)
        -- Defined in `GHC.Real'
      ...plus 47 others
    When checking that `cg'
      has the inferred type `forall (m :: * -> *) a.
                             (Num a, MonadState Int m) =>
                             ByteOp -> m [Char]'
    Probable cause: the inferred type is ambiguous
    In an equation for `compileBody':
        compileBody (Code numlocs args bytecode)
          = let (code, b) = runState (cgs bytecode) 0
            in if (b > 0) then "void** block;" ++ code else code
          where
              sizeneeded x
                = do { max <- get;
                       .... }
              cgs [] = return ""
              cgs (x : xs)
                = do { xc <- cg x;
                       .... }
              cg (CALL t fn args)
                = return $ tmp t ++ " = " ++ quickcall fn ++ targs "(" args ++ ");"
              cg (TAILCALL t fn args)
                = return
                  $ "DROPROOTS; return " ++ quickcall fn ++ targs "(" args ++ ");"
              cg (THUNK t ar fn [])
                = do { return
                       $ tmp t
                         ++
                           " = (void*)CLOSURE(" ++ thunk fn ++ ", " ++ show ar ++ ", 0, 0);" }
              cg (THUNK t ar fn args)
                = do { sizeneeded (length args);
                       .... }
              cg (ADDARGS t th args)
                = do { sizeneeded (length args);
                       .... }
              cg (FOREIGN ty t fn args)
                = return
                  $ castFrom t ty (fn ++ "(" ++ foreignArgs args ++ ")") ++ ";"
              cg (VAR t l) = return $ tmp t ++ " = " ++ loc l ++ ";"
              cg (GROWROOT i) = return $ "GROWROOT;"
              cg (ADDVARROOT l) = return $ "ADDROOT(" ++ loc l ++ ");"
              cg (ADDTMPROOT l) = return $ "ADDROOT(" ++ tmp l ++ ");"
              cg (DROPROOTS i) = return $ "DROPROOTS;"
              cg (ASSIGN l t) = return $ loc l ++ " = " ++ tmp t ++ ";"
              cg (TMPASSIGN t1 t2) = return $ tmp t1 ++ " = " ++ tmp t2 ++ ";"
              cg (NOASSIGN l t)
                = return $ "// " ++ loc l ++ " = " ++ tmp t ++ ";"
              cg (CON t tag args)
                = do { sizeneeded (length args);
                       .... }
              cg (UNIT t) = return $ tmp t ++ " = MKUNIT;"
              cg (UNUSED t) = return $ tmp t ++ " = (void*)(1+42424242*2);"
              cg (INT t i)
                = return $ "ASSIGNINT(" ++ tmp t ++ ", " ++ show i ++ ");"
              cg (BIGINT t i)
                = return $ tmp t ++ " = NEWBIGINT(\"" ++ show i ++ "\");"
              cg (FLOAT t i) = return $ tmp t ++ " = MKFLOAT(" ++ show i ++ ");"
              cg (BIGFLOAT t i)
                = return $ tmp t ++ " = NEWBIGFLOAT(\"" ++ show i ++ "\");"
              cg (STRING t st)
                = return $ "MKSTRm(" ++ tmp t ++ ", " ++ constv st ++ ");"
              cg (PROJ t1 t2 i)
                = return
                  $ tmp t1
                    ++ " = PROJECT((Closure*)" ++ tmp t2 ++ ", " ++ show i ++ ");"
              cg (PROJVAR l t i)
                = return
                  $ loc l
                    ++ " = PROJECT((Closure*)" ++ tmp t ++ ", " ++ show i ++ ");"
              cg (OP t op l r) = return $ doOp t op l r
              cg (LOCALS n) = return $ declare "void* " loc (length args) n
              cg (TMPS n) = return $ declare "void* " tmp 0 n
              cg (CONSTS n) = return $ declareconsts n 0
              cg (LABEL i) = return $ "lbl" ++ show i ++ ":"
              cg (BREAKFALSE t) = return $ "if (!GETINT(" ++ tmp t ++ ")) break;"
              cg (MEMORY alloc r t b)
                = do { bcode <- cgs b;
                       .... }
                where
                    pool FixedPool = "NEWFIXEDPOOL"
                    pool GrowablePool = "NEWGROWABLEPOOL"
                    pool TracePool = "NEWTRACEPOOL"
              cg (WHILE t b)
                = do { tcode <- cgs t;
                       .... }
              cg (WHILEACC t a b)
                = do { tcode <- cgs t;
                       .... }
              cg (JUMP i) = return $ "goto lbl" ++ show i ++ ";"
              cg (JFALSE t i)
                = return
                  $ "assertInt("
                    ++
                      tmp t
                      ++
                        ");" ++ "if (!GETINT(" ++ tmp t ++ ")) goto lbl" ++ show i ++ ";"
              cg (CASE v alts def)
                = do { altscode <- cgalts alts def 0;
                       .... }
              cg (INTCASE v alts def)
                = do { altscode <- cgalts alts def 0;
                       .... }
              cg (IF v t e)
                = do { tcode <- cgs t;
                       .... }
              cg (EVAL v True)
                = return $ tmp v ++ "=(void*)EVAL((VAL)" ++ tmp v ++ ");"
              cg (EVAL v False)
                = return $ tmp v ++ "=(void*)EVAL_NOUP((VAL)" ++ tmp v ++ ");"
              cg (EVALINT v True)
                = return $ tmp v ++ "=(void*)EVALINT((VAL)" ++ tmp v ++ ");"
              cg (EVALINT v False)
                = return $ tmp v ++ "=(void*)EVALINT_NOUP((VAL)" ++ tmp v ++ ");"
              cg (RETURN t) = return $ "DROPROOTS; return " ++ tmp t ++ ";"
              cg DRETURN = return $ "DROPROOTS; return NULL;"
              cg (ERROR s) = return $ "ERROR(" ++ show s ++ ");"
              cg (COMMENT s) = return $ " // " ++ show s
              cg (TRACE s args)
                = return
                  $ "TRACE {\
                    \\tprintf(\"%s\\n\", "
                    ++ show s ++ ");" ++ concat (map dumpClosure args) ++ " }"
                where
                    dumpClosure i
                      = "\tdumpClosure(" ++ loc i ++ "); printf(\"--\\n\");"
              cgalts [] def _
                = case def of {
                    Nothing -> return $ ""
                    (Just bc) -> ... }
              cgalts ((t, bc) : alts) def tag
                = do { bcode <- cgs bc;
                       .... }