git.iko.soy/Idris-dev
on ace080c help sign in
Idris-dev/src/IRTS/CodegenC.hs
470 lines 23 kB history raw
1module IRTS.CodegenC (codegenC) where
3import Idris.AbsSyntax
4import IRTS.Bytecode
5import IRTS.Lang
6import IRTS.Simplified
7import IRTS.CodegenCommon
8import Core.TT
9import Paths_idris
10import Util.System
12import Data.Char
13import System.Process
14import System.Exit
15import System.IO
16import System.Directory
17import System.FilePath ((</>), (<.>))
18import Control.Monad
20codegenC :: [(Name, SDecl)] ->
21 String -> -- output file name
22 OutputType -> -- generate executable if True, only .o if False
23 [FilePath] -> -- include files
24 String -> -- extra object files
25 String -> -- extra compiler flags
26 DbgLevel ->
27 IO ()
28codegenC defs out exec incs objs libs dbg
29 = do -- print defs
30 let bc = map toBC defs
31 let h = concatMap toDecl (map fst bc)
32 let cc = concatMap (uncurry toC) bc
33 d <- getDataDir
34 mprog <- readFile (d </> "rts" </> "idris_main" <.> "c")
35 let cout = headers incs ++ debug dbg ++ h ++ cc ++
36 (if (exec == Executable) then mprog else "")
37 case exec of
38 Raw -> writeFile out cout
39 _ -> do
40 (tmpn, tmph) <- tempfile
41 hPutStr tmph cout
42 hFlush tmph
43 hClose tmph
44 let useclang = False
45 comp <- getCC
46 libFlags <- getLibFlags
47 incFlags <- getIncFlags
48 let gcc = comp ++ " " ++
49 gccDbg dbg ++
50 " -I. " ++ objs ++ " -x c " ++
51 (if (exec == Executable) then "" else " -c ") ++
52 " " ++ tmpn ++
53 " " ++ libFlags ++
54 " " ++ incFlags ++
55 " " ++ libs ++
56 " -o " ++ out
57-- putStrLn gcc
58 exit <- system gcc
59 when (exit /= ExitSuccess) $
60 putStrLn ("FAILURE: " ++ gcc)
62headers xs =
63 concatMap
64 (\h -> "#include <" ++ h ++ ">\n")
65 (xs ++ ["idris_rts.h", "idris_bitstring.h", "idris_stdfgn.h", "gmp.h", "assert.h"])
67debug TRACE = "#define IDRIS_TRACE\n\n"
68debug _ = ""
70gccDbg DEBUG = "-g"
71gccDbg TRACE = "-O2"
72gccDbg _ = "-O2"
74cname :: Name -> String
75cname n = "_idris_" ++ concatMap cchar (show n)
76 where cchar x | isAlpha x || isDigit x = [x]
77 | otherwise = "_" ++ show (fromEnum x) ++ "_"
79indent :: Int -> String
80indent n = replicate (n*4) ' '
82creg RVal = "RVAL"
83creg (L i) = "LOC(" ++ show i ++ ")"
84creg (T i) = "TOP(" ++ show i ++ ")"
85creg Tmp = "REG1"
87toDecl :: Name -> String
88toDecl f = "void " ++ cname f ++ "(VM*, VAL*);\n"
90toC :: Name -> [BC] -> String
91toC f code
92 = -- "/* " ++ show code ++ "*/\n\n" ++
93 "void " ++ cname f ++ "(VM* vm, VAL* oldbase) {\n" ++
94 indent 1 ++ "INITFRAME;\n" ++
95 concatMap (bcc 1) code ++ "}\n\n"
97bcc :: Int -> BC -> String
98bcc i (ASSIGN l r) = indent i ++ creg l ++ " = " ++ creg r ++ ";\n"
99bcc i (ASSIGNCONST l c)
100 = indent i ++ creg l ++ " = " ++ mkConst c ++ ";\n"
101 where
102 mkConst (I i) = "MKINT(" ++ show i ++ ")"
103 mkConst (BI i) | i < (2^30) = "MKINT(" ++ show i ++ ")"
104 | otherwise = "MKBIGC(vm,\"" ++ show i ++ "\")"
105 mkConst (Fl f) = "MKFLOAT(vm, " ++ show f ++ ")"
106 mkConst (Ch c) = "MKINT(" ++ show (fromEnum c) ++ ")"
107 mkConst (Str s) = "MKSTR(vm, " ++ show s ++ ")"
108 mkConst (B8 b) = "MKB8(vm, " ++ show b ++")"
109 mkConst (B16 b) = "MKB16(vm, " ++ show b ++ ")"
110 mkConst (B32 b) = "MKB32(vm, " ++ show b ++ ")"
111 mkConst (B64 b) = "MKB64(vm, " ++ show b ++ ")"
112 mkConst _ = "MKINT(42424242)"
113bcc i (UPDATE l r) = indent i ++ creg l ++ " = " ++ creg r ++ ";\n"
114bcc i (MKCON l tag args)
115 = indent i ++ "allocCon(" ++ creg Tmp ++ ", vm, " ++ show tag ++ "," ++
116 show (length args) ++ ", 0);\n" ++
117 indent i ++ setArgs 0 args ++ "\n" ++
118 indent i ++ creg l ++ " = " ++ creg Tmp ++ ";\n"
120-- "MKCON(vm, " ++ creg l ++ ", " ++ show tag ++ ", " ++
121-- show (length args) ++ concatMap showArg args ++ ");\n"
122 where showArg r = ", " ++ creg r
123 setArgs i [] = ""
124 setArgs i (x : xs) = "SETARG(" ++ creg Tmp ++ ", " ++ show i ++ ", " ++ creg x ++
125 "); " ++ setArgs (i + 1) xs
127bcc i (PROJECT l loc a) = indent i ++ "PROJECT(vm, " ++ creg l ++ ", " ++ show loc ++
128 ", " ++ show a ++ ");\n"
129bcc i (PROJECTINTO r t idx)
130 = indent i ++ creg r ++ " = GETARG(" ++ creg t ++ ", " ++ show idx ++ ");\n"
131bcc i (CASE True r code def)
132 | length code < 4 = showCase i def code
133 where
134 showCode :: Int -> [BC] -> String
135 showCode i bc = "{\n" ++ indent i ++ concatMap (bcc (i + 1)) bc ++
136 indent i ++ "}\n"
138 showCase :: Int -> Maybe [BC] -> [(Int, [BC])] -> String
139 showCase i Nothing [(t, c)] = showCode i c
140 showCase i (Just def) [] = showCode i def
141 showCase i def ((t, c) : cs)
142 = "if (CTAG(" ++ creg r ++ ") == " ++ show t ++ ") " ++ showCode i c
143 ++ "else " ++ showCase i def cs
145bcc i (CASE safe r code def)
146 = indent i ++ "switch(" ++ ctag safe ++ "(" ++ creg r ++ ")) {\n" ++
147 concatMap (showCase i) code ++
148 showDef i def ++
149 indent i ++ "}\n"
150 where
151 ctag True = "CTAG"
152 ctag False = "TAG"
154 showCase i (t, bc) = indent i ++ "case " ++ show t ++ ":\n"
155 ++ concatMap (bcc (i+1)) bc ++ indent (i + 1) ++ "break;\n"
156 showDef i Nothing = ""
157 showDef i (Just c) = indent i ++ "default:\n"
158 ++ concatMap (bcc (i+1)) c ++ indent (i + 1) ++ "break;\n"
159bcc i (CONSTCASE r code def)
160 | intConsts code
161-- = indent i ++ "switch(GETINT(" ++ creg r ++ ")) {\n" ++
162-- concatMap (showCase i) code ++
163-- showDef i def ++
164-- indent i ++ "}\n"
165 = concatMap (iCase (creg r)) code ++
166 indent i ++ "{\n" ++ showDefS i def ++ indent i ++ "}\n"
167 | strConsts code
168 = concatMap (strCase ("GETSTR(" ++ creg r ++ ")")) code ++
169 indent i ++ "{\n" ++ showDefS i def ++ indent i ++ "}\n"
170 | bigintConsts code
171 = concatMap (biCase (creg r)) code ++
172 indent i ++ "{\n" ++ showDefS i def ++ indent i ++ "}\n"
173 | otherwise = error $ "Can't happen: Can't compile const case " ++ show code
174 where
175 intConsts ((I _, _ ) : _) = True
176 intConsts ((Ch _, _ ) : _) = True
177 intConsts _ = False
179 bigintConsts ((BI _, _ ) : _) = True
180 bigintConsts _ = False
182 strConsts ((Str _, _ ) : _) = True
183 strConsts _ = False
185 strCase sv (s, bc) =
186 indent i ++ "if (strcmp(" ++ sv ++ ", " ++ show s ++ ") == 0) {\n" ++
187 concatMap (bcc (i+1)) bc ++ indent i ++ "} else\n"
188 biCase bv (BI b, bc) =
189 indent i ++ "if (bigEqConst(" ++ bv ++ ", " ++ show b ++ ")) {\n"
190 ++ concatMap (bcc (i+1)) bc ++ indent i ++ "} else\n"
191 iCase v (I b, bc) =
192 indent i ++ "if (GETINT(" ++ v ++ ") == " ++ show b ++ ") {\n"
193 ++ concatMap (bcc (i+1)) bc ++ indent i ++ "} else\n"
194 iCase v (Ch b, bc) =
195 indent i ++ "if (GETINT(" ++ v ++ ") == " ++ show b ++ ") {\n"
196 ++ concatMap (bcc (i+1)) bc ++ indent i ++ "} else\n"
198 showCase i (t, bc) = indent i ++ "case " ++ show t ++ ":\n"
199 ++ concatMap (bcc (i+1)) bc ++
200 indent (i + 1) ++ "break;\n"
201 showDef i Nothing = ""
202 showDef i (Just c) = indent i ++ "default:\n"
203 ++ concatMap (bcc (i+1)) c ++
204 indent (i + 1) ++ "break;\n"
205 showDefS i Nothing = ""
206 showDefS i (Just c) = concatMap (bcc (i+1)) c
208bcc i (CALL n) = indent i ++ "CALL(" ++ cname n ++ ");\n"
209bcc i (TAILCALL n) = indent i ++ "TAILCALL(" ++ cname n ++ ");\n"
210bcc i (SLIDE n) = indent i ++ "SLIDE(vm, " ++ show n ++ ");\n"
211bcc i REBASE = indent i ++ "REBASE;\n"
212bcc i (RESERVE 0) = ""
213bcc i (RESERVE n) = indent i ++ "RESERVE(" ++ show n ++ ");\n"
214bcc i (ADDTOP 0) = ""
215bcc i (ADDTOP n) = indent i ++ "ADDTOP(" ++ show n ++ ");\n"
216bcc i (TOPBASE n) = indent i ++ "TOPBASE(" ++ show n ++ ");\n"
217bcc i (BASETOP n) = indent i ++ "BASETOP(" ++ show n ++ ");\n"
218bcc i STOREOLD = indent i ++ "STOREOLD;\n"
219bcc i (OP l fn args) = indent i ++ doOp (creg l ++ " = ") fn args ++ ";\n"
220bcc i (FOREIGNCALL l LANG_C rty fn args)
221 = indent i ++
222 c_irts rty (creg l ++ " = ")
223 (fn ++ "(" ++ showSep "," (map fcall args) ++ ")") ++ ";\n"
224 where fcall (t, arg) = irts_c t (creg arg)
225bcc i (NULL r) = indent i ++ creg r ++ " = NULL;\n" -- clear, so it'll be GCed
226bcc i (ERROR str) = indent i ++ "fprintf(stderr, " ++ show str ++ "); assert(0); exit(-1);"
227-- bcc i _ = indent i ++ "// not done yet\n"
229c_irts FInt l x = l ++ "MKINT((i_int)(" ++ x ++ "))"
230c_irts FChar l x = l ++ "MKINT((i_int)(" ++ x ++ "))"
231c_irts FString l x = l ++ "MKSTR(vm, " ++ x ++ ")"
232c_irts FUnit l x = x
233c_irts FPtr l x = l ++ "MKPTR(vm, " ++ x ++ ")"
234c_irts FDouble l x = l ++ "MKFLOAT(vm, " ++ x ++ ")"
235c_irts FAny l x = l ++ x
237irts_c FInt x = "GETINT(" ++ x ++ ")"
238irts_c FChar x = "GETINT(" ++ x ++ ")"
239irts_c FString x = "GETSTR(" ++ x ++ ")"
240irts_c FUnit x = x
241irts_c FPtr x = "GETPTR(" ++ x ++ ")"
242irts_c FDouble x = "GETFLOAT(" ++ x ++ ")"
243irts_c FAny x = x
245doOp v LPlus [l, r] = v ++ "ADD(" ++ creg l ++ ", " ++ creg r ++ ")"
246doOp v LMinus [l, r] = v ++ "INTOP(-," ++ creg l ++ ", " ++ creg r ++ ")"
247doOp v LTimes [l, r] = v ++ "MULT(" ++ creg l ++ ", " ++ creg r ++ ")"
248doOp v LDiv [l, r] = v ++ "INTOP(/," ++ creg l ++ ", " ++ creg r ++ ")"
249doOp v LMod [l, r] = v ++ "INTOP(%," ++ creg l ++ ", " ++ creg r ++ ")"
250doOp v LAnd [l, r] = v ++ "INTOP(&," ++ creg l ++ ", " ++ creg r ++ ")"
251doOp v LOr [l, r] = v ++ "INTOP(|," ++ creg l ++ ", " ++ creg r ++ ")"
252doOp v LXOr [l, r] = v ++ "INTOP(^," ++ creg l ++ ", " ++ creg r ++ ")"
253doOp v LSHL [l, r] = v ++ "INTOP(<<," ++ creg l ++ ", " ++ creg r ++ ")"
254doOp v LSHR [l, r] = v ++ "INTOP(>>," ++ creg l ++ ", " ++ creg r ++ ")"
255doOp v LCompl [x] = v ++ "INTOP(~," ++ creg x ++ ")"
256doOp v LEq [l, r] = v ++ "INTOP(==," ++ creg l ++ ", " ++ creg r ++ ")"
257doOp v LLt [l, r] = v ++ "INTOP(<," ++ creg l ++ ", " ++ creg r ++ ")"
258doOp v LLe [l, r] = v ++ "INTOP(<=," ++ creg l ++ ", " ++ creg r ++ ")"
259doOp v LGt [l, r] = v ++ "INTOP(>," ++ creg l ++ ", " ++ creg r ++ ")"
260doOp v LGe [l, r] = v ++ "INTOP(>=," ++ creg l ++ ", " ++ creg r ++ ")"
262doOp v LFPlus [l, r] = v ++ "FLOATOP(+," ++ creg l ++ ", " ++ creg r ++ ")"
263doOp v LFMinus [l, r] = v ++ "FLOATOP(-," ++ creg l ++ ", " ++ creg r ++ ")"
264doOp v LFTimes [l, r] = v ++ "FLOATOP(*," ++ creg l ++ ", " ++ creg r ++ ")"
265doOp v LFDiv [l, r] = v ++ "FLOATOP(/," ++ creg l ++ ", " ++ creg r ++ ")"
266doOp v LFEq [l, r] = v ++ "FLOATBOP(==," ++ creg l ++ ", " ++ creg r ++ ")"
267doOp v LFLt [l, r] = v ++ "FLOATBOP(<," ++ creg l ++ ", " ++ creg r ++ ")"
268doOp v LFLe [l, r] = v ++ "FLOATBOP(<=," ++ creg l ++ ", " ++ creg r ++ ")"
269doOp v LFGt [l, r] = v ++ "FLOATBOP(>," ++ creg l ++ ", " ++ creg r ++ ")"
270doOp v LFGe [l, r] = v ++ "FLOATBOP(>=," ++ creg l ++ ", " ++ creg r ++ ")"
272doOp v LBPlus [l, r] = v ++ "idris_bigPlus(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
273doOp v LBMinus [l, r] = v ++ "idris_bigMinus(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
274doOp v LBDec [l] = v ++ "idris_bigMinus(vm, " ++ creg l ++ ", MKINT(1))"
275doOp v LBTimes [l, r] = v ++ "idris_bigTimes(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
276doOp v LBDiv [l, r] = v ++ "idris_bigDivide(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
277doOp v LBMod [l, r] = v ++ "idris_bigMod(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
278doOp v LBEq [l, r] = v ++ "idris_bigEq(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
279doOp v LBLt [l, r] = v ++ "idris_bigLt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
280doOp v LBLe [l, r] = v ++ "idris_bigLe(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
281doOp v LBGt [l, r] = v ++ "idris_bigGt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
282doOp v LBGe [l, r] = v ++ "idris_bigGe(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
284doOp v LStrConcat [l,r] = v ++ "idris_concat(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
285doOp v LStrLt [l,r] = v ++ "idris_strlt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
286doOp v LStrEq [l,r] = v ++ "idris_streq(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
287doOp v LStrLen [x] = v ++ "idris_strlen(vm, " ++ creg x ++ ")"
289doOp v LIntFloat [x] = v ++ "idris_castIntFloat(" ++ creg x ++ ")"
290doOp v LFloatInt [x] = v ++ "idris_castFloatInt(" ++ creg x ++ ")"
291doOp v LIntStr [x] = v ++ "idris_castIntStr(vm, " ++ creg x ++ ")"
292doOp v LStrInt [x] = v ++ "idris_castStrInt(vm, " ++ creg x ++ ")"
293doOp v LIntBig [x] = v ++ "idris_castIntBig(vm, " ++ creg x ++ ")"
294doOp v LBigInt [x] = v ++ "idris_castBigInt(vm, " ++ creg x ++ ")"
295doOp v LStrBig [x] = v ++ "idris_castStrBig(vm, " ++ creg x ++ ")"
296doOp v LBigStr [x] = v ++ "idris_castBigStr(vm, " ++ creg x ++ ")"
297doOp v LFloatStr [x] = v ++ "idris_castFloatStr(vm, " ++ creg x ++ ")"
298doOp v LStrFloat [x] = v ++ "idris_castStrFloat(vm, " ++ creg x ++ ")"
300doOp v LReadStr [x] = v ++ "idris_readStr(vm, GETPTR(" ++ creg x ++ "))"
301doOp _ LPrintNum [x] = "printf(\"%ld\\n\", GETINT(" ++ creg x ++ "))"
302doOp _ LPrintStr [x] = "fputs(GETSTR(" ++ creg x ++ "), stdout)"
304doOp v LIntB8 [x] = v ++ "idris_b8(vm, " ++ creg x ++ ")"
305doOp v LIntB16 [x] = v ++ "idris_b16(vm, " ++ creg x ++ ")"
306doOp v LIntB32 [x] = v ++ "idris_b32(vm, " ++ creg x ++ ")"
307doOp v LIntB64 [x] = v ++ "idris_b64(vm, " ++ creg x ++ ")"
309doOp v LB32Int [x] = v ++ "idris_castB32Int(vm, " ++ creg x ++ ")"
311doOp v LB8Lt [x, y] = v ++ "idris_b8Lt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
312doOp v LB8Lte [x, y] = v ++ "idris_b8Lte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
313doOp v LB8Eq [x, y] = v ++ "idris_b8Eq(vm, " ++ creg x ++ "," ++ creg y ++ ")"
314doOp v LB8Gte [x, y] = v ++ "idris_b8Gte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
315doOp v LB8Gt [x, y] = v ++ "idris_b8Gt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
317doOp v LB8Shl [x, y] = v ++ "idris_b8Shl(vm, " ++ creg x ++ "," ++ creg y ++ ")"
318doOp v LB8LShr [x, y] = v ++ "idris_b8Shr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
319doOp v LB8AShr [x, y] = v ++ "idris_b8AShr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
320doOp v LB8And [x, y] = v ++ "idris_b8And(vm, " ++ creg x ++ "," ++ creg y ++ ")"
321doOp v LB8Or [x, y] = v ++ "idris_b8Or(vm, " ++ creg x ++ "," ++ creg y ++ ")"
322doOp v LB8Xor [x, y] = v ++ "idris_b8Xor(vm, " ++ creg x ++ "," ++ creg y ++ ")"
323doOp v LB8Compl [x] = v ++ "idris_b8Compl(vm, " ++ creg x ++ ")"
325doOp v LB8Plus [x, y] = v ++ "idris_b8Plus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
326doOp v LB8Minus [x, y] = v ++ "idris_b8Minus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
327doOp v LB8Times [x, y] = v ++ "idris_b8Times(vm, " ++ creg x ++ "," ++ creg y ++ ")"
328doOp v LB8UDiv [x, y] = v ++ "idris_b8UDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
329doOp v LB8SDiv [x, y] = v ++ "idris_b8SDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
330doOp v LB8URem [x, y] = v ++ "idris_b8URem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
331doOp v LB8SRem [x, y] = v ++ "idris_b8SRem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
333doOp v LB8Z16 [x] = v ++ "idris_b8Z16(vm, " ++ creg x ++ ")"
334doOp v LB8Z32 [x] = v ++ "idris_b8Z32(vm, " ++ creg x ++ ")"
335doOp v LB8Z64 [x] = v ++ "idris_b8Z64(vm, " ++ creg x ++ ")"
336doOp v LB8S16 [x] = v ++ "idris_b8S16(vm, " ++ creg x ++ ")"
337doOp v LB8S32 [x] = v ++ "idris_b8S32(vm, " ++ creg x ++ ")"
338doOp v LB8S64 [x] = v ++ "idris_b8S64(vm, " ++ creg x ++ ")"
340doOp v LB16Lt [x, y] = v ++ "idris_b16Lt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
341doOp v LB16Lte [x, y] = v ++ "idris_b16Lte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
342doOp v LB16Eq [x, y] = v ++ "idris_b16Eq(vm, " ++ creg x ++ "," ++ creg y ++ ")"
343doOp v LB16Gte [x, y] = v ++ "idris_b16Gte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
344doOp v LB16Gt [x, y] = v ++ "idris_b16Gt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
346doOp v LB16Shl [x, y] = v ++ "idris_b16Shl(vm, " ++ creg x ++ "," ++ creg y ++ ")"
347doOp v LB16LShr [x, y] = v ++ "idris_b16Shr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
348doOp v LB16AShr [x, y] = v ++ "idris_b16AShr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
349doOp v LB16And [x, y] = v ++ "idris_b16And(vm, " ++ creg x ++ "," ++ creg y ++ ")"
350doOp v LB16Or [x, y] = v ++ "idris_b16Or(vm, " ++ creg x ++ "," ++ creg y ++ ")"
351doOp v LB16Xor [x, y] = v ++ "idris_b16Xor(vm, " ++ creg x ++ "," ++ creg y ++ ")"
352doOp v LB16Compl [x] = v ++ "idris_b16Compl(vm, " ++ creg x ++ ")"
354doOp v LB16Plus [x, y] =
355 v ++ "idris_b16Plus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
356doOp v LB16Minus [x, y] =
357 v ++ "idris_b16Minus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
358doOp v LB16Times [x, y] =
359 v ++ "idris_b16Times(vm, " ++ creg x ++ "," ++ creg y ++ ")"
360doOp v LB16UDiv [x, y] =
361 v ++ "idris_b16UDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
362doOp v LB16SDiv [x, y] =
363 v ++ "idris_b16SDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
364doOp v LB16URem [x, y] =
365 v ++ "idris_b16URem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
366doOp v LB16SRem [x, y] =
367 v ++ "idris_b16SRem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
369doOp v LB16Z32 [x] = v ++ "idris_b16Z32(vm, " ++ creg x ++ ")"
370doOp v LB16Z64 [x] = v ++ "idris_b16Z64(vm, " ++ creg x ++ ")"
371doOp v LB16S32 [x] = v ++ "idris_b16S32(vm, " ++ creg x ++ ")"
372doOp v LB16S64 [x] = v ++ "idris_b16S64(vm, " ++ creg x ++ ")"
373doOp v LB16T8 [x] = v ++ "idris_b16T8(vm, " ++ creg x ++ ")"
375doOp v LB32Lt [x, y] = v ++ "idris_b32Lt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
376doOp v LB32Lte [x, y] = v ++ "idris_b32Lte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
377doOp v LB32Eq [x, y] = v ++ "idris_b32Eq(vm, " ++ creg x ++ "," ++ creg y ++ ")"
378doOp v LB32Gte [x, y] = v ++ "idris_b32Gte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
379doOp v LB32Gt [x, y] = v ++ "idris_b32Gt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
381doOp v LB32Shl [x, y] = v ++ "idris_b32Shl(vm, " ++ creg x ++ "," ++ creg y ++ ")"
382doOp v LB32LShr [x, y] = v ++ "idris_b32Shr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
383doOp v LB32AShr [x, y] = v ++ "idris_b32AShr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
384doOp v LB32And [x, y] = v ++ "idris_b32And(vm, " ++ creg x ++ "," ++ creg y ++ ")"
385doOp v LB32Or [x, y] = v ++ "idris_b32Or(vm, " ++ creg x ++ "," ++ creg y ++ ")"
386doOp v LB32Xor [x, y] = v ++ "idris_b32Xor(vm, " ++ creg x ++ "," ++ creg y ++ ")"
387doOp v LB32Compl [x] = v ++ "idris_b32Compl(vm, " ++ creg x ++ ")"
389doOp v LB32Plus [x, y] =
390 v ++ "idris_b32Plus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
391doOp v LB32Minus [x, y] =
392 v ++ "idris_b32Minus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
393doOp v LB32Times [x, y] =
394 v ++ "idris_b32Times(vm, " ++ creg x ++ "," ++ creg y ++ ")"
395doOp v LB32UDiv [x, y] =
396 v ++ "idris_b32UDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
397doOp v LB32SDiv [x, y] =
398 v ++ "idris_b32SDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
399doOp v LB32URem [x, y] =
400 v ++ "idris_b32URem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
401doOp v LB32SRem [x, y] =
402 v ++ "idris_b32SRem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
404doOp v LB32Z64 [x] = v ++ "idris_b32Z64(vm, " ++ creg x ++ ")"
405doOp v LB32S64 [x] = v ++ "idris_b32S64(vm, " ++ creg x ++ ")"
406doOp v LB32T8 [x] = v ++ "idris_b32T8(vm, " ++ creg x ++ ")"
407doOp v LB32T16 [x] = v ++ "idris_b32T16(vm, " ++ creg x ++ ")"
409doOp v LB64Lt [x, y] = v ++ "idris_b64Lt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
410doOp v LB64Lte [x, y] = v ++ "idris_b64Lte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
411doOp v LB64Eq [x, y] = v ++ "idris_b64Eq(vm, " ++ creg x ++ "," ++ creg y ++ ")"
412doOp v LB64Gte [x, y] = v ++ "idris_b64Gte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
413doOp v LB64Gt [x, y] = v ++ "idris_b64Gt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
415doOp v LB64Shl [x, y] = v ++ "idris_b64Shl(vm, " ++ creg x ++ "," ++ creg y ++ ")"
416doOp v LB64LShr [x, y] = v ++ "idris_b64Shr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
417doOp v LB64AShr [x, y] = v ++ "idris_b64AShr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
418doOp v LB64And [x, y] = v ++ "idris_b64And(vm, " ++ creg x ++ "," ++ creg y ++ ")"
419doOp v LB64Or [x, y] = v ++ "idris_b64Or(vm, " ++ creg x ++ "," ++ creg y ++ ")"
420doOp v LB64Xor [x, y] = v ++ "idris_b64Xor(vm, " ++ creg x ++ "," ++ creg y ++ ")"
421doOp v LB64Compl [x] = v ++ "idris_b64Compl(vm, " ++ creg x ++ ")"
423doOp v LB64Plus [x, y] =
424 v ++ "idris_b64Plus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
425doOp v LB64Minus [x, y] =
426 v ++ "idris_b64Minus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
427doOp v LB64Times [x, y] =
428 v ++ "idris_b64Times(vm, " ++ creg x ++ "," ++ creg y ++ ")"
429doOp v LB64UDiv [x, y] =
430 v ++ "idris_b64UDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
431doOp v LB64SDiv [x, y] =
432 v ++ "idris_b64SDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
433doOp v LB64URem [x, y] =
434 v ++ "idris_b64URem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
435doOp v LB64SRem [x, y] =
436 v ++ "idris_b64SRem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
438doOp v LB64T8 [x] = v ++ "idris_b64T8(vm, " ++ creg x ++ ")"
439doOp v LB64T16 [x] = v ++ "idris_b64T16(vm, " ++ creg x ++ ")"
440doOp v LB64T32 [x] = v ++ "idris_b64T32(vm, " ++ creg x ++ ")"
442doOp v LFExp [x] = v ++ "MKFLOAT(exp(GETFLOAT(" ++ creg x ++ ")))"
443doOp v LFLog [x] = v ++ "MKFLOAT(log(GETFLOAT(" ++ creg x ++ ")))"
444doOp v LFSin [x] = v ++ "MKFLOAT(sin(GETFLOAT(" ++ creg x ++ ")))"
445doOp v LFCos [x] = v ++ "MKFLOAT(cos(GETFLOAT(" ++ creg x ++ ")))"
446doOp v LFTan [x] = v ++ "MKFLOAT(tan(GETFLOAT(" ++ creg x ++ ")))"
447doOp v LFASin [x] = v ++ "MKFLOAT(asin(GETFLOAT(" ++ creg x ++ ")))"
448doOp v LFACos [x] = v ++ "MKFLOAT(acos(GETFLOAT(" ++ creg x ++ ")))"
449doOp v LFATan [x] = v ++ "MKFLOAT(atan(GETFLOAT(" ++ creg x ++ ")))"
450doOp v LFSqrt [x] = v ++ "MKFLOAT(floor(GETFLOAT(" ++ creg x ++ ")))"
451doOp v LFFloor [x] = v ++ "MKFLOAT(ceil(GETFLOAT(" ++ creg x ++ ")))"
452doOp v LFCeil [x] = v ++ "MKFLOAT(sqrt(GETFLOAT(" ++ creg x ++ ")))"
454doOp v LStrHead [x] = v ++ "idris_strHead(vm, " ++ creg x ++ ")"
455doOp v LStrTail [x] = v ++ "idris_strTail(vm, " ++ creg x ++ ")"
456doOp v LStrCons [x, y] = v ++ "idris_strCons(vm, " ++ creg x ++ "," ++ creg y ++ ")"
457doOp v LStrIndex [x, y] = v ++ "idris_strIndex(vm, " ++ creg x ++ "," ++ creg y ++ ")"
458doOp v LStrRev [x] = v ++ "idris_strRev(vm, " ++ creg x ++ ")"
460doOp v LStdIn [] = v ++ "MKPTR(vm, stdin)"
461doOp v LStdOut [] = v ++ "MKPTR(vm, stdout)"
462doOp v LStdErr [] = v ++ "MKPTR(vm, stderr)"
464doOp v LFork [x] = v ++ "MKPTR(vm, vmThread(vm, " ++ cname (MN 0 "EVAL") ++ ", " ++ creg x ++ "))"
465doOp v LPar [x] = v ++ creg x -- "MKPTR(vm, vmThread(vm, " ++ cname (MN 0 "EVAL") ++ ", " ++ creg x ++ "))"
466doOp v LVMPtr [] = v ++ "MKPTR(vm, vm)"
467doOp v LChInt args = v ++ creg (last args)
468doOp v LIntCh args = v ++ creg (last args)
469doOp v LNoOp args = v ++ creg (last args)
470doOp _ op _ = "FAIL /* " ++ show op ++ " */"