@@ -54,7 +54,8 @@ codegenC dump defs out exec incs objs libs dbg
5454 when (exit /= ExitSuccess) $
5555 putStrLn ("FAILURE: " ++ gcc)
5656
57−headers [] = "#include <idris_rts.h>\n#include <idris_stdfgn.h>\n#include <assert.h>\n"
57+headers [] = "#include <idris_rts.h>\n#include <idris_stdfgn.h>\n" ++
58+ "#include <gmp.h>\n#include <assert.h>\n"
5859headers (x : xs) = "#include <" ++ x ++ ">\n" ++ headers xs
5960
6061debug TRACE = "#define IDRIS_TRACE\n\n"
@@ -127,16 +128,46 @@ bcc i (CASE r code def)
127128 showDef i (Just c) = indent i ++ "default:\n"
128129 ++ concatMap (bcc (i+1)) c ++ indent (i + 1) ++ "break;\n"
129130bcc i (CONSTCASE r code def)
130− = indent i ++ "switch(GETINT(" ++ creg r ++ ")) {\n" ++
131− concatMap (showCase i) code ++
132− showDef i def ++
133− indent i ++ "}\n"
131+ | intConsts code
132+ = indent i ++ "switch(GETINT(" ++ creg r ++ ")) {\n" ++
133+ concatMap (showCase i) code ++
134+ showDef i def ++
135+ indent i ++ "}\n"
136+ | strConsts code
137+ = concatMap (strCase ("GETSTR(" ++ creg r ++ ")")) code ++
138+ indent i ++ "{\n" ++ showDefS i def ++ indent i ++ "}\n"
139+ | bigintConsts code
140+ = concatMap (biCase (creg r)) code ++
141+ indent i ++ "{\n" ++ showDefS i def ++ indent i ++ "}\n"
142+ | otherwise = error $ "Can't happen: Can't compile const case " ++ show code
134143 where
144+ intConsts ((I _, _ ) : _) = True
145+ intConsts ((Ch _, _ ) : _) = True
146+ intConsts _ = False
147+
148+ bigintConsts ((BI _, _ ) : _) = True
149+ bigintConsts _ = False
150+
151+ strConsts ((Str _, _ ) : _) = True
152+ strConsts _ = False
153+
154+ strCase sv (s, bc) =
155+ indent i ++ "if (strcmp(" ++ sv ++ ", " ++ show s ++ ") == 0) {\n" ++
156+ concatMap (bcc (i+1)) bc ++ indent i ++ "} else\n"
157+ biCase bv (BI b, bc) =
158+ indent i ++ "if (bigEqConst(" ++ bv ++ ", " ++ show b ++ ")) {\n"
159+ ++ concatMap (bcc (i+1)) bc ++ indent i ++ "} else\n"
160+
135161 showCase i (t, bc) = indent i ++ "case " ++ show t ++ ":\n"
136− ++ concatMap (bcc (i+1)) bc ++ indent (i + 1) ++ "break;\n"
162+ ++ concatMap (bcc (i+1)) bc ++
163+ indent (i + 1) ++ "break;\n"
137164 showDef i Nothing = ""
138165 showDef i (Just c) = indent i ++ "default:\n"
139− ++ concatMap (bcc (i+1)) c ++ indent (i + 1) ++ "break;\n"
166+ ++ concatMap (bcc (i+1)) c ++
167+ indent (i + 1) ++ "break;\n"
168+ showDefS i Nothing = ""
169+ showDefS i (Just c) = concatMap (bcc (i+1)) c
170+
140171bcc i (CALL n) = indent i ++ "CALL(" ++ cname n ++ ");\n"
141172bcc i (TAILCALL n) = indent i ++ "TAILCALL(" ++ cname n ++ ");\n"
142173bcc i (SLIDE n) = indent i ++ "SLIDE(vm, " ++ show n ++ ");\n"