public
Created

epic thing

  • Download Gist
gistfile1.txt
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145
 
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;
.... }

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.