{-|
Module      : IRTS.DumpBC
Description : Serialise Idris to its IBC format.

License     : BSD3
Maintainer  : The Idris Community.
-}
module IRTS.DumpBC where

import Idris.Core.TT
import IRTS.Bytecode
import IRTS.Simplified

import Data.List

interMap :: [a] -> [b] -> (a -> [b]) -> [b]
interMap :: forall a b. [a] -> [b] -> (a -> [b]) -> [b]
interMap [a]
xs [b]
y a -> [b]
f = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. a -> [a] -> [a]
intersperse [b]
y (forall a b. (a -> b) -> [a] -> [b]
map a -> [b]
f [a]
xs))

indent :: Int -> String
indent :: Int -> String
indent Int
n = forall a. Int -> a -> [a]
replicate (Int
nforall a. Num a => a -> a -> a
*Int
4) Char
' '

serializeReg :: Reg -> String
serializeReg :: Reg -> String
serializeReg (L Int
n) = String
"L" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
serializeReg (T Int
n) = String
"T" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
serializeReg Reg
r = forall a. Show a => a -> String
show Reg
r

serializeCase :: Show a => Int -> (a, [BC]) -> String
serializeCase :: forall a. Show a => Int -> (a, [BC]) -> String
serializeCase Int
n (a
x, [BC]
bcs) =
  Int -> String
indent Int
n forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
x forall a. [a] -> [a] -> [a]
++ String
":\n" forall a. [a] -> [a] -> [a]
++ forall a b. [a] -> [b] -> (a -> [b]) -> [b]
interMap [BC]
bcs String
"\n" (Int -> BC -> String
serializeBC (Int
n forall a. Num a => a -> a -> a
+ Int
1))

serializeDefault :: Int -> [BC] -> String
serializeDefault :: Int -> [BC] -> String
serializeDefault Int
n [BC]
bcs =
  Int -> String
indent Int
n forall a. [a] -> [a] -> [a]
++ String
"default:\n" forall a. [a] -> [a] -> [a]
++ forall a b. [a] -> [b] -> (a -> [b]) -> [b]
interMap [BC]
bcs String
"\n" (Int -> BC -> String
serializeBC (Int
n forall a. Num a => a -> a -> a
+ Int
1))

serializeBC :: Int -> BC -> String
serializeBC :: Int -> BC -> String
serializeBC Int
n BC
bc = Int -> String
indent Int
n forall a. [a] -> [a] -> [a]
++
    case BC
bc of
      ASSIGN Reg
a Reg
b ->
        String
"ASSIGN " forall a. [a] -> [a] -> [a]
++ Reg -> String
serializeReg Reg
a forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ Reg -> String
serializeReg Reg
b
      ASSIGNCONST Reg
a Const
b ->
        String
"ASSIGNCONST " forall a. [a] -> [a] -> [a]
++ Reg -> String
serializeReg Reg
a forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Const
b
      UPDATE Reg
a Reg
b ->
        String
"UPDATE " forall a. [a] -> [a] -> [a]
++ Reg -> String
serializeReg Reg
a forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ Reg -> String
serializeReg Reg
b
      MKCON Reg
a Maybe Reg
Nothing Int
b [Reg]
xs ->
        String
"MKCON " forall a. [a] -> [a] -> [a]
++ Reg -> String
serializeReg Reg
a forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
b forall a. [a] -> [a] -> [a]
++ String
" [" forall a. [a] -> [a] -> [a]
++ (forall a b. [a] -> [b] -> (a -> [b]) -> [b]
interMap [Reg]
xs String
", " Reg -> String
serializeReg) forall a. [a] -> [a] -> [a]
++ String
"]"
      MKCON Reg
a (Just Reg
r) Int
b [Reg]
xs ->
        String
"MKCON@" forall a. [a] -> [a] -> [a]
++ Reg -> String
serializeReg Reg
r forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ Reg -> String
serializeReg Reg
a forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
b forall a. [a] -> [a] -> [a]
++ String
" [" forall a. [a] -> [a] -> [a]
++ (forall a b. [a] -> [b] -> (a -> [b]) -> [b]
interMap [Reg]
xs String
", " Reg -> String
serializeReg) forall a. [a] -> [a] -> [a]
++ String
"]"
      CASE Bool
safe Reg
r [(Int, [BC])]
cases Maybe [BC]
def ->
        String
"CASE " forall a. [a] -> [a] -> [a]
++ Reg -> String
serializeReg Reg
r forall a. [a] -> [a] -> [a]
++ String
":\n" forall a. [a] -> [a] -> [a]
++ forall a b. [a] -> [b] -> (a -> [b]) -> [b]
interMap [(Int, [BC])]
cases String
"\n" (forall a. Show a => Int -> (a, [BC]) -> String
serializeCase (Int
n forall a. Num a => a -> a -> a
+ Int
1)) forall a. [a] -> [a] -> [a]
++
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\[BC]
def' -> String
"\n" forall a. [a] -> [a] -> [a]
++ Int -> [BC] -> String
serializeDefault (Int
n forall a. Num a => a -> a -> a
+ Int
1) [BC]
def') Maybe [BC]
def
      PROJECT Reg
a Int
b Int
c ->
        String
"PROJECT " forall a. [a] -> [a] -> [a]
++ Reg -> String
serializeReg Reg
a forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
b forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
c
      PROJECTINTO Reg
a Reg
b Int
c ->
        String
"PROJECTINTO " forall a. [a] -> [a] -> [a]
++ Reg -> String
serializeReg Reg
a forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ Reg -> String
serializeReg Reg
b forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
c
      CONSTCASE Reg
r [(Const, [BC])]
cases Maybe [BC]
def ->
        String
"CONSTCASE " forall a. [a] -> [a] -> [a]
++ Reg -> String
serializeReg Reg
r forall a. [a] -> [a] -> [a]
++ String
":\n" forall a. [a] -> [a] -> [a]
++ forall a b. [a] -> [b] -> (a -> [b]) -> [b]
interMap [(Const, [BC])]
cases String
"\n" (forall a. Show a => Int -> (a, [BC]) -> String
serializeCase (Int
n forall a. Num a => a -> a -> a
+ Int
1)) forall a. [a] -> [a] -> [a]
++
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\[BC]
def' -> String
"\n" forall a. [a] -> [a] -> [a]
++ Int -> [BC] -> String
serializeDefault (Int
n forall a. Num a => a -> a -> a
+ Int
1) [BC]
def') Maybe [BC]
def
      CALL Name
x -> String
"CALL " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Name
x
      TAILCALL Name
x -> String
"TAILCALL " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Name
x
      FOREIGNCALL Reg
r FDesc
ret FDesc
name [(FDesc, Reg)]
args ->
        String
"FOREIGNCALL " forall a. [a] -> [a] -> [a]
++ Reg -> String
serializeReg Reg
r forall a. [a] -> [a] -> [a]
++ String
" \"" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show FDesc
name forall a. [a] -> [a] -> [a]
++ String
"\" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show FDesc
ret forall a. [a] -> [a] -> [a]
++
        String
" [" forall a. [a] -> [a] -> [a]
++ forall a b. [a] -> [b] -> (a -> [b]) -> [b]
interMap [(FDesc, Reg)]
args String
", " (\(FDesc
ty, Reg
r) -> Reg -> String
serializeReg Reg
r forall a. [a] -> [a] -> [a]
++ String
" : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show FDesc
ty) forall a. [a] -> [a] -> [a]
++ String
"]"
      SLIDE Int
n -> String
"SLIDE " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
      BC
REBASE -> String
"REBASE"
      RESERVE Int
n -> String
"RESERVE " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
      RESERVENOALLOC Int
n -> String
"RESERVENOALLOC " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
      ADDTOP Int
n -> String
"ADDTOP " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
      TOPBASE Int
n -> String
"TOPBASE " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
      BASETOP Int
n -> String
"BASETOP " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
      BC
STOREOLD -> String
"STOREOLD"
      OP Reg
a PrimFn
b [Reg]
c ->
        String
"OP " forall a. [a] -> [a] -> [a]
++ Reg -> String
serializeReg Reg
a forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show PrimFn
b forall a. [a] -> [a] -> [a]
++ String
" [" forall a. [a] -> [a] -> [a]
++ forall a b. [a] -> [b] -> (a -> [b]) -> [b]
interMap [Reg]
c String
", " Reg -> String
serializeReg forall a. [a] -> [a] -> [a]
++ String
"]"
      NULL Reg
r -> String
"NULL " forall a. [a] -> [a] -> [a]
++ Reg -> String
serializeReg Reg
r
      ERROR String
s -> String
"ERROR \"" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"\"" -- FIXME: s may contain quotes
                                         -- Issue #1596
serialize :: [(Name, [BC])] -> String
serialize :: [(Name, [BC])] -> String
serialize [(Name, [BC])]
decls =
    forall a b. [a] -> [b] -> (a -> [b]) -> [b]
interMap [(Name, [BC])]
decls String
"\n\n" (Name, [BC]) -> String
serializeDecl
  where
    serializeDecl :: (Name, [BC]) -> String
    serializeDecl :: (Name, [BC]) -> String
serializeDecl (Name
name, [BC]
bcs) =
      forall a. Show a => a -> String
show Name
name forall a. [a] -> [a] -> [a]
++ String
":\n" forall a. [a] -> [a] -> [a]
++ forall a b. [a] -> [b] -> (a -> [b]) -> [b]
interMap [BC]
bcs String
"\n" (Int -> BC -> String
serializeBC Int
1)

dumpBC :: [(Name, SDecl)] -> String -> IO ()
dumpBC :: [(Name, SDecl)] -> String -> IO ()
dumpBC [(Name, SDecl)]
c String
output = String -> String -> IO ()
writeFile String
output forall a b. (a -> b) -> a -> b
$ [(Name, [BC])] -> String
serialize forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Name, SDecl) -> (Name, [BC])
toBC [(Name, SDecl)]
c