{-# LANGUAGE FlexibleContexts #-}
module IRTS.CodegenC (codegenC) where
import Idris.Core.TT
import IRTS.Bytecode
import IRTS.CodegenCommon
import IRTS.Defunctionalise
import IRTS.Simplified
import IRTS.System
import Util.System
import Control.Monad
import Data.Bits
import Data.Char
import Data.List (intercalate, nubBy)
import Numeric
import System.Exit
import System.FilePath ((<.>), (</>))
import System.IO
import System.Process
codegenC :: CodeGenerator
codegenC :: CodeGenerator
codegenC CodegenInfo
ci = do [(Name, SDecl)]
-> String
-> OutputType
-> [String]
-> [String]
-> [String]
-> [String]
-> [ExportIFace]
-> Bool
-> DbgLevel
-> IO ()
codegenC' (CodegenInfo -> [(Name, SDecl)]
simpleDecls CodegenInfo
ci)
(CodegenInfo -> String
outputFile CodegenInfo
ci)
(CodegenInfo -> OutputType
outputType CodegenInfo
ci)
(CodegenInfo -> [String]
includes CodegenInfo
ci)
(CodegenInfo -> [String]
compileObjs CodegenInfo
ci)
((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
mkLib (CodegenInfo -> [String]
compileLibs CodegenInfo
ci) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
(String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
incdir (CodegenInfo -> [String]
importDirs CodegenInfo
ci))
(CodegenInfo -> [String]
compilerFlags CodegenInfo
ci)
(CodegenInfo -> [ExportIFace]
exportDecls CodegenInfo
ci)
(CodegenInfo -> Bool
interfaces CodegenInfo
ci)
(CodegenInfo -> DbgLevel
debugLevel CodegenInfo
ci)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CodegenInfo -> Bool
interfaces CodegenInfo
ci) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[ExportIFace] -> IO ()
codegenH (CodegenInfo -> [ExportIFace]
exportDecls CodegenInfo
ci)
where mkLib :: String -> String
mkLib String
l = String
"-l" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l
incdir :: String -> String
incdir String
i = String
"-I" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
i
codegenC' :: [(Name, SDecl)]
-> String
-> OutputType
-> [FilePath]
-> [String]
-> [String]
-> [String]
-> [ExportIFace]
-> Bool
-> DbgLevel
-> IO ()
codegenC' :: [(Name, SDecl)]
-> String
-> OutputType
-> [String]
-> [String]
-> [String]
-> [String]
-> [ExportIFace]
-> Bool
-> DbgLevel
-> IO ()
codegenC' [(Name, SDecl)]
defs String
out OutputType
exec [String]
incs [String]
objs [String]
libs [String]
flags [ExportIFace]
exports Bool
iface DbgLevel
dbg
= do
let bc :: [(Name, [BC])]
bc = ((Name, SDecl) -> (Name, [BC]))
-> [(Name, SDecl)] -> [(Name, [BC])]
forall a b. (a -> b) -> [a] -> [b]
map (Name, SDecl) -> (Name, [BC])
toBC [(Name, SDecl)]
defs
let wrappers :: String
wrappers = [(Name, [BC])] -> String
genWrappers [(Name, [BC])]
bc
let h :: String
h = (Name -> String) -> [Name] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Name -> String
toDecl (((Name, [BC]) -> Name) -> [(Name, [BC])] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, [BC]) -> Name
forall a b. (a, b) -> a
fst [(Name, [BC])]
bc)
let cc :: String
cc = ((Name, [BC]) -> String) -> [(Name, [BC])] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Name -> [BC] -> String) -> (Name, [BC]) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Name -> [BC] -> String
toC) [(Name, [BC])]
bc
let hi :: String
hi = (Export -> String) -> [Export] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Export -> String
ifaceC ((ExportIFace -> [Export]) -> [ExportIFace] -> [Export]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ExportIFace -> [Export]
getExp [ExportIFace]
exports)
String
d <- IO String
getIdrisCRTSDir
String
mprog <- String -> IO String
readFile (String
d String -> String -> String
</> String
"idris_main" String -> String -> String
<.> String
"c")
let cout :: String
cout = [String] -> String
headers [String]
incs String -> String -> String
forall a. [a] -> [a] -> [a]
++ DbgLevel -> String
debug DbgLevel
dbg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
wrappers String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cc String -> String -> String
forall a. [a] -> [a] -> [a]
++
(if (OutputType
exec OutputType -> OutputType -> Bool
forall a. Eq a => a -> a -> Bool
== OutputType
Executable) then String
mprog else String
hi)
case OutputType
exec of
OutputType
Raw -> String -> String -> IO ()
writeSource String
out String
cout
OutputType
_ -> do
(String
tmpn, Handle
tmph) <- String -> IO (String, Handle)
tempfile String
".c"
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
tmph TextEncoding
utf8
Handle -> String -> IO ()
hPutStr Handle
tmph String
cout
Handle -> IO ()
hFlush Handle
tmph
Handle -> IO ()
hClose Handle
tmph
String
comp <- IO String
getCC
[String]
libFlags <- IO [String]
getLibFlags
[String]
incFlags <- IO [String]
getIncFlags
[String]
envFlags <- IO [String]
getEnvFlags
let stripFlag :: String
stripFlag = if Bool
isDarwin then String
"-dead_strip" else String
"-Wl,-gc-sections"
let stackFlags :: [String]
stackFlags = if Bool
isWindows then [String
"-Wl,--stack,16777216"] else []
let linkFlags :: [String]
linkFlags = String
stripFlag String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
stackFlags
let args :: [String]
args = DbgLevel -> [String]
gccDbg DbgLevel
dbg [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
Bool -> [String]
gccFlags Bool
iface [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
[ String
"-std=c99", String
"-pipe"
, String
"-fdata-sections", String
"-ffunction-sections"
, String
"-D_POSIX_C_SOURCE=200809L", String
"-DHAS_PTHREAD", String
"-DIDRIS_ENABLE_STATS"
, String
"-I."] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
objs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
envFlags [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
(if (OutputType
exec OutputType -> OutputType -> Bool
forall a. Eq a => a -> a -> Bool
== OutputType
Executable) then [String]
linkFlags else [String
"-c"]) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
[String
tmpn] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
(if Bool -> Bool
not Bool
iface then [String]
libFlags else []) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
[String]
incFlags [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
(if Bool -> Bool
not Bool
iface then [String]
libs else []) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
[String]
flags [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
[String
"-o", String
out]
ExitCode
exit <- String -> [String] -> IO ExitCode
rawSystem String
comp [String]
args
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
exit ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn (String
"FAILURE: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
comp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
args)
where
getExp :: ExportIFace -> [Export]
getExp (Export Name
_ String
_ [Export]
exp) = [Export]
exp
[String]
xs =
(String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(\String
h -> String
"#include \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"\n")
([String]
xs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"idris_rts.h", String
"idris_bitstring.h", String
"idris_stdfgn.h"])
debug :: DbgLevel -> String
debug DbgLevel
TRACE = String
"#define IDRIS_TRACE\n\n"
debug DbgLevel
_ = String
""
gccFlags :: Bool -> [String]
gccFlags Bool
i = if Bool
i then [String
"-fwrapv"]
else [String
"-fwrapv", String
"-fno-strict-overflow"]
gccDbg :: DbgLevel -> [String]
gccDbg DbgLevel
DEBUG = [String
"-g"]
gccDbg DbgLevel
_ = []
cname :: Name -> String
cname :: Name -> String
cname Name
n = String
"_idris_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
cchar (Name -> String
showCG Name
n)
where cchar :: Char -> String
cchar Char
x | Char -> Bool
isAscii Char
x Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
x Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
x = [Char
x]
| Bool
otherwise = String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_"
indent :: Int -> String
indent :: Int -> String
indent Int
n = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
4) Char
' '
creg :: Reg -> String
creg Reg
RVal = String
"RVAL"
creg (L Int
i) = String
"LOC(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
creg (T Int
i) = String
"TOP(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
creg Reg
Tmp = String
"REG1"
toDecl :: Name -> String
toDecl :: Name -> String
toDecl Name
f = String
"void* " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
cname Name
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(VM*, VAL*);\n"
toC :: Name -> [BC] -> String
toC :: Name -> [BC] -> String
toC Name
f [BC]
code
=
String
"void* " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
cname Name
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(VM* vm, VAL* oldbase) {\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"INITFRAME;\nloop:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
(BC -> String) -> [BC] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Name -> Int -> BC -> String
bcc Name
f Int
1) [BC]
code String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}\n\n"
showCStr :: String -> String
showCStr :: String -> String
showCStr String
s = Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: (Char -> String -> String) -> String -> String -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (String -> String -> String)
-> (Char -> String) -> Char -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
showChar) String
"\"" String
s
where
showChar :: Char -> String
showChar :: Char -> String
showChar Char
'"' = String
"\\\""
showChar Char
'\\' = String
"\\\\"
showChar Char
c
| Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x20 = Int -> String
forall {a}. Integral a => a -> String
showUTF8 (Char -> Int
ord Char
c)
| Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x7f = [Char
c]
| Bool
otherwise = [Int] -> String
showHexes (Int -> [Int]
utf8bytes (Char -> Int
ord Char
c))
showUTF8 :: a -> String
showUTF8 a
c = String
"\"\"\\x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
pad (a -> String -> String
forall a. Integral a => a -> String -> String
showHex a
c String
"") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"\""
showHexes :: [Int] -> String
showHexes = (Int -> String -> String) -> String -> [Int] -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (String -> String -> String)
-> (Int -> String) -> Int -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall {a}. Integral a => a -> String
showUTF8) String
""
utf8bytes :: Int -> [Int]
utf8bytes :: Int -> [Int]
utf8bytes Int
x
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7f = [Int
x]
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7ff = let (Int
y : [Int]
ys) = [Int] -> Integer -> Int -> [Int]
forall {t} {t}.
(Bits t, Num t, Num t, Eq t) =>
[t] -> t -> t -> [t]
split [] Integer
2 Int
x in (Int
y Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
0xc0) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
0x80) [Int]
ys
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffff = let (Int
y : [Int]
ys) = [Int] -> Integer -> Int -> [Int]
forall {t} {t}.
(Bits t, Num t, Num t, Eq t) =>
[t] -> t -> t -> [t]
split [] Integer
3 Int
x in (Int
y Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
0xe0) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
0x80) [Int]
ys
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x10ffff = let (Int
y : [Int]
ys) = [Int] -> Integer -> Int -> [Int]
forall {t} {t}.
(Bits t, Num t, Num t, Eq t) =>
[t] -> t -> t -> [t]
split [] Integer
4 Int
x in (Int
y Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
0xf0) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
0x80) [Int]
ys
| Bool
otherwise = String -> [Int]
forall a. HasCallStack => String -> a
error (String -> [Int]) -> String -> [Int]
forall a b. (a -> b) -> a -> b
$ String
"Invalid Unicode code point U+" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Integral a => a -> String -> String
showHex Int
x String
""
where
split :: [t] -> t -> t -> [t]
split [t]
acc t
1 t
x = t
x t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
acc
split [t]
acc t
i t
x = [t] -> t -> t -> [t]
split (t
x t -> t -> t
forall a. Bits a => a -> a -> a
.&. t
0x3f t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
acc) (t
i t -> t -> t
forall a. Num a => a -> a -> a
- t
1) (t -> Int -> t
forall a. Bits a => a -> Int -> a
shiftR t
x Int
6)
pad :: String -> String
pad :: String -> String
pad String
s = case String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s of
Int
1 -> String
"0" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
Int
2 -> String
s
Int
_ -> String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"Can't happen: String of invalid length " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
s
bcc :: Name -> Int -> BC -> String
bcc :: Name -> Int -> BC -> String
bcc Name
f Int
i (ASSIGN Reg
l Reg
r) = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n"
bcc Name
f Int
i (ASSIGNCONST Reg
l Const
c)
= Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Const -> String
mkConst Const
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n"
where
mkConst :: Const -> String
mkConst (I Int
i) = String
"MKINT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
mkConst (BI Integer
i) = let maxInt :: Integer
maxInt = Integer
2Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
30
in if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= -Integer
maxInt Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
maxInt
then String
"MKINT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
else String
"MKBIGC(vm,\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\")"
mkConst (Fl Double
f) = String
"MKFLOAT(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
f) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
mkConst (Ch Char
c) = String
"MKINT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
mkConst (Str String
s) = String
"MKSTR(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
showCStr String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
mkConst (B8 Word8
x) = String
"idris_b8const(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"U)"
mkConst (B16 Word16
x) = String
"idris_b16const(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word16 -> String
forall a. Show a => a -> String
show Word16
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"U)"
mkConst (B32 Word32
x) = String
"idris_b32const(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"UL)"
mkConst (B64 Word64
x) = String
"idris_b64const(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"ULL)"
mkConst Const
c | Const -> Bool
isTypeConst Const
c = String
"MKINT(42424242)"
mkConst Const
c = String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"mkConst of (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Const -> String
forall a. Show a => a -> String
show Const
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") not implemented"
bcc Name
f Int
i (UPDATE Reg
l Reg
r) = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n"
bcc Name
f Int
i (MKCON Reg
l Maybe Reg
loc Int
tag []) | Int
tag Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
256
= Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = NULL_CON(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
tag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n"
bcc Name
f Int
i (MKCON Reg
l Maybe Reg
loc Int
tag [Reg]
args)
= Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe Reg -> Int -> String
forall {a}. Show a => Maybe Reg -> a -> String
alloc Maybe Reg
loc Int
tag String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> [Reg] -> String
forall {t}. (Show t, Num t) => t -> [Reg] -> String
setArgs Integer
0 [Reg]
args String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
Tmp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n"
where setArgs :: t -> [Reg] -> String
setArgs t
i [] = String
""
setArgs t
i (Reg
x : [Reg]
xs) = String
"SETARG(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
Tmp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ t -> String
forall a. Show a => a -> String
show t
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"); " String -> String -> String
forall a. [a] -> [a] -> [a]
++ t -> [Reg] -> String
setArgs (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) [Reg]
xs
alloc :: Maybe Reg -> a -> String
alloc Maybe Reg
Nothing a
tag
= String
"allocCon(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
Tmp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
tag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
forall a. Show a => a -> String
show ([Reg] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Reg]
args) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", 0);\n"
alloc (Just Reg
old) a
tag
= String
"updateCon(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
Tmp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
old String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
tag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
forall a. Show a => a -> String
show ([Reg] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Reg]
args) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n"
bcc Name
f Int
i (PROJECT Reg
l Int
loc Int
a) = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"PROJECT(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
loc String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n"
bcc Name
f Int
i (PROJECTINTO Reg
r Reg
t Int
idx)
= Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = GETARG(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
idx String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n"
bcc Name
f Int
i (CASE Bool
True Reg
r [(Int
_, [BC]
alt)] Maybe [BC]
Nothing)
= Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> [BC] -> String
showCode Int
i [BC]
alt
where
showCode :: Int -> [BC] -> String
showCode :: Int -> [BC] -> String
showCode Int
i [BC]
bc = String
"{\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (BC -> String) -> [BC] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Name -> Int -> BC -> String
bcc Name
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) [BC]
bc String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}\n"
bcc Name
f Int
i (CASE Bool
True Reg
r [(Int, [BC])]
code Maybe [BC]
def)
| [(Int, [BC])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, [BC])]
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
6 Bool -> Bool -> Bool
&& [(Int, [BC])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, [BC])]
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = Int -> Maybe [BC] -> [(Int, [BC])] -> String
showCase Int
i Maybe [BC]
def [(Int, [BC])]
code
where
showCode :: Int -> [BC] -> String
showCode :: Int -> [BC] -> String
showCode Int
i [BC]
bc = String
"{\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (BC -> String) -> [BC] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Name -> Int -> BC -> String
bcc Name
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) [BC]
bc String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}\n"
showCase :: Int -> Maybe [BC] -> [(Int, [BC])] -> String
showCase :: Int -> Maybe [BC] -> [(Int, [BC])] -> String
showCase Int
i Maybe [BC]
Nothing [(Int
t, [BC]
c)] = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> [BC] -> String
showCode Int
i [BC]
c
showCase Int
i (Just [BC]
def) [] = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> [BC] -> String
showCode Int
i [BC]
def
showCase Int
i Maybe [BC]
def ((Int
t, [BC]
c) : [(Int, [BC])]
cs)
= Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"if (CTAG(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") == " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> [BC] -> String
showCode Int
i [BC]
c
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"else\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Maybe [BC] -> [(Int, [BC])] -> String
showCase Int
i Maybe [BC]
def [(Int, [BC])]
cs
bcc Name
f Int
i (CASE Bool
safe Reg
r [(Int, [BC])]
code Maybe [BC]
def)
= Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"switch(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Bool -> String
ctag Bool
safe String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")) {\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
((Int, [BC]) -> String) -> [(Int, [BC])] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> (Int, [BC]) -> String
forall {a} {t :: * -> *}.
(Show a, Foldable t) =>
Int -> (a, t BC) -> String
showCase Int
i) [(Int, [BC])]
code String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> Maybe [BC] -> String
forall {t :: * -> *}. Foldable t => Int -> Maybe (t BC) -> String
showDef Int
i Maybe [BC]
def String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}\n"
where
ctag :: Bool -> String
ctag Bool
True = String
"CTAG"
ctag Bool
False = String
"TAG"
showCase :: Int -> (a, t BC) -> String
showCase Int
i (a
t, t BC
bc) = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"case " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (BC -> String) -> t BC -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Name -> Int -> BC -> String
bcc Name
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) t BC
bc String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
indent (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"break;\n"
showDef :: Int -> Maybe (t BC) -> String
showDef Int
i Maybe (t BC)
Nothing = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"default:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"return NULL;\n"
showDef Int
i (Just t BC
c) = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"default:\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (BC -> String) -> t BC -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Name -> Int -> BC -> String
bcc Name
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) t BC
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
indent (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"break;\n"
bcc Name
f Int
i (CONSTCASE Reg
r [(Const, [BC])]
code Maybe [BC]
def)
| [(Const, [BC])] -> Bool
forall {b}. [(Const, b)] -> Bool
intConsts [(Const, [BC])]
code
= ((Const, [BC]) -> String) -> [(Const, [BC])] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> (Const, [BC]) -> String
forall {t :: * -> *}.
Foldable t =>
String -> (Const, t BC) -> String
iCase (Reg -> String
creg Reg
r)) [(Const, [BC])]
code String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"{\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Maybe [BC] -> String
forall {t :: * -> *}. Foldable t => Int -> Maybe (t BC) -> String
showDefS Int
i Maybe [BC]
def String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}\n"
| [(Const, [BC])] -> Bool
forall {b}. [(Const, b)] -> Bool
strConsts [(Const, [BC])]
code
= ((Const, [BC]) -> String) -> [(Const, [BC])] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> (Const, [BC]) -> String
forall {a} {t :: * -> *}.
(Show a, Foldable t) =>
String -> (a, t BC) -> String
strCase (String
"GETSTR(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")) [(Const, [BC])]
code String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"{\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Maybe [BC] -> String
forall {t :: * -> *}. Foldable t => Int -> Maybe (t BC) -> String
showDefS Int
i Maybe [BC]
def String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}\n"
| [(Const, [BC])] -> Bool
forall {b}. [(Const, b)] -> Bool
bigintConsts [(Const, [BC])]
code
= ((Const, [BC]) -> String) -> [(Const, [BC])] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> (Const, [BC]) -> String
forall {t :: * -> *}.
Foldable t =>
String -> (Const, t BC) -> String
biCase (Reg -> String
creg Reg
r)) [(Const, [BC])]
code String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"{\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Maybe [BC] -> String
forall {t :: * -> *}. Foldable t => Int -> Maybe (t BC) -> String
showDefS Int
i Maybe [BC]
def String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}\n"
| Bool
otherwise = String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"Can't happen: Can't compile const case " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(Const, [BC])] -> String
forall a. Show a => a -> String
show [(Const, [BC])]
code
where
intConsts :: [(Const, b)] -> Bool
intConsts ((I Int
_, b
_ ) : [(Const, b)]
_) = Bool
True
intConsts ((Ch Char
_, b
_ ) : [(Const, b)]
_) = Bool
True
intConsts ((B8 Word8
_, b
_ ) : [(Const, b)]
_) = Bool
True
intConsts ((B16 Word16
_, b
_ ) : [(Const, b)]
_) = Bool
True
intConsts ((B32 Word32
_, b
_ ) : [(Const, b)]
_) = Bool
True
intConsts ((B64 Word64
_, b
_ ) : [(Const, b)]
_) = Bool
True
intConsts [(Const, b)]
_ = Bool
False
bigintConsts :: [(Const, b)] -> Bool
bigintConsts ((BI Integer
_, b
_ ) : [(Const, b)]
_) = Bool
True
bigintConsts [(Const, b)]
_ = Bool
False
strConsts :: [(Const, b)] -> Bool
strConsts ((Str String
_, b
_ ) : [(Const, b)]
_) = Bool
True
strConsts [(Const, b)]
_ = Bool
False
strCase :: String -> (a, t BC) -> String
strCase String
sv (a
s, t BC
bc) =
Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"if (strcmp(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sv String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") == 0) {\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
(BC -> String) -> t BC -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Name -> Int -> BC -> String
bcc Name
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) t BC
bc String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"} else\n"
biCase :: String -> (Const, t BC) -> String
biCase String
bv (BI Integer
b, t BC
bc) =
Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"if (bigEqConst(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bv String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")) {\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (BC -> String) -> t BC -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Name -> Int -> BC -> String
bcc Name
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) t BC
bc String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"} else\n"
iCase :: String -> (Const, t BC) -> String
iCase String
v (I Int
b, t BC
bc) =
Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"if (GETINT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") == " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") {\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (BC -> String) -> t BC -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Name -> Int -> BC -> String
bcc Name
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) t BC
bc String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"} else\n"
iCase String
v (Ch Char
b, t BC
bc) =
Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"if (GETINT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") == " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
b) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") {\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (BC -> String) -> t BC -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Name -> Int -> BC -> String
bcc Name
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) t BC
bc String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"} else\n"
iCase String
v (B8 Word8
w, t BC
bc) =
Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"if (GETBITS8(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") == " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Word8 -> Int
forall a. Enum a => a -> Int
fromEnum Word8
w) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") {\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (BC -> String) -> t BC -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Name -> Int -> BC -> String
bcc Name
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) t BC
bc String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"} else\n"
iCase String
v (B16 Word16
w, t BC
bc) =
Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"if (GETBITS16(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") == " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Word16 -> Int
forall a. Enum a => a -> Int
fromEnum Word16
w) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") {\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (BC -> String) -> t BC -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Name -> Int -> BC -> String
bcc Name
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) t BC
bc String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"} else\n"
iCase String
v (B32 Word32
w, t BC
bc) =
Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"if (GETBITS32(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") == " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Word32 -> Int
forall a. Enum a => a -> Int
fromEnum Word32
w) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") {\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (BC -> String) -> t BC -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Name -> Int -> BC -> String
bcc Name
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) t BC
bc String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"} else\n"
iCase String
v (B64 Word64
w, t BC
bc) =
Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"if (GETBITS64(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") == " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Word64 -> Int
forall a. Enum a => a -> Int
fromEnum Word64
w) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") {\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (BC -> String) -> t BC -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Name -> Int -> BC -> String
bcc Name
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) t BC
bc String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"} else\n"
showDefS :: Int -> Maybe (t BC) -> String
showDefS Int
i Maybe (t BC)
Nothing = String
""
showDefS Int
i (Just t BC
c) = (BC -> String) -> t BC -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Name -> Int -> BC -> String
bcc Name
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) t BC
c
bcc Name
f Int
i (CALL Name
n) = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"CALL(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
cname Name
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n"
bcc Name
f Int
i (TAILCALL Name
n)
| Name
f Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"goto loop;\n"
| Bool
otherwise = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"TAILCALL(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
cname Name
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n"
bcc Name
f Int
i (SLIDE Int
n) = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"SLIDE(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n"
bcc Name
f Int
i BC
REBASE = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"REBASE;\n"
bcc Name
f Int
i (RESERVE Int
0) = String
""
bcc Name
f Int
i (RESERVE Int
n) = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"RESERVE(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n"
bcc Name
f Int
i (RESERVENOALLOC Int
0) = String
""
bcc Name
f Int
i (RESERVENOALLOC Int
n) = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"RESERVENOALLOC(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n"
bcc Name
f Int
i (ADDTOP Int
0) = String
""
bcc Name
f Int
i (ADDTOP Int
n) = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"ADDTOP(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n"
bcc Name
f Int
i (TOPBASE Int
n) = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"TOPBASE(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n"
bcc Name
f Int
i (BASETOP Int
n) = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"BASETOP(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n"
bcc Name
f Int
i BC
STOREOLD = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"STOREOLD;\n"
bcc Name
f Int
i (OP Reg
l PrimFn
fn [Reg]
args) = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> PrimFn -> [Reg] -> String
doOp (Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = ") PrimFn
fn [Reg]
args String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n"
bcc Name
f Int
i (FOREIGNCALL Reg
l FDesc
rty (FStr (Char
'#':String
name)) [])
= Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++
FType -> String -> String -> String
c_irts (FDesc -> FType
toFType FDesc
rty) (Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = ") String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n"
bcc Name
f Int
i (FOREIGNCALL Reg
l FDesc
rty (FStr fn :: String
fn@(Char
'&':String
name)) [])
= Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++
FType -> String -> String -> String
c_irts (FDesc -> FType
toFType FDesc
rty) (Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = ") String
fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n"
bcc Name
f Int
i (FOREIGNCALL Reg
l FDesc
rty (FStr String
fn) ((FDesc, Reg)
x:[(FDesc, Reg)]
xs)) | String
fn String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"%wrapper"
= Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++
FType -> String -> String -> String
c_irts (FDesc -> FType
toFType FDesc
rty) (Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = ")
(String
"_idris_get_wrapper(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg ((FDesc, Reg) -> Reg
forall a b. (a, b) -> b
snd (FDesc, Reg)
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n"
bcc Name
f Int
i (FOREIGNCALL Reg
l FDesc
rty (FStr String
fn) ((FDesc, Reg)
x:[(FDesc, Reg)]
xs)) | String
fn String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"%dynamic"
= Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ FType -> String -> String -> String
c_irts (FDesc -> FType
toFType FDesc
rty) (Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = ")
(String
"(*(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> FDesc -> [(FDesc, Reg)] -> String
forall {b}. String -> FDesc -> [(FDesc, b)] -> String
cFnSig String
"" FDesc
rty [(FDesc, Reg)]
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") GETPTR(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg ((FDesc, Reg) -> Reg
forall a b. (a, b) -> b
snd (FDesc, Reg)
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
showSep String
"," (((FDesc, Reg) -> String) -> [(FDesc, Reg)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (FDesc, Reg) -> String
fcall [(FDesc, Reg)]
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n"
bcc Name
f Int
i (FOREIGNCALL Reg
l FDesc
rty (FStr String
fn) [(FDesc, Reg)]
args)
= Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++
FType -> String -> String -> String
c_irts (FDesc -> FType
toFType FDesc
rty) (Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = ")
(String
fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
showSep String
"," (((FDesc, Reg) -> String) -> [(FDesc, Reg)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (FDesc, Reg) -> String
fcall [(FDesc, Reg)]
args) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n"
bcc Name
f Int
i (FOREIGNCALL Reg
l FDesc
rty FDesc
_ [(FDesc, Reg)]
args) = String -> String
forall a. HasCallStack => String -> a
error String
"Foreign Function calls cannot be partially applied, without being inlined."
bcc Name
f Int
i (NULL Reg
r) = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = NULL;\n"
bcc Name
f Int
i (ERROR String
str) = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"fprintf(stderr, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"); fprintf(stderr, \"\\n\"); exit(-1);\n"
fcall :: (FDesc, Reg) -> String
fcall (FDesc
t, Reg
arg) = FType -> String -> String
irts_c (FDesc -> FType
toFType FDesc
t) (Reg -> String
creg Reg
arg)
toAType :: FDesc -> ArithTy
toAType (FCon Name
i)
| Name
i Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_IntChar" = IntTy -> ArithTy
ATInt IntTy
ITChar
| Name
i Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_IntNative" = IntTy -> ArithTy
ATInt IntTy
ITNative
| Name
i Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_IntBits8" = IntTy -> ArithTy
ATInt (NativeTy -> IntTy
ITFixed NativeTy
IT8)
| Name
i Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_IntBits16" = IntTy -> ArithTy
ATInt (NativeTy -> IntTy
ITFixed NativeTy
IT16)
| Name
i Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_IntBits32" = IntTy -> ArithTy
ATInt (NativeTy -> IntTy
ITFixed NativeTy
IT32)
| Name
i Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_IntBits64" = IntTy -> ArithTy
ATInt (NativeTy -> IntTy
ITFixed NativeTy
IT64)
toAType FDesc
t = String -> ArithTy
forall a. HasCallStack => String -> a
error (FDesc -> String
forall a. Show a => a -> String
show FDesc
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not defined in toAType")
toFType :: FDesc -> FType
toFType (FCon Name
c)
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_Str" = FType
FString
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_Float" = ArithTy -> FType
FArith ArithTy
ATFloat
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_Ptr" = FType
FPtr
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_MPtr" = FType
FManagedPtr
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_CData" = FType
FCData
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_Unit" = FType
FUnit
toFType (FApp Name
c [FDesc
_,FDesc
ity])
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_IntT" = ArithTy -> FType
FArith (FDesc -> ArithTy
toAType FDesc
ity)
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_FnT" = FDesc -> FType
toFunType FDesc
ity
toFType (FApp Name
c [FDesc
_])
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_Any" = FType
FAny
toFType FDesc
t = FType
FAny
toFunType :: FDesc -> FType
toFunType (FApp Name
c [FDesc
_,FDesc
ity])
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_FnBase" = FType
FFunction
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_FnIO" = FType
FFunctionIO
toFunType (FApp Name
c [FDesc
_,FDesc
_,FDesc
_,FDesc
ity])
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_Fn" = FDesc -> FType
toFunType FDesc
ity
toFunType FDesc
_ = FType
FAny
c_irts :: FType -> String -> String -> String
c_irts (FArith (ATInt IntTy
ITNative)) String
l String
x = String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKINT((i_int)(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))"
c_irts (FArith (ATInt IntTy
ITChar)) String
l String
x = FType -> String -> String -> String
c_irts (ArithTy -> FType
FArith (IntTy -> ArithTy
ATInt IntTy
ITNative)) String
l String
x
c_irts (FArith (ATInt (ITFixed NativeTy
ity))) String
l String
x
= String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_b" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (NativeTy -> Int
nativeTyWidth NativeTy
ity) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"const(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
c_irts FType
FString String
l String
x = String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKSTR(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
c_irts FType
FUnit String
l String
x = String
x
c_irts FType
FPtr String
l String
x = String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKPTR(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
c_irts FType
FManagedPtr String
l String
x = String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x
c_irts (FArith ArithTy
ATFloat) String
l String
x = String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKFLOAT(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
c_irts FType
FCData String
l String
x = String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKCDATA(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
c_irts FType
FAny String
l String
x = String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x
c_irts FType
FFunction String
l String
x = String -> String
forall a. HasCallStack => String -> a
error String
"Return of function from foreign call is not supported"
c_irts FType
FFunctionIO String
l String
x = String -> String
forall a. HasCallStack => String -> a
error String
"Return of function from foreign call is not supported"
irts_c :: FType -> String -> String
irts_c (FArith (ATInt IntTy
ITNative)) String
x = String
"GETINT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
irts_c (FArith (ATInt IntTy
ITChar)) String
x = FType -> String -> String
irts_c (ArithTy -> FType
FArith (IntTy -> ArithTy
ATInt IntTy
ITNative)) String
x
irts_c (FArith (ATInt (ITFixed NativeTy
ity))) String
x
= String
"GETBITS" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (NativeTy -> Int
nativeTyWidth NativeTy
ity) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
irts_c FType
FString String
x = String
"GETSTR(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
irts_c FType
FUnit String
x = String
x
irts_c FType
FPtr String
x = String
"GETPTR(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
irts_c FType
FManagedPtr String
x = String
"GETMPTR(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
irts_c (FArith ArithTy
ATFloat) String
x = String
"GETFLOAT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
irts_c FType
FCData String
x = String
"GETCDATA(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
irts_c FType
FAny String
x = String
x
irts_c FType
FFunctionIO String
x = String -> String
wrapped String
x
irts_c FType
FFunction String
x = String -> String
wrapped String
x
cFnSig :: String -> FDesc -> [(FDesc, b)] -> String
cFnSig String
name FDesc
rty [] = FDesc -> String
ctype FDesc
rty String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")(void) "
cFnSig String
name FDesc
rty [(FDesc, b)]
args = FDesc -> String
ctype FDesc
rty String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")("
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
showSep String
"," (((FDesc, b) -> String) -> [(FDesc, b)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (FDesc -> String
ctype (FDesc -> String) -> ((FDesc, b) -> FDesc) -> (FDesc, b) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FDesc, b) -> FDesc
forall a b. (a, b) -> a
fst) [(FDesc, b)]
args) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") "
wrapped :: String -> String
wrapped String
x = String
"_idris_get_wrapper(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
bitOp :: String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
op NativeTy
ty [Reg]
args = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_b" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (NativeTy -> Int
nativeTyWidth NativeTy
ty) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
op String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Reg -> String) -> [Reg] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Reg -> String
creg [Reg]
args) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
bitCoerce :: String -> String -> NativeTy -> NativeTy -> Reg -> String
bitCoerce String
v String
op NativeTy
input NativeTy
output Reg
arg
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_b" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (NativeTy -> Int
nativeTyWidth NativeTy
input) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
op String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (NativeTy -> Int
nativeTyWidth NativeTy
output) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
arg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
signedTy :: NativeTy -> String
signedTy :: NativeTy -> String
signedTy NativeTy
t = String
"int" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (NativeTy -> Int
nativeTyWidth NativeTy
t) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_t"
wrapGMP :: String -> String
wrapGMP String
op
= String
"idris_requireAlloc(vm, 65536); " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
op String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"; idris_doneAlloc(vm)"
doOp :: String -> PrimFn -> [Reg] -> String
doOp String
v (LPlus (ATInt IntTy
ITNative)) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"ADD(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LMinus (ATInt IntTy
ITNative)) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"INTOP(-," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LTimes (ATInt IntTy
ITNative)) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MULT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LUDiv IntTy
ITNative) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"UINTOP(/," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSDiv (ATInt IntTy
ITNative)) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"INTOP(/," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LURem IntTy
ITNative) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"UINTOP(%," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSRem (ATInt IntTy
ITNative)) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"INTOP(%," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LAnd IntTy
ITNative) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"INTOP(&," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LOr IntTy
ITNative) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"INTOP(|," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LXOr IntTy
ITNative) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"INTOP(^," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSHL IntTy
ITNative) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"INTOP(<<," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LLSHR IntTy
ITNative) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"UINTOP(>>," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LASHR IntTy
ITNative) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"INTOP(>>," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LCompl IntTy
ITNative) [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"INTOP(~," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LEq (ATInt IntTy
ITNative)) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"INTOP(==," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSLt (ATInt IntTy
ITNative)) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"INTOP(<," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSLe (ATInt IntTy
ITNative)) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"INTOP(<=," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSGt (ATInt IntTy
ITNative)) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"INTOP(>," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSGe (ATInt IntTy
ITNative)) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"INTOP(>=," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LLt IntTy
ITNative) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"UINTOP(<," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LLe IntTy
ITNative) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"UINTOP(<=," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LGt IntTy
ITNative) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"UINTOP(>," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LGe IntTy
ITNative) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"UINTOP(>=," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LPlus (ATInt IntTy
ITChar)) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (ArithTy -> PrimFn
LPlus (IntTy -> ArithTy
ATInt IntTy
ITNative)) [Reg
l, Reg
r]
doOp String
v (LMinus (ATInt IntTy
ITChar)) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (ArithTy -> PrimFn
LMinus (IntTy -> ArithTy
ATInt IntTy
ITNative)) [Reg
l, Reg
r]
doOp String
v (LTimes (ATInt IntTy
ITChar)) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (ArithTy -> PrimFn
LTimes (IntTy -> ArithTy
ATInt IntTy
ITNative)) [Reg
l, Reg
r]
doOp String
v (LUDiv IntTy
ITChar) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> PrimFn
LUDiv IntTy
ITNative) [Reg
l, Reg
r]
doOp String
v (LSDiv (ATInt IntTy
ITChar)) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (ArithTy -> PrimFn
LSDiv (IntTy -> ArithTy
ATInt IntTy
ITNative)) [Reg
l, Reg
r]
doOp String
v (LURem IntTy
ITChar) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> PrimFn
LURem IntTy
ITNative) [Reg
l, Reg
r]
doOp String
v (LSRem (ATInt IntTy
ITChar)) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (ArithTy -> PrimFn
LSRem (IntTy -> ArithTy
ATInt IntTy
ITNative)) [Reg
l, Reg
r]
doOp String
v (LAnd IntTy
ITChar) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> PrimFn
LAnd IntTy
ITNative) [Reg
l, Reg
r]
doOp String
v (LOr IntTy
ITChar) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> PrimFn
LOr IntTy
ITNative) [Reg
l, Reg
r]
doOp String
v (LXOr IntTy
ITChar) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> PrimFn
LXOr IntTy
ITNative) [Reg
l, Reg
r]
doOp String
v (LSHL IntTy
ITChar) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> PrimFn
LSHL IntTy
ITNative) [Reg
l, Reg
r]
doOp String
v (LLSHR IntTy
ITChar) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> PrimFn
LLSHR IntTy
ITNative) [Reg
l, Reg
r]
doOp String
v (LASHR IntTy
ITChar) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> PrimFn
LASHR IntTy
ITNative) [Reg
l, Reg
r]
doOp String
v (LCompl IntTy
ITChar) [Reg
x] = String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> PrimFn
LCompl IntTy
ITNative) [Reg
x]
doOp String
v (LEq (ATInt IntTy
ITChar)) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (ArithTy -> PrimFn
LEq (IntTy -> ArithTy
ATInt IntTy
ITNative)) [Reg
l, Reg
r]
doOp String
v (LSLt (ATInt IntTy
ITChar)) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (ArithTy -> PrimFn
LSLt (IntTy -> ArithTy
ATInt IntTy
ITNative)) [Reg
l, Reg
r]
doOp String
v (LSLe (ATInt IntTy
ITChar)) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (ArithTy -> PrimFn
LSLe (IntTy -> ArithTy
ATInt IntTy
ITNative)) [Reg
l, Reg
r]
doOp String
v (LSGt (ATInt IntTy
ITChar)) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (ArithTy -> PrimFn
LSGt (IntTy -> ArithTy
ATInt IntTy
ITNative)) [Reg
l, Reg
r]
doOp String
v (LSGe (ATInt IntTy
ITChar)) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (ArithTy -> PrimFn
LSGe (IntTy -> ArithTy
ATInt IntTy
ITNative)) [Reg
l, Reg
r]
doOp String
v (LLt IntTy
ITChar) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> PrimFn
LLt IntTy
ITNative) [Reg
l, Reg
r]
doOp String
v (LLe IntTy
ITChar) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> PrimFn
LLe IntTy
ITNative) [Reg
l, Reg
r]
doOp String
v (LGt IntTy
ITChar) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> PrimFn
LGt IntTy
ITNative) [Reg
l, Reg
r]
doOp String
v (LGe IntTy
ITChar) [Reg
l, Reg
r] = String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> PrimFn
LGe IntTy
ITNative) [Reg
l, Reg
r]
doOp String
v (LPlus ArithTy
ATFloat) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"FLOATOP(+," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LMinus ArithTy
ATFloat) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"FLOATOP(-," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LTimes ArithTy
ATFloat) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"FLOATOP(*," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSDiv ArithTy
ATFloat) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"FLOATOP(/," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LEq ArithTy
ATFloat) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"FLOATBOP(==," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSLt ArithTy
ATFloat) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"FLOATBOP(<," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSLe ArithTy
ATFloat) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"FLOATBOP(<=," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSGt ArithTy
ATFloat) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"FLOATBOP(>," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSGe ArithTy
ATFloat) [Reg
l, Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"FLOATBOP(>=," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LIntFloat IntTy
ITBig) [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_castBigFloat(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LFloatInt IntTy
ITBig) [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_castFloatBig(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LPlus (ATInt IntTy
ITBig)) [Reg
l, Reg
r] = String -> String
wrapGMP (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_bigPlus(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LMinus (ATInt IntTy
ITBig)) [Reg
l, Reg
r] = String -> String
wrapGMP (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_bigMinus(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LTimes (ATInt IntTy
ITBig)) [Reg
l, Reg
r] = String -> String
wrapGMP (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_bigTimes(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSDiv (ATInt IntTy
ITBig)) [Reg
l, Reg
r] = String -> String
wrapGMP (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_bigDivide(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSRem (ATInt IntTy
ITBig)) [Reg
l, Reg
r] = String -> String
wrapGMP (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_bigMod(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LAnd IntTy
ITBig) [Reg
l, Reg
r] = String -> String
wrapGMP (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_bigAnd(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LOr IntTy
ITBig) [Reg
l, Reg
r] = String -> String
wrapGMP (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_bigOr(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSHL IntTy
ITBig) [Reg
l, Reg
r] = String -> String
wrapGMP (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_bigShiftLeft(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LLSHR IntTy
ITBig) [Reg
l, Reg
r] = String -> String
wrapGMP (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_bigLShiftRight(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LASHR IntTy
ITBig) [Reg
l, Reg
r] = String -> String
wrapGMP (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_bigAShiftRight(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LEq (ATInt IntTy
ITBig)) [Reg
l, Reg
r] = String -> String
wrapGMP (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_bigEq(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSLt (ATInt IntTy
ITBig)) [Reg
l, Reg
r] = String -> String
wrapGMP (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_bigLt(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSLe (ATInt IntTy
ITBig)) [Reg
l, Reg
r] = String -> String
wrapGMP (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_bigLe(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSGt (ATInt IntTy
ITBig)) [Reg
l, Reg
r] = String -> String
wrapGMP (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_bigGt(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSGe (ATInt IntTy
ITBig)) [Reg
l, Reg
r] = String -> String
wrapGMP (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_bigGe(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LIntFloat IntTy
ITNative) [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_castIntFloat(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LFloatInt IntTy
ITNative) [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_castFloatInt(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSExt IntTy
ITNative IntTy
ITBig) [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_castIntBig(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LTrunc IntTy
ITBig IntTy
ITNative) [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_castBigInt(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LStrInt IntTy
ITBig) [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_castStrBig(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LIntStr IntTy
ITBig) [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_castBigStr(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LIntStr IntTy
ITNative) [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_castIntStr(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LStrInt IntTy
ITNative) [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_castStrInt(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LIntStr (ITFixed NativeTy
_)) [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_castBitsStr(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v PrimFn
LFloatStr [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_castFloatStr(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v PrimFn
LStrFloat [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_castStrFloat(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LSLt (ATInt (ITFixed NativeTy
ty))) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"SLt" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LSLe (ATInt (ITFixed NativeTy
ty))) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"SLte" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LEq (ATInt (ITFixed NativeTy
ty))) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"Eq" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LSGe (ATInt (ITFixed NativeTy
ty))) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"SGte" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LSGt (ATInt (ITFixed NativeTy
ty))) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"SGt" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LLt (ITFixed NativeTy
ty)) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"Lt" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LLe (ITFixed NativeTy
ty)) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"Lte" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LGe (ITFixed NativeTy
ty)) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"Gte" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LGt (ITFixed NativeTy
ty)) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"Gt" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LSHL (ITFixed NativeTy
ty)) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"Shl" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LLSHR (ITFixed NativeTy
ty)) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"LShr" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LASHR (ITFixed NativeTy
ty)) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"AShr" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LAnd (ITFixed NativeTy
ty)) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"And" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LOr (ITFixed NativeTy
ty)) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"Or" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LXOr (ITFixed NativeTy
ty)) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"Xor" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LCompl (ITFixed NativeTy
ty)) [Reg
x] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"Compl" NativeTy
ty [Reg
x]
doOp String
v (LPlus (ATInt (ITFixed NativeTy
ty))) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"Plus" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LMinus (ATInt (ITFixed NativeTy
ty))) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"Minus" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LTimes (ATInt (ITFixed NativeTy
ty))) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"Times" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LUDiv (ITFixed NativeTy
ty)) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"UDiv" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LSDiv (ATInt (ITFixed NativeTy
ty))) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"SDiv" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LURem (ITFixed NativeTy
ty)) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"URem" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LSRem (ATInt (ITFixed NativeTy
ty))) [Reg
x, Reg
y] = String -> String -> NativeTy -> [Reg] -> String
bitOp String
v String
"SRem" NativeTy
ty [Reg
x, Reg
y]
doOp String
v (LSExt (ITFixed NativeTy
from) IntTy
ITBig) [Reg
x]
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKBIGSI(vm, (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NativeTy -> String
signedTy NativeTy
from String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") GETBITS" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (NativeTy -> Int
nativeTyWidth NativeTy
from) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))"
doOp String
v (LSExt IntTy
ITNative (ITFixed NativeTy
to)) [Reg
x]
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_b" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (NativeTy -> Int
nativeTyWidth NativeTy
to) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"const(vm, GETINT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))"
doOp String
v (LSExt IntTy
ITChar (ITFixed NativeTy
to)) [Reg
x]
= String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> IntTy -> PrimFn
LSExt IntTy
ITNative (NativeTy -> IntTy
ITFixed NativeTy
to)) [Reg
x]
doOp String
v (LSExt (ITFixed NativeTy
from) IntTy
ITNative) [Reg
x]
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKINT((i_int)((" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NativeTy -> String
signedTy NativeTy
from String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") GETBITS" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (NativeTy -> Int
nativeTyWidth NativeTy
from) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")))"
doOp String
v (LSExt (ITFixed NativeTy
from) IntTy
ITChar) [Reg
x]
= String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> IntTy -> PrimFn
LSExt (NativeTy -> IntTy
ITFixed NativeTy
from) IntTy
ITNative) [Reg
x]
doOp String
v (LSExt (ITFixed NativeTy
from) (ITFixed NativeTy
to)) [Reg
x]
| NativeTy -> Int
nativeTyWidth NativeTy
from Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< NativeTy -> Int
nativeTyWidth NativeTy
to = String -> String -> NativeTy -> NativeTy -> Reg -> String
bitCoerce String
v String
"S" NativeTy
from NativeTy
to Reg
x
doOp String
v (LZExt IntTy
ITNative (ITFixed NativeTy
to)) [Reg
x]
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_b" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (NativeTy -> Int
nativeTyWidth NativeTy
to) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"const(vm, (uintptr_t)GETINT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))"
doOp String
v (LZExt IntTy
ITChar (ITFixed NativeTy
to)) [Reg
x]
= String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> IntTy -> PrimFn
LZExt IntTy
ITNative (NativeTy -> IntTy
ITFixed NativeTy
to)) [Reg
x]
doOp String
v (LZExt (ITFixed NativeTy
from) IntTy
ITNative) [Reg
x]
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKINT((i_int)GETBITS" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (NativeTy -> Int
nativeTyWidth NativeTy
from) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))"
doOp String
v (LZExt (ITFixed NativeTy
from) IntTy
ITChar) [Reg
x]
= String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> IntTy -> PrimFn
LZExt (NativeTy -> IntTy
ITFixed NativeTy
from) IntTy
ITNative) [Reg
x]
doOp String
v (LZExt (ITFixed NativeTy
from) IntTy
ITBig) [Reg
x]
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKBIGUI(vm, GETBITS" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (NativeTy -> Int
nativeTyWidth NativeTy
from) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))"
doOp String
v (LZExt IntTy
ITNative IntTy
ITBig) [Reg
x]
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKBIGUI(vm, (uintptr_t)GETINT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))"
doOp String
v (LZExt (ITFixed NativeTy
from) (ITFixed NativeTy
to)) [Reg
x]
| NativeTy -> Int
nativeTyWidth NativeTy
from Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< NativeTy -> Int
nativeTyWidth NativeTy
to = String -> String -> NativeTy -> NativeTy -> Reg -> String
bitCoerce String
v String
"Z" NativeTy
from NativeTy
to Reg
x
doOp String
v (LTrunc IntTy
ITNative (ITFixed NativeTy
to)) [Reg
x]
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_b" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (NativeTy -> Int
nativeTyWidth NativeTy
to) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"const(vm, GETINT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))"
doOp String
v (LTrunc IntTy
ITChar (ITFixed NativeTy
to)) [Reg
x]
= String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> IntTy -> PrimFn
LTrunc IntTy
ITNative (NativeTy -> IntTy
ITFixed NativeTy
to)) [Reg
x]
doOp String
v (LTrunc (ITFixed NativeTy
from) IntTy
ITNative) [Reg
x]
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKINT((i_int)GETBITS" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (NativeTy -> Int
nativeTyWidth NativeTy
from) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))"
doOp String
v (LTrunc (ITFixed NativeTy
from) IntTy
ITChar) [Reg
x]
= String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> IntTy -> PrimFn
LTrunc (NativeTy -> IntTy
ITFixed NativeTy
from) IntTy
ITNative) [Reg
x]
doOp String
v (LTrunc IntTy
ITBig (ITFixed NativeTy
IT64)) [Reg
x]
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_b64const(vm, ISINT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") ? GETINT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") : idris_truncBigB64(GETMPZ(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")))"
doOp String
v (LTrunc IntTy
ITBig (ITFixed NativeTy
to)) [Reg
x]
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_b" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (NativeTy -> Int
nativeTyWidth NativeTy
to) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"const(vm, ISINT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") ? GETINT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") : mpz_get_ui(GETMPZ(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")))"
doOp String
v (LTrunc (ITFixed NativeTy
from) (ITFixed NativeTy
to)) [Reg
x]
| NativeTy -> Int
nativeTyWidth NativeTy
from Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> NativeTy -> Int
nativeTyWidth NativeTy
to = String -> String -> NativeTy -> NativeTy -> Reg -> String
bitCoerce String
v String
"T" NativeTy
from NativeTy
to Reg
x
doOp String
v PrimFn
LFExp [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
flUnOp String
"exp" (Reg -> String
creg Reg
x)
doOp String
v PrimFn
LFLog [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
flUnOp String
"log" (Reg -> String
creg Reg
x)
doOp String
v PrimFn
LFSin [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
flUnOp String
"sin" (Reg -> String
creg Reg
x)
doOp String
v PrimFn
LFCos [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
flUnOp String
"cos" (Reg -> String
creg Reg
x)
doOp String
v PrimFn
LFTan [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
flUnOp String
"tan" (Reg -> String
creg Reg
x)
doOp String
v PrimFn
LFASin [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
flUnOp String
"asin" (Reg -> String
creg Reg
x)
doOp String
v PrimFn
LFACos [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
flUnOp String
"acos" (Reg -> String
creg Reg
x)
doOp String
v PrimFn
LFATan [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
flUnOp String
"atan" (Reg -> String
creg Reg
x)
doOp String
v PrimFn
LFSqrt [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
flUnOp String
"sqrt" (Reg -> String
creg Reg
x)
doOp String
v PrimFn
LFFloor [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
flUnOp String
"floor" (Reg -> String
creg Reg
x)
doOp String
v PrimFn
LFCeil [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
flUnOp String
"ceil" (Reg -> String
creg Reg
x)
doOp String
v PrimFn
LFNegate [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKFLOAT(vm, -GETFLOAT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Reg -> String
creg Reg
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))"
doOp String
v PrimFn
LFATan2 [Reg
y, Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKFLOAT(vm, atan2(GETFLOAT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"), GETFLOAT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")))"
doOp String
v PrimFn
LStrConcat [Reg
l,Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_concat(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v PrimFn
LStrLt [Reg
l,Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_strlt(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v PrimFn
LStrEq [Reg
l,Reg
r] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_streq(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v PrimFn
LReadStr [Reg
_] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_readStr(vm, stdin)"
doOp String
v PrimFn
LWriteStr [Reg
_,Reg
s]
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKINT((i_int)(idris_writeStr(stdout"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
",GETSTR("
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))))"
doOp String
v PrimFn
LStrHead [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_strHead(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v PrimFn
LStrTail [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_strTail(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v PrimFn
LStrCons [Reg
x, Reg
y] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_strCons(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v PrimFn
LStrIndex [Reg
x, Reg
y] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_strIndex(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v PrimFn
LStrRev [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_strRev(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v PrimFn
LStrLen [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_strlen(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v PrimFn
LStrSubstr [Reg
x,Reg
y,Reg
z] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_substr(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
z String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v PrimFn
LFork [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKPTR(vm, vmThread(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
cname (Int -> String -> Name
sMN Int
0 String
"EVAL") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))"
doOp String
v PrimFn
LPar [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x
doOp String
v (LChInt IntTy
ITNative) [Reg]
args = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg ([Reg] -> Reg
forall a. HasCallStack => [a] -> a
last [Reg]
args)
doOp String
v (LChInt IntTy
ITChar) [Reg]
args = String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> PrimFn
LChInt IntTy
ITNative) [Reg]
args
doOp String
v (LIntCh IntTy
ITNative) [Reg]
args = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg ([Reg] -> Reg
forall a. HasCallStack => [a] -> a
last [Reg]
args)
doOp String
v (LIntCh IntTy
ITChar) [Reg]
args = String -> PrimFn -> [Reg] -> String
doOp String
v (IntTy -> PrimFn
LIntCh IntTy
ITNative) [Reg]
args
doOp String
v PrimFn
LSystemInfo [Reg
x] = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_systemInfo(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v PrimFn
LCrash [Reg
x] = String
"idris_crash(GETSTR(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))"
doOp String
v PrimFn
LNoOp [Reg]
args = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg ([Reg] -> Reg
forall a. HasCallStack => [a] -> a
last [Reg]
args)
doOp String
v (LExternal Name
rf) [Reg
_,Reg
x]
| Name
rf Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__readFile"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_readStr(vm, GETPTR(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))"
doOp String
v (LExternal Name
rf) [Reg
_,Reg
len,Reg
x]
| Name
rf Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__readChars"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_readChars(vm, GETINT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
len String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"), GETPTR(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))"
doOp String
v (LExternal Name
wf) [Reg
_,Reg
x,Reg
s]
| Name
wf Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__writeFile"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKINT((i_int)(idris_writeStr(GETPTR(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"),GETSTR("
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))))"
doOp String
v (LExternal Name
si) [] | Name
si Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__stdin" = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKPTR(vm, stdin)"
doOp String
v (LExternal Name
so) [] | Name
so Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__stdout" = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKPTR(vm, stdout)"
doOp String
v (LExternal Name
se) [] | Name
se Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__stderr" = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKPTR(vm, stderr)"
doOp String
v (LExternal Name
vm) [Reg
_] | Name
vm Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__vm" = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKPTR(vm, vm)"
doOp String
v (LExternal Name
nul) [] | Name
nul Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__null" = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKPTR(vm, NULL)"
doOp String
v (LExternal Name
nul) [] | Name
nul Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__managedNull" = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKPTR(vm, NULL)"
doOp String
v (LExternal Name
eqp) [Reg
x, Reg
y] | Name
eqp Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__eqPtr"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKINT((i_int)(GETPTR(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") == GETPTR(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")))"
doOp String
v (LExternal Name
eqp) [Reg
x, Reg
y] | Name
eqp Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__eqManagedPtr"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKINT((i_int)(GETMPTR(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") == GETMPTR(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")))"
doOp String
v (LExternal Name
rp) [Reg
p, Reg
i] | Name
rp Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__registerPtr"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKMPTR(vm, GETPTR(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"), GETINT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))"
doOp String
v (LExternal Name
pk) [Reg
_, Reg
p, Reg
o] | Name
pk Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__peek8"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_peekB8(vm," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
o String -> String -> String
forall a. [a] -> [a] -> [a]
++String
")"
doOp String
v (LExternal Name
pk) [Reg
_, Reg
p, Reg
o, Reg
x] | Name
pk Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__poke8"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_pokeB8(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LExternal Name
pk) [Reg
_, Reg
p, Reg
o] | Name
pk Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__peek16"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_peekB16(vm," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
o String -> String -> String
forall a. [a] -> [a] -> [a]
++String
")"
doOp String
v (LExternal Name
pk) [Reg
_, Reg
p, Reg
o, Reg
x] | Name
pk Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__poke16"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_pokeB16(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LExternal Name
pk) [Reg
_, Reg
p, Reg
o] | Name
pk Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__peek32"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_peekB32(vm," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
o String -> String -> String
forall a. [a] -> [a] -> [a]
++String
")"
doOp String
v (LExternal Name
pk) [Reg
_, Reg
p, Reg
o, Reg
x] | Name
pk Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__poke32"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_pokeB32(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LExternal Name
pk) [Reg
_, Reg
p, Reg
o] | Name
pk Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__peek64"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_peekB64(vm," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
o String -> String -> String
forall a. [a] -> [a] -> [a]
++String
")"
doOp String
v (LExternal Name
pk) [Reg
_, Reg
p, Reg
o, Reg
x] | Name
pk Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__poke64"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_pokeB64(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LExternal Name
pk) [Reg
_, Reg
p, Reg
o] | Name
pk Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__peekPtr"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_peekPtr(vm," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
o String -> String -> String
forall a. [a] -> [a] -> [a]
++String
")"
doOp String
v (LExternal Name
pk) [Reg
_, Reg
p, Reg
o, Reg
x] | Name
pk Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__pokePtr"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_pokePtr(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LExternal Name
pk) [Reg
_, Reg
p, Reg
o, Reg
x] | Name
pk Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__pokeDouble"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_pokeDouble(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LExternal Name
pk) [Reg
_, Reg
p, Reg
o] | Name
pk Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__peekDouble"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_peekDouble(vm," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
o String -> String -> String
forall a. [a] -> [a] -> [a]
++String
")"
doOp String
v (LExternal Name
pk) [Reg
_, Reg
p, Reg
o, Reg
x] | Name
pk Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__pokeSingle"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_pokeSingle(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
doOp String
v (LExternal Name
pk) [Reg
_, Reg
p, Reg
o] | Name
pk Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__peekSingle"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"idris_peekSingle(vm," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
o String -> String -> String
forall a. [a] -> [a] -> [a]
++String
")"
doOp String
v (LExternal Name
pk) [] | Name
pk Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__sizeofPtr"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKINT(sizeof(void*))"
doOp String
v (LExternal Name
mpt) [Reg
p] | Name
mpt Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__asPtr"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKPTR(vm, GETMPTR("String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
p String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"))"
doOp String
v (LExternal Name
offs) [Reg
p, Reg
n] | Name
offs Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"prim__ptrOffset"
= String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MKPTR(vm, (void *)((char *)GETPTR(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") + GETINT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
creg Reg
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")))"
doOp String
_ PrimFn
op [Reg]
args = String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"doOp not implemented (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (PrimFn, [Reg]) -> String
forall a. Show a => a -> String
show (PrimFn
op, [Reg]
args) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
flUnOp :: String -> String -> String
flUnOp :: String -> String -> String
flUnOp String
name String
val = String
"MKFLOAT(vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(GETFLOAT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
val String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")))"
ifaceC :: Export -> String
ifaceC :: Export -> String
ifaceC (ExportData FDesc
n) = String
"typedef VAL " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FDesc -> String
cdesc FDesc
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n"
ifaceC (ExportFun Name
n FDesc
cn FDesc
ret [FDesc]
args)
= FDesc -> String
ctype FDesc
ret String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FDesc -> String
cdesc FDesc
cn String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"(VM* vm" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(String, FDesc)] -> String
showArgs ([String] -> [FDesc] -> [(String, FDesc)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
argNames [FDesc]
args) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") {\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> [(String, FDesc)] -> FDesc -> String
mkBody Name
n ([String] -> [FDesc] -> [(String, FDesc)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
argNames [FDesc]
args) FDesc
ret String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}\n\n"
where showArgs :: [(String, FDesc)] -> String
showArgs [] = String
""
showArgs ((String
n, FDesc
t) : [(String, FDesc)]
ts) = String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FDesc -> String
ctype FDesc
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
[(String, FDesc)] -> String
showArgs [(String, FDesc)]
ts
argNames :: [String]
argNames = (String -> String -> String) -> [String] -> [String] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (String -> [String]
forall a. a -> [a]
repeat String
"arg") ((Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
forall a. Show a => a -> String
show [Integer
0..])
mkBody :: Name -> [(String, FDesc)] -> FDesc -> String
mkBody Name
n [(String, FDesc)]
as_in FDesc
t
= Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"INITFRAME;\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"RESERVE(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ([(String, FDesc)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, FDesc)]
as) Int
3) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Integer -> [(String, FDesc)] -> String
forall {t}. (Show t, Num t) => t -> [(String, FDesc)] -> String
push Integer
0 [(String, FDesc)]
as String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall {p}. p -> String
call Name
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ FDesc -> String
retval FDesc
t
where
as :: [(String, FDesc)]
as = case FDesc
t of
FIO FDesc
t -> [(String, FDesc)]
as_in [(String, FDesc)] -> [(String, FDesc)] -> [(String, FDesc)]
forall a. [a] -> [a] -> [a]
++ [(String
"NULL", FDesc
FUnknown)]
FDesc
_ -> [(String, FDesc)]
as_in
push :: t -> [(String, FDesc)] -> String
push t
i [] = String
""
push t
i ((String
n, FDesc
t) : [(String, FDesc)]
ts) = Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ FType -> String -> String -> String
c_irts (FDesc -> FType
toFType FDesc
t)
(String
"TOP(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ t -> String
forall a. Show a => a -> String
show t
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") = ") String
n
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ t -> [(String, FDesc)] -> String
push (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) [(String, FDesc)]
ts
call :: p -> String
call p
_ = Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"STOREOLD;\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"BASETOP(0);\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"ADDTOP(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([(String, FDesc)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, FDesc)]
as) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"CALL(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
cname Name
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n"
retval :: FDesc -> String
retval (FIO FDesc
t) = FDesc -> String
retval FDesc
t
retval FDesc
t = Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"return " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FType -> String -> String
irts_c (FDesc -> FType
toFType FDesc
t) String
"RVAL" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n"
ctype :: FDesc -> String
ctype (FCon Name
c)
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_Str" = String
"char*"
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_Float" = String
"float"
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_Ptr" = String
"void*"
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_MPtr" = String
"void*"
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_Unit" = String
"void"
ctype (FApp Name
c [FDesc
_,FDesc
ity])
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_IntT" = FDesc -> String
carith FDesc
ity
ctype (FApp Name
c [FDesc
_])
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_Any" = String
"VAL"
ctype (FStr String
s) = String
s
ctype FDesc
FUnknown = String
"void*"
ctype (FIO FDesc
t) = FDesc -> String
ctype FDesc
t
ctype FDesc
t = String -> String
forall a. HasCallStack => String -> a
error String
"Can't happen: Not a valid interface type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FDesc -> String
forall a. Show a => a -> String
show FDesc
t
carith :: FDesc -> String
carith (FCon Name
i)
| Name
i Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_IntChar" = String
"char"
| Name
i Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_IntNative" = String
"int"
| Name
i Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_IntBits8" = String
"uint8_t"
| Name
i Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_IntBits16" = String
"uint16_t"
| Name
i Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_IntBits32" = String
"uint32_t"
| Name
i Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_IntBits64" = String
"uint64_t"
carith FDesc
t = String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"Can't happen: Not an exportable arithmetic type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FDesc -> String
forall a. Show a => a -> String
show FDesc
t
cdesc :: FDesc -> String
cdesc (FStr String
s) = String
s
cdesc FDesc
s = String -> String
forall a. HasCallStack => String -> a
error String
"Can't happen: Not a valid C name"
codegenH :: [ExportIFace] -> IO ()
codegenH :: [ExportIFace] -> IO ()
codegenH [ExportIFace]
es = (ExportIFace -> IO ()) -> [ExportIFace] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ExportIFace -> IO ()
writeIFace [ExportIFace]
es
writeIFace :: ExportIFace -> IO ()
writeIFace :: ExportIFace -> IO ()
writeIFace (Export Name
ffic String
hdr [Export]
exps)
| Name
ffic Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> [String] -> Name
sNS (String -> Name
sUN String
"FFI_C") [String
"FFI_C"]
= do let hfile :: String
hfile = String
"#ifndef " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
hdr_guard String
hdr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#define " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
hdr_guard String
hdr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#include <idris_rts.h>\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
(Export -> String) -> [Export] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Export -> String
hdr_export [Export]
exps String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#endif\n\n"
String -> String -> IO ()
writeFile String
hdr String
hfile
| Bool
otherwise = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
hdr_guard :: String -> String
hdr_guard String
x = String
"__" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
hchar String
x
where hchar :: Char -> Char
hchar Char
x | Char -> Bool
isAlphaNum Char
x = Char -> Char
toUpper Char
x
hchar Char
_ = Char
'_'
hdr_export :: Export -> String
hdr_export :: Export -> String
hdr_export (ExportData FDesc
n) = String
"typedef VAL " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FDesc -> String
cdesc FDesc
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n"
hdr_export (ExportFun Name
n FDesc
cn FDesc
ret [FDesc]
args)
= FDesc -> String
ctype FDesc
ret String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FDesc -> String
cdesc FDesc
cn String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"(VM* vm" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(String, FDesc)] -> String
showArgs ([String] -> [FDesc] -> [(String, FDesc)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
argNames [FDesc]
args) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n"
where showArgs :: [(String, FDesc)] -> String
showArgs [] = String
""
showArgs ((String
n, FDesc
t) : [(String, FDesc)]
ts) = String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FDesc -> String
ctype FDesc
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
[(String, FDesc)] -> String
showArgs [(String, FDesc)]
ts
argNames :: [String]
argNames = (String -> String -> String) -> [String] -> [String] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (String -> [String]
forall a. a -> [a]
repeat String
"arg") ((Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
forall a. Show a => a -> String
show [Integer
0..])
genWrappers :: [(Name, [BC])] -> String
genWrappers :: [(Name, [BC])] -> String
genWrappers [(Name, [BC])]
bcs = let
tags :: [(FDesc, Int)]
tags = ((FDesc, Int) -> (FDesc, Int) -> Bool)
-> [(FDesc, Int)] -> [(FDesc, Int)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\(FDesc, Int)
x (FDesc, Int)
y -> (FDesc, Int) -> Int
forall a b. (a, b) -> b
snd (FDesc, Int)
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (FDesc, Int) -> Int
forall a b. (a, b) -> b
snd (FDesc, Int)
y) ([(FDesc, Int)] -> [(FDesc, Int)])
-> [(FDesc, Int)] -> [(FDesc, Int)]
forall a b. (a -> b) -> a -> b
$ ((Name, [BC]) -> [(FDesc, Int)])
-> [(Name, [BC])] -> [(FDesc, Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([BC] -> [(FDesc, Int)]
getCallback ([BC] -> [(FDesc, Int)])
-> ((Name, [BC]) -> [BC]) -> (Name, [BC]) -> [(FDesc, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, [BC]) -> [BC]
forall a b. (a, b) -> b
snd) [(Name, [BC])]
bcs
in
case [(FDesc, Int)]
tags of
[] -> String
""
[(FDesc, Int)]
t -> ((FDesc, Int) -> String) -> [(FDesc, Int)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FDesc, Int) -> String
genWrapper [(FDesc, Int)]
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(FDesc, Int)] -> String
genDispatcher [(FDesc, Int)]
t
genDispatcher :: [(FDesc, Int)] -> String
genDispatcher :: [(FDesc, Int)] -> String
genDispatcher [(FDesc, Int)]
tags = String
"void* _idris_get_wrapper(VAL con)\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"{\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"switch(TAG(con)) {\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
((FDesc, Int) -> String) -> [(FDesc, Int)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FDesc, Int) -> String
forall {a}. (a, Int) -> String
makeSwitch [(FDesc, Int)]
tags String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"fprintf(stderr, \"No wrapper for callback\");\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"exit(-1);\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"}\n\n"
where
makeSwitch :: (a, Int) -> String
makeSwitch (a
_, Int
tag) =
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"case " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
tag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"return (void*) &" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
wrapperName Int
tag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n"
genWrapper :: (FDesc, Int) -> String
genWrapper :: (FDesc, Int) -> String
genWrapper (FDesc
desc, Int
tag) | (FDesc -> FType
toFType FDesc
desc) FType -> FType -> Bool
forall a. Eq a => a -> a -> Bool
== FType
FFunctionIO =
String -> String
forall a. HasCallStack => String -> a
error String
"Cannot create C callbacks for IO functions, wrap them with unsafePerformIO.\n"
genWrapper (FDesc
desc, Int
tag) = String
ret String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
wrapperName Int
tag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++
[((String, FDesc), Integer)] -> String
forall {a} {b}. Show a => [((String, b), a)] -> String
renderArgs [((String, FDesc), Integer)]
argList String -> String -> String
forall a. [a] -> [a] -> [a]
++String
")\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"{\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
(if String
ret String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"void" then Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ret String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ret;\n" else String
"") String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"VM* vm = get_vm();\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"if (vm == NULL) {\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"vm = idris_vm();\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"INITFRAME;\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"RESERVE(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"allocCon(REG1, vm, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
tag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
",0 , 0);\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"TOP(0) = REG1;\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
[((String, FDesc), Integer)] -> String
forall {a} {a}. Show a => [((a, FDesc), a)] -> String
applyArgs [((String, FDesc), Integer)]
argList String -> String -> String
forall a. [a] -> [a] -> [a]
++
if String
ret String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"void"
then Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"ret = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FType -> String -> String
irts_c (FDesc -> FType
toFType FDesc
ft) String
"RVAL" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"return ret;\n}\n\n"
else String
"}\n\n"
where
(String
ret, FDesc
ft) = FDesc -> (String, FDesc)
rty FDesc
desc
argList :: [((String, FDesc), Integer)]
argList = [(String, FDesc)] -> [Integer] -> [((String, FDesc), Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip (FDesc -> [(String, FDesc)]
args FDesc
desc) [Integer
0..]
len :: Int
len = [((String, FDesc), Integer)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [((String, FDesc), Integer)]
argList
applyArgs :: [((a, FDesc), a)] -> String
applyArgs (((a, FDesc), a)
x:((a, FDesc), a)
y:[((a, FDesc), a)]
xs) = Integer -> [((a, FDesc), a)] -> String
forall {t} {a} {a}.
(Show t, Show a, Num t) =>
t -> [((a, FDesc), a)] -> String
push Integer
1 [((a, FDesc), a)
x] String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"STOREOLD;\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"BASETOP(0);\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"ADDTOP(2);\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"CALL(_idris__123_APPLY_95_0_125_);\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"TOP(0)=REG1;\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
[((a, FDesc), a)] -> String
applyArgs (((a, FDesc), a)
y((a, FDesc), a) -> [((a, FDesc), a)] -> [((a, FDesc), a)]
forall a. a -> [a] -> [a]
:[((a, FDesc), a)]
xs)
applyArgs [((a, FDesc), a)]
x = Integer -> [((a, FDesc), a)] -> String
forall {t} {a} {a}.
(Show t, Show a, Num t) =>
t -> [((a, FDesc), a)] -> String
push Integer
1 [((a, FDesc), a)]
x String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"STOREOLD;\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"BASETOP(0);\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"ADDTOP(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([((a, FDesc), a)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [((a, FDesc), a)]
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"CALL(_idris__123_APPLY_95_0_125_);\n"
renderArgs :: [((String, b), a)] -> String
renderArgs [] = String
"void"
renderArgs [((String
s, b
_), a
n)] = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" a" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (a -> String
forall a. Show a => a -> String
show a
n)
renderArgs (((String
s, b
_), a
n):[((String, b), a)]
xs) = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" a" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (a -> String
forall a. Show a => a -> String
show a
n) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++
[((String, b), a)] -> String
renderArgs [((String, b), a)]
xs
rty :: FDesc -> (String, FDesc)
rty (FApp Name
c [FDesc
_,FDesc
ty])
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_FnBase" = (FDesc -> String
ctype FDesc
ty, FDesc
ty)
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_FnIO" = (FDesc -> String
ctype FDesc
ty, FDesc
ty)
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_FnT" = FDesc -> (String, FDesc)
rty FDesc
ty
rty (FApp Name
c [FDesc
_,FDesc
_,FDesc
ty,FDesc
fn])
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_Fn" = FDesc -> (String, FDesc)
rty FDesc
fn
rty FDesc
x = (String
"", FDesc
x)
args :: FDesc -> [(String, FDesc)]
args (FApp Name
c [FDesc
_,FDesc
ty])
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_FnBase" = []
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_FnIO" = []
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_FnT" = FDesc -> [(String, FDesc)]
args FDesc
ty
args (FApp Name
c [FDesc
_,FDesc
_,FDesc
ty,FDesc
fn])
| FDesc -> FType
toFType FDesc
ty FType -> FType -> Bool
forall a. Eq a => a -> a -> Bool
== FType
FUnit = []
| Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
sUN String
"C_Fn" = (FDesc -> String
ctype FDesc
ty, FDesc
ty) (String, FDesc) -> [(String, FDesc)] -> [(String, FDesc)]
forall a. a -> [a] -> [a]
: FDesc -> [(String, FDesc)]
args FDesc
fn
args FDesc
_ = []
push :: t -> [((a, FDesc), a)] -> String
push t
i [] = String
""
push t
i (((a
c, FDesc
t), a
n) : [((a, FDesc), a)]
ts) = Int -> String
indent Int
1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ FType -> String -> String -> String
c_irts (FDesc -> FType
toFType FDesc
t)
(String
"TOP(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ t -> String
forall a. Show a => a -> String
show t
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") = ") (String
"a" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n)
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ t -> [((a, FDesc), a)] -> String
push (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) [((a, FDesc), a)]
ts
wrapperName :: Int -> String
wrapperName :: Int -> String
wrapperName Int
tag = String
"_idris_wrapper_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
tag
getCallback :: [BC] -> [(FDesc, Int)]
getCallback :: [BC] -> [(FDesc, Int)]
getCallback [BC]
bc = [BC] -> [(FDesc, Int)]
getCallback' ([BC] -> [BC]
forall a. [a] -> [a]
reverse [BC]
bc)
where
getCallback' :: [BC] -> [(FDesc, Int)]
getCallback' (BC
x:[BC]
xs) = case BC -> [(FDesc, Reg)]
hasCallback BC
x of
[] -> [BC] -> [(FDesc, Int)]
getCallback' [BC]
xs
[(FDesc, Reg)]
cbs -> case [(FDesc, Reg)] -> [BC] -> [(FDesc, Int)]
forall {a}. [(a, Reg)] -> [BC] -> [(a, Int)]
findCons [(FDesc, Reg)]
cbs [BC]
xs of
[] -> String -> [(FDesc, Int)]
forall a. HasCallStack => String -> a
error String
"Idris function couldn't be wrapped."
[(FDesc, Int)]
x -> [(FDesc, Int)]
x
getCallback' [] = []
findCons :: [(a, Reg)] -> [BC] -> [(a, Int)]
findCons ((a, Reg)
c:[(a, Reg)]
cs) [BC]
xs = (a, Reg) -> [BC] -> [(a, Int)]
forall {a}. (a, Reg) -> [BC] -> [(a, Int)]
findCon (a, Reg)
c [BC]
xs [(a, Int)] -> [(a, Int)] -> [(a, Int)]
forall a. [a] -> [a] -> [a]
++ [(a, Reg)] -> [BC] -> [(a, Int)]
findCons [(a, Reg)]
cs [BC]
xs
findCons [] [BC]
_ = []
findCon :: (a, Reg) -> [BC] -> [(a, Int)]
findCon (a, Reg)
c ((MKCON Reg
l Maybe Reg
loc Int
tag [Reg]
args):[BC]
xs) | (a, Reg) -> Reg
forall a b. (a, b) -> b
snd (a, Reg)
c Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
l =
if [Reg] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Reg]
args
then [((a, Reg) -> a
forall a b. (a, b) -> a
fst (a, Reg)
c, Int
tag)]
else String -> [(a, Int)]
forall a. HasCallStack => String -> a
error String
"Can't wrap a closure as callback."
findCon (a, Reg)
c (BC
_:[BC]
xs) = (a, Reg) -> [BC] -> [(a, Int)]
findCon (a, Reg)
c [BC]
xs
findCon (a, Reg)
c [] = []
hasCallback :: BC -> [(FDesc, Reg)]
hasCallback :: BC -> [(FDesc, Reg)]
hasCallback (FOREIGNCALL Reg
l FDesc
rty (FStr String
fn) [(FDesc, Reg)]
args) = ((FDesc, Reg) -> Bool) -> [(FDesc, Reg)] -> [(FDesc, Reg)]
forall a. (a -> Bool) -> [a] -> [a]
filter (FDesc, Reg) -> Bool
forall {b}. (FDesc, b) -> Bool
isFn [(FDesc, Reg)]
args
where
isFn :: (FDesc, b) -> Bool
isFn (FDesc
desc,b
_) = case FDesc -> FType
toFType FDesc
desc of
FType
FFunction -> Bool
True
FType
FFunctionIO -> Bool
True
FType
_ -> Bool
False
hasCallback BC
_ = []