Skip to content

@cartazio /gist:3364775
Created

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
epic thing
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;
.... }
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.