src/IRTS/CodegenC.hs · Idris-dev

git.iko.soy/Idris-dev

on 308efea help sign in

Idris-dev/src/IRTS/CodegenC.hs

381 lines 17 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 Data.List (intercalate)

14import System.Process

15import System.Exit

16import System.IO

17import System.Directory

18import System.FilePath ((</>), (<.>))

19import Control.Monad

21codegenC :: [(Name, SDecl)] ->

22 String -> -- output file name

23 OutputType -> -- generate executable if True, only .o if False

24 [FilePath] -> -- include files

25 String -> -- extra object files

26 String -> -- extra compiler flags

27 DbgLevel ->

28 IO ()

29codegenC defs out exec incs objs libs dbg

30 = do -- print defs

31 let bc = map toBC defs

32 let h = concatMap toDecl (map fst bc)

33 let cc = concatMap (uncurry toC) bc

34 d <- getDataDir

35 mprog <- readFile (d </> "rts" </> "idris_main" <.> "c")

36 let cout = headers incs ++ debug dbg ++ h ++ cc ++

37 (if (exec == Executable) then mprog else "")

38 case exec of

39 Raw -> writeFile out cout

40 _ -> do

41 (tmpn, tmph) <- tempfile

42 hPutStr tmph cout

43 hFlush tmph

44 hClose tmph

45 let useclang = False

46 comp <- getCC

47 libFlags <- getLibFlags

48 incFlags <- getIncFlags

49 let gcc = comp ++ " " ++

50 gccDbg dbg ++

51 " -I. " ++ objs ++ " -x c " ++

52 (if (exec == Executable) then "" else " -c ") ++

53 " " ++ tmpn ++

54 " " ++ libFlags ++

55 " " ++ incFlags ++

56 " " ++ libs ++

57 " -o " ++ out

58-- putStrLn gcc

59 exit <- system gcc

60 when (exit /= ExitSuccess) $

61 putStrLn ("FAILURE: " ++ gcc)

63headers xs =

64 concatMap

65 (\h -> "#include <" ++ h ++ ">\n")

66 (xs ++ ["idris_rts.h", "idris_bitstring.h", "idris_stdfgn.h", "gmp.h", "assert.h"])

68debug TRACE = "#define IDRIS_TRACE\n\n"

69debug _ = ""

71gccDbg DEBUG = "-g"

72gccDbg TRACE = "-O2"

73gccDbg _ = "-O2"

75cname :: Name -> String

76cname n = "_idris_" ++ concatMap cchar (show n)

77 where cchar x | isAlpha x || isDigit x = [x]

78 | otherwise = "_" ++ show (fromEnum x) ++ "_"

80indent :: Int -> String

81indent n = replicate (n*4) ' '

83creg RVal = "RVAL"

84creg (L i) = "LOC(" ++ show i ++ ")"

85creg (T i) = "TOP(" ++ show i ++ ")"

86creg Tmp = "REG1"

88toDecl :: Name -> String

89toDecl f = "void " ++ cname f ++ "(VM*, VAL*);\n"

91toC :: Name -> [BC] -> String

92toC f code

93 = -- "/* " ++ show code ++ "*/\n\n" ++

94 "void " ++ cname f ++ "(VM* vm, VAL* oldbase) {\n" ++

95 indent 1 ++ "INITFRAME;\n" ++

96 concatMap (bcc 1) code ++ "}\n\n"

98bcc :: Int -> BC -> String

99bcc i (ASSIGN l r) = indent i ++ creg l ++ " = " ++ creg r ++ ";\n"

100bcc i (ASSIGNCONST l c)

101 = indent i ++ creg l ++ " = " ++ mkConst c ++ ";\n"

102 where

103 mkConst (I i) = "MKINT(" ++ show i ++ ")"

104 mkConst (BI i) | i < (2^30) = "MKINT(" ++ show i ++ ")"

105 | otherwise = "MKBIGC(vm,\"" ++ show i ++ "\")"

106 mkConst (Fl f) = "MKFLOAT(vm, " ++ show f ++ ")"

107 mkConst (Ch c) = "MKINT(" ++ show (fromEnum c) ++ ")"

108 mkConst (Str s) = "MKSTR(vm, " ++ show s ++ ")"

109 mkConst (B8 x) = "idris_b8const(vm, " ++ show x ++ ")"

110 mkConst (B16 x) = "idris_b16const(vm, " ++ show x ++ ")"

111 mkConst (B32 x) = "idris_b32const(vm, " ++ show x ++ ")"

112 mkConst (B64 x) = "idris_b64const(vm, " ++ show x ++ ")"

113 mkConst _ = "MKINT(42424242)"

114bcc i (UPDATE l r) = indent i ++ creg l ++ " = " ++ creg r ++ ";\n"

115bcc i (MKCON l tag args)

116 = indent i ++ "allocCon(" ++ creg Tmp ++ ", vm, " ++ show tag ++ "," ++

117 show (length args) ++ ", 0);\n" ++

118 indent i ++ setArgs 0 args ++ "\n" ++

119 indent i ++ creg l ++ " = " ++ creg Tmp ++ ";\n"

120

121-- "MKCON(vm, " ++ creg l ++ ", " ++ show tag ++ ", " ++

122-- show (length args) ++ concatMap showArg args ++ ");\n"

123 where showArg r = ", " ++ creg r

124 setArgs i [] = ""

125 setArgs i (x : xs) = "SETARG(" ++ creg Tmp ++ ", " ++ show i ++ ", " ++ creg x ++

126 "); " ++ setArgs (i + 1) xs

127

128bcc i (PROJECT l loc a) = indent i ++ "PROJECT(vm, " ++ creg l ++ ", " ++ show loc ++

129 ", " ++ show a ++ ");\n"

130bcc i (PROJECTINTO r t idx)

131 = indent i ++ creg r ++ " = GETARG(" ++ creg t ++ ", " ++ show idx ++ ");\n"

132bcc i (CASE True r code def)

133 | length code < 4 = showCase i def code

134 where

135 showCode :: Int -> [BC] -> String

136 showCode i bc = "{\n" ++ indent i ++ concatMap (bcc (i + 1)) bc ++

137 indent i ++ "}\n"

138

139 showCase :: Int -> Maybe [BC] -> [(Int, [BC])] -> String

140 showCase i Nothing [(t, c)] = showCode i c

141 showCase i (Just def) [] = showCode i def

142 showCase i def ((t, c) : cs)

143 = "if (CTAG(" ++ creg r ++ ") == " ++ show t ++ ") " ++ showCode i c

144 ++ "else " ++ showCase i def cs

145

146bcc i (CASE safe r code def)

147 = indent i ++ "switch(" ++ ctag safe ++ "(" ++ creg r ++ ")) {\n" ++

148 concatMap (showCase i) code ++

149 showDef i def ++

150 indent i ++ "}\n"

151 where

152 ctag True = "CTAG"

153 ctag False = "TAG"

154

155 showCase i (t, bc) = indent i ++ "case " ++ show t ++ ":\n"

156 ++ concatMap (bcc (i+1)) bc ++ indent (i + 1) ++ "break;\n"

157 showDef i Nothing = ""

158 showDef i (Just c) = indent i ++ "default:\n"

159 ++ concatMap (bcc (i+1)) c ++ indent (i + 1) ++ "break;\n"

160bcc i (CONSTCASE r code def)

161 | intConsts code

162-- = indent i ++ "switch(GETINT(" ++ creg r ++ ")) {\n" ++

163-- concatMap (showCase i) code ++

164-- showDef i def ++

165-- indent i ++ "}\n"

166 = concatMap (iCase (creg r)) code ++

167 indent i ++ "{\n" ++ showDefS i def ++ indent i ++ "}\n"

168 | strConsts code

169 = concatMap (strCase ("GETSTR(" ++ creg r ++ ")")) code ++

170 indent i ++ "{\n" ++ showDefS i def ++ indent i ++ "}\n"

171 | bigintConsts code

172 = concatMap (biCase (creg r)) code ++

173 indent i ++ "{\n" ++ showDefS i def ++ indent i ++ "}\n"

174 | otherwise = error $ "Can't happen: Can't compile const case " ++ show code

175 where

176 intConsts ((I _, _ ) : _) = True

177 intConsts ((Ch _, _ ) : _) = True

178 intConsts _ = False

179

180 bigintConsts ((BI _, _ ) : _) = True

181 bigintConsts _ = False

182

183 strConsts ((Str _, _ ) : _) = True

184 strConsts _ = False

185

186 strCase sv (s, bc) =

187 indent i ++ "if (strcmp(" ++ sv ++ ", " ++ show s ++ ") == 0) {\n" ++

188 concatMap (bcc (i+1)) bc ++ indent i ++ "} else\n"

189 biCase bv (BI b, bc) =

190 indent i ++ "if (bigEqConst(" ++ bv ++ ", " ++ show b ++ ")) {\n"

191 ++ concatMap (bcc (i+1)) bc ++ indent i ++ "} else\n"

192 iCase v (I b, bc) =

193 indent i ++ "if (GETINT(" ++ v ++ ") == " ++ show b ++ ") {\n"

194 ++ concatMap (bcc (i+1)) bc ++ indent i ++ "} else\n"

195 iCase v (Ch b, bc) =

196 indent i ++ "if (GETINT(" ++ v ++ ") == " ++ show b ++ ") {\n"

197 ++ concatMap (bcc (i+1)) bc ++ indent i ++ "} else\n"

198

199 showCase i (t, bc) = indent i ++ "case " ++ show t ++ ":\n"

200 ++ concatMap (bcc (i+1)) bc ++

201 indent (i + 1) ++ "break;\n"

202 showDef i Nothing = ""

203 showDef i (Just c) = indent i ++ "default:\n"

204 ++ concatMap (bcc (i+1)) c ++

205 indent (i + 1) ++ "break;\n"

206 showDefS i Nothing = ""

207 showDefS i (Just c) = concatMap (bcc (i+1)) c

208

209bcc i (CALL n) = indent i ++ "CALL(" ++ cname n ++ ");\n"

210bcc i (TAILCALL n) = indent i ++ "TAILCALL(" ++ cname n ++ ");\n"

211bcc i (SLIDE n) = indent i ++ "SLIDE(vm, " ++ show n ++ ");\n"

212bcc i REBASE = indent i ++ "REBASE;\n"

213bcc i (RESERVE 0) = ""

214bcc i (RESERVE n) = indent i ++ "RESERVE(" ++ show n ++ ");\n"

215bcc i (ADDTOP 0) = ""

216bcc i (ADDTOP n) = indent i ++ "ADDTOP(" ++ show n ++ ");\n"

217bcc i (TOPBASE n) = indent i ++ "TOPBASE(" ++ show n ++ ");\n"

218bcc i (BASETOP n) = indent i ++ "BASETOP(" ++ show n ++ ");\n"

219bcc i STOREOLD = indent i ++ "STOREOLD;\n"

220bcc i (OP l fn args) = indent i ++ doOp (creg l ++ " = ") fn args ++ ";\n"

221bcc i (FOREIGNCALL l LANG_C rty fn args)

222 = indent i ++

223 c_irts rty (creg l ++ " = ")

224 (fn ++ "(" ++ showSep "," (map fcall args) ++ ")") ++ ";\n"

225 where fcall (t, arg) = irts_c t (creg arg)

226bcc i (NULL r) = indent i ++ creg r ++ " = NULL;\n" -- clear, so it'll be GCed

227bcc i (ERROR str) = indent i ++ "fprintf(stderr, " ++ show str ++ "); assert(0); exit(-1);"

228-- bcc i _ = indent i ++ "// not done yet\n"

229

230

231

232c_irts (FInt ITNative) l x = l ++ "MKINT((i_int)(" ++ x ++ "))"

233c_irts (FInt ty) l x = l ++ "idris_b" ++ show (intTyWidth ty) ++ "const(vm, " ++ x ++ ")"

234c_irts FChar l x = l ++ "MKINT((i_int)(" ++ x ++ "))"

235c_irts FString l x = l ++ "MKSTR(vm, " ++ x ++ ")"

236c_irts FUnit l x = x

237c_irts FPtr l x = l ++ "MKPTR(vm, " ++ x ++ ")"

238c_irts FDouble l x = l ++ "MKFLOAT(vm, " ++ x ++ ")"

239c_irts FAny l x = l ++ x

240

241irts_c (FInt ITNative) x = "GETINT(" ++ x ++ ")"

242irts_c (FInt ty) x = "(" ++ x ++ "->info.bits" ++ show (intTyWidth ty) ++ ")"

243irts_c FChar x = "GETINT(" ++ x ++ ")"

244irts_c FString x = "GETSTR(" ++ x ++ ")"

245irts_c FUnit x = x

246irts_c FPtr x = "GETPTR(" ++ x ++ ")"

247irts_c FDouble x = "GETFLOAT(" ++ x ++ ")"

248irts_c FAny x = x

249

250bitOp v op ty args = v ++ "idris_b" ++ show (intTyWidth ty) ++ op ++ "(vm, " ++ intercalate ", " (map creg args) ++ ")"

251

252bitCoerce v op input output arg

253 = v ++ "idris_b" ++ show (intTyWidth input) ++ op ++ show (intTyWidth output) ++ "(vm, " ++ creg arg ++ ")"

254

255doOp v (LPlus ITNative) [l, r] = v ++ "ADD(" ++ creg l ++ ", " ++ creg r ++ ")"

256doOp v (LMinus ITNative) [l, r] = v ++ "INTOP(-," ++ creg l ++ ", " ++ creg r ++ ")"

257doOp v (LTimes ITNative) [l, r] = v ++ "MULT(" ++ creg l ++ ", " ++ creg r ++ ")"

258doOp v (LUDiv ITNative) [l, r] = v ++ "UINTOP(/," ++ creg l ++ ", " ++ creg r ++ ")"

259doOp v (LSDiv ITNative) [l, r] = v ++ "INTOP(/," ++ creg l ++ ", " ++ creg r ++ ")"

260doOp v (LURem ITNative) [l, r] = v ++ "UINTOP(%," ++ creg l ++ ", " ++ creg r ++ ")"

261doOp v (LSRem ITNative) [l, r] = v ++ "INTOP(%," ++ creg l ++ ", " ++ creg r ++ ")"

262doOp v (LAnd ITNative) [l, r] = v ++ "INTOP(&," ++ creg l ++ ", " ++ creg r ++ ")"

263doOp v (LOr ITNative) [l, r] = v ++ "INTOP(|," ++ creg l ++ ", " ++ creg r ++ ")"

264doOp v (LXOr ITNative) [l, r] = v ++ "INTOP(^," ++ creg l ++ ", " ++ creg r ++ ")"

265doOp v (LSHL ITNative) [l, r] = v ++ "INTOP(<<," ++ creg l ++ ", " ++ creg r ++ ")"

266doOp v (LLSHR ITNative) [l, r] = v ++ "UINTOP(>>," ++ creg l ++ ", " ++ creg r ++ ")"

267doOp v (LASHR ITNative) [l, r] = v ++ "INTOP(>>," ++ creg l ++ ", " ++ creg r ++ ")"

268doOp v (LCompl ITNative) [x] = v ++ "INTOP(~," ++ creg x ++ ")"

269doOp v (LEq ITNative) [l, r] = v ++ "INTOP(==," ++ creg l ++ ", " ++ creg r ++ ")"

270doOp v (LLt ITNative) [l, r] = v ++ "INTOP(<," ++ creg l ++ ", " ++ creg r ++ ")"

271doOp v (LLe ITNative) [l, r] = v ++ "INTOP(<=," ++ creg l ++ ", " ++ creg r ++ ")"

272doOp v (LGt ITNative) [l, r] = v ++ "INTOP(>," ++ creg l ++ ", " ++ creg r ++ ")"

273doOp v (LGe ITNative) [l, r] = v ++ "INTOP(>=," ++ creg l ++ ", " ++ creg r ++ ")"

274

275doOp v LFPlus [l, r] = v ++ "FLOATOP(+," ++ creg l ++ ", " ++ creg r ++ ")"

276doOp v LFMinus [l, r] = v ++ "FLOATOP(-," ++ creg l ++ ", " ++ creg r ++ ")"

277doOp v LFTimes [l, r] = v ++ "FLOATOP(*," ++ creg l ++ ", " ++ creg r ++ ")"

278doOp v LFDiv [l, r] = v ++ "FLOATOP(/," ++ creg l ++ ", " ++ creg r ++ ")"

279doOp v LFEq [l, r] = v ++ "FLOATBOP(==," ++ creg l ++ ", " ++ creg r ++ ")"

280doOp v LFLt [l, r] = v ++ "FLOATBOP(<," ++ creg l ++ ", " ++ creg r ++ ")"

281doOp v LFLe [l, r] = v ++ "FLOATBOP(<=," ++ creg l ++ ", " ++ creg r ++ ")"

282doOp v LFGt [l, r] = v ++ "FLOATBOP(>," ++ creg l ++ ", " ++ creg r ++ ")"

283doOp v LFGe [l, r] = v ++ "FLOATBOP(>=," ++ creg l ++ ", " ++ creg r ++ ")"

284

285doOp v LBPlus [l, r] = v ++ "idris_bigPlus(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

286doOp v LBMinus [l, r] = v ++ "idris_bigMinus(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

287doOp v LBDec [l] = v ++ "idris_bigMinus(vm, " ++ creg l ++ ", MKINT(1))"

288doOp v LBTimes [l, r] = v ++ "idris_bigTimes(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

289doOp v LBDiv [l, r] = v ++ "idris_bigDivide(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

290doOp v LBMod [l, r] = v ++ "idris_bigMod(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

291doOp v LBEq [l, r] = v ++ "idris_bigEq(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

292doOp v LBLt [l, r] = v ++ "idris_bigLt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

293doOp v LBLe [l, r] = v ++ "idris_bigLe(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

294doOp v LBGt [l, r] = v ++ "idris_bigGt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

295doOp v LBGe [l, r] = v ++ "idris_bigGe(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

296

297doOp v LStrConcat [l,r] = v ++ "idris_concat(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

298doOp v LStrLt [l,r] = v ++ "idris_strlt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

299doOp v LStrEq [l,r] = v ++ "idris_streq(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

300doOp v LStrLen [x] = v ++ "idris_strlen(vm, " ++ creg x ++ ")"

301

302doOp v LIntFloat [x] = v ++ "idris_castIntFloat(" ++ creg x ++ ")"

303doOp v LFloatInt [x] = v ++ "idris_castFloatInt(" ++ creg x ++ ")"

304doOp v LIntStr [x] = v ++ "idris_castIntStr(vm, " ++ creg x ++ ")"

305doOp v LStrInt [x] = v ++ "idris_castStrInt(vm, " ++ creg x ++ ")"

306doOp v LIntBig [x] = v ++ "idris_castIntBig(vm, " ++ creg x ++ ")"

307doOp v LBigInt [x] = v ++ "idris_castBigInt(vm, " ++ creg x ++ ")"

308doOp v LStrBig [x] = v ++ "idris_castStrBig(vm, " ++ creg x ++ ")"

309doOp v LBigStr [x] = v ++ "idris_castBigStr(vm, " ++ creg x ++ ")"

310doOp v LFloatStr [x] = v ++ "idris_castFloatStr(vm, " ++ creg x ++ ")"

311doOp v LStrFloat [x] = v ++ "idris_castStrFloat(vm, " ++ creg x ++ ")"

312

313doOp v LReadStr [x] = v ++ "idris_readStr(vm, GETPTR(" ++ creg x ++ "))"

314doOp _ LPrintNum [x] = "printf(\"%ld\\n\", GETINT(" ++ creg x ++ "))"

315doOp _ LPrintStr [x] = "fputs(GETSTR(" ++ creg x ++ "), stdout)"

316

317doOp v LIntB8 [x] = v ++ "idris_b8(vm, " ++ creg x ++ ")"

318doOp v LIntB16 [x] = v ++ "idris_b16(vm, " ++ creg x ++ ")"

319doOp v LIntB32 [x] = v ++ "idris_b32(vm, " ++ creg x ++ ")"

320doOp v LIntB64 [x] = v ++ "idris_b64(vm, " ++ creg x ++ ")"

321

322doOp v LB32Int [x] = v ++ "idris_castB32Int(vm, " ++ creg x ++ ")"

323

324doOp v (LLt ty) [x, y] = bitOp v "Lt" ty [x, y]

325doOp v (LLe ty) [x, y] = bitOp v "Lte" ty [x, y]

326doOp v (LEq ty) [x, y] = bitOp v "Eq" ty [x, y]

327doOp v (LGe ty) [x, y] = bitOp v "Gte" ty [x, y]

328doOp v (LGt ty) [x, y] = bitOp v "Gt" ty [x, y]

329

330doOp v (LSHL ty) [x, y] = bitOp v "Shl" ty [x, y]

331doOp v (LLSHR ty) [x, y] = bitOp v "Shr" ty [x, y]

332doOp v (LASHR ty) [x, y] = bitOp v "AShr" ty [x, y]

333doOp v (LAnd ty) [x, y] = bitOp v "And" ty [x, y]

334doOp v (LOr ty) [x, y] = bitOp v "Or" ty [x, y]

335doOp v (LXOr ty) [x, y] = bitOp v "Xor" ty [x, y]

336doOp v (LCompl ty) [x] = bitOp v "Compl" ty [x]

337

338doOp v (LPlus ty) [x, y] = bitOp v "Plus" ty [x, y]

339doOp v (LMinus ty) [x, y] = bitOp v "Minus" ty [x, y]

340doOp v (LTimes ty) [x, y] = bitOp v "Times" ty [x, y]

341doOp v (LUDiv ty) [x, y] = bitOp v "UDiv" ty [x, y]

342doOp v (LSDiv ty) [x, y] = bitOp v "SDiv" ty [x, y]

343doOp v (LURem ty) [x, y] = bitOp v "URem" ty [x, y]

344doOp v (LSRem ty) [x, y] = bitOp v "SRem" ty [x, y]

345

346doOp v (LSExt from to) [x]

347 | intTyWidth from < intTyWidth to = bitCoerce v "S" from to x

348doOp v (LZExt from to) [x]

349 | intTyWidth from < intTyWidth to = bitCoerce v "Z" from to x

350doOp v (LTrunc from to) [x]

351 | intTyWidth from > intTyWidth to = bitCoerce v "T" from to x

352

353doOp v LFExp [x] = v ++ "MKFLOAT(exp(GETFLOAT(" ++ creg x ++ ")))"

354doOp v LFLog [x] = v ++ "MKFLOAT(log(GETFLOAT(" ++ creg x ++ ")))"

355doOp v LFSin [x] = v ++ "MKFLOAT(sin(GETFLOAT(" ++ creg x ++ ")))"

356doOp v LFCos [x] = v ++ "MKFLOAT(cos(GETFLOAT(" ++ creg x ++ ")))"

357doOp v LFTan [x] = v ++ "MKFLOAT(tan(GETFLOAT(" ++ creg x ++ ")))"

358doOp v LFASin [x] = v ++ "MKFLOAT(asin(GETFLOAT(" ++ creg x ++ ")))"

359doOp v LFACos [x] = v ++ "MKFLOAT(acos(GETFLOAT(" ++ creg x ++ ")))"

360doOp v LFATan [x] = v ++ "MKFLOAT(atan(GETFLOAT(" ++ creg x ++ ")))"

361doOp v LFSqrt [x] = v ++ "MKFLOAT(floor(GETFLOAT(" ++ creg x ++ ")))"

362doOp v LFFloor [x] = v ++ "MKFLOAT(ceil(GETFLOAT(" ++ creg x ++ ")))"

363doOp v LFCeil [x] = v ++ "MKFLOAT(sqrt(GETFLOAT(" ++ creg x ++ ")))"

364

365doOp v LStrHead [x] = v ++ "idris_strHead(vm, " ++ creg x ++ ")"

366doOp v LStrTail [x] = v ++ "idris_strTail(vm, " ++ creg x ++ ")"

367doOp v LStrCons [x, y] = v ++ "idris_strCons(vm, " ++ creg x ++ "," ++ creg y ++ ")"

368doOp v LStrIndex [x, y] = v ++ "idris_strIndex(vm, " ++ creg x ++ "," ++ creg y ++ ")"

369doOp v LStrRev [x] = v ++ "idris_strRev(vm, " ++ creg x ++ ")"

370

371doOp v LStdIn [] = v ++ "MKPTR(vm, stdin)"

372doOp v LStdOut [] = v ++ "MKPTR(vm, stdout)"

373doOp v LStdErr [] = v ++ "MKPTR(vm, stderr)"

374

375doOp v LFork [x] = v ++ "MKPTR(vm, vmThread(vm, " ++ cname (MN 0 "EVAL") ++ ", " ++ creg x ++ "))"

376doOp v LPar [x] = v ++ creg x -- "MKPTR(vm, vmThread(vm, " ++ cname (MN 0 "EVAL") ++ ", " ++ creg x ++ "))"

377doOp v LVMPtr [] = v ++ "MKPTR(vm, vm)"

378doOp v LChInt args = v ++ creg (last args)

379doOp v LIntCh args = v ++ creg (last args)

380doOp v LNoOp args = v ++ creg (last args)

381doOp _ op _ = "FAIL /* " ++ show op ++ " */"