{-# LANGUAGE PostfixOperators #-}


module Futhark.CodeGen.Backends.GenericCSharp.AST
  ( CSExp(..)
  , CSType(..)
  , CSComp(..)
  , CSPrim(..)
  , CSInt(..)
  , CSUInt(..)
  , CSFloat(..)
  , CSIdx (..)
  , ArgMemType(..)
  , CSArg (..)
  , CSStmt(..)
  , module Language.Futhark.Core
  , CSProg(..)
  , CSExcept(..)
  , CSFunDef(..)
  , CSFunDefArg
  , CSClassDef(..)
  , CSConstructorDef(..)
  )
  where

import Language.Futhark.Core
import Data.List(intersperse)
import Futhark.Util.Pretty

data MemT = Pointer
          deriving (MemT -> MemT -> Bool
(MemT -> MemT -> Bool) -> (MemT -> MemT -> Bool) -> Eq MemT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemT -> MemT -> Bool
$c/= :: MemT -> MemT -> Bool
== :: MemT -> MemT -> Bool
$c== :: MemT -> MemT -> Bool
Eq, Int -> MemT -> ShowS
[MemT] -> ShowS
MemT -> String
(Int -> MemT -> ShowS)
-> (MemT -> String) -> ([MemT] -> ShowS) -> Show MemT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MemT] -> ShowS
$cshowList :: [MemT] -> ShowS
show :: MemT -> String
$cshow :: MemT -> String
showsPrec :: Int -> MemT -> ShowS
$cshowsPrec :: Int -> MemT -> ShowS
Show)

data ArgMemType = ArgOut
                | ArgRef
                deriving (ArgMemType -> ArgMemType -> Bool
(ArgMemType -> ArgMemType -> Bool)
-> (ArgMemType -> ArgMemType -> Bool) -> Eq ArgMemType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArgMemType -> ArgMemType -> Bool
$c/= :: ArgMemType -> ArgMemType -> Bool
== :: ArgMemType -> ArgMemType -> Bool
$c== :: ArgMemType -> ArgMemType -> Bool
Eq, Int -> ArgMemType -> ShowS
[ArgMemType] -> ShowS
ArgMemType -> String
(Int -> ArgMemType -> ShowS)
-> (ArgMemType -> String)
-> ([ArgMemType] -> ShowS)
-> Show ArgMemType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArgMemType] -> ShowS
$cshowList :: [ArgMemType] -> ShowS
show :: ArgMemType -> String
$cshow :: ArgMemType -> String
showsPrec :: Int -> ArgMemType -> ShowS
$cshowsPrec :: Int -> ArgMemType -> ShowS
Show)

instance Pretty ArgMemType where
  ppr :: ArgMemType -> Doc
ppr ArgMemType
ArgOut = String -> Doc
text String
"out"
  ppr ArgMemType
ArgRef = String -> Doc
text String
"ref"

instance Pretty CSComp where
  ppr :: CSComp -> Doc
ppr (ArrayT CSType
t) = CSType -> Doc
forall a. Pretty a => a -> Doc
ppr CSType
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"[]"
  ppr (TupleT [CSType]
ts) = Doc -> Doc
parens([Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSType -> Doc) -> [CSType] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSType -> Doc
forall a. Pretty a => a -> Doc
ppr [CSType]
ts)
  ppr (SystemTupleT [CSType]
ts) = String -> Doc
text String
"Tuple" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
angles([Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSType -> Doc) -> [CSType] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSType -> Doc
forall a. Pretty a => a -> Doc
ppr [CSType]
ts)

data CSInt = Int8T
           | Int16T
           | Int32T
           | Int64T
           deriving (CSInt -> CSInt -> Bool
(CSInt -> CSInt -> Bool) -> (CSInt -> CSInt -> Bool) -> Eq CSInt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSInt -> CSInt -> Bool
$c/= :: CSInt -> CSInt -> Bool
== :: CSInt -> CSInt -> Bool
$c== :: CSInt -> CSInt -> Bool
Eq, Int -> CSInt -> ShowS
[CSInt] -> ShowS
CSInt -> String
(Int -> CSInt -> ShowS)
-> (CSInt -> String) -> ([CSInt] -> ShowS) -> Show CSInt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSInt] -> ShowS
$cshowList :: [CSInt] -> ShowS
show :: CSInt -> String
$cshow :: CSInt -> String
showsPrec :: Int -> CSInt -> ShowS
$cshowsPrec :: Int -> CSInt -> ShowS
Show)

data CSUInt = UInt8T
            | UInt16T
            | UInt32T
            | UInt64T
            deriving (CSUInt -> CSUInt -> Bool
(CSUInt -> CSUInt -> Bool)
-> (CSUInt -> CSUInt -> Bool) -> Eq CSUInt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSUInt -> CSUInt -> Bool
$c/= :: CSUInt -> CSUInt -> Bool
== :: CSUInt -> CSUInt -> Bool
$c== :: CSUInt -> CSUInt -> Bool
Eq, Int -> CSUInt -> ShowS
[CSUInt] -> ShowS
CSUInt -> String
(Int -> CSUInt -> ShowS)
-> (CSUInt -> String) -> ([CSUInt] -> ShowS) -> Show CSUInt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSUInt] -> ShowS
$cshowList :: [CSUInt] -> ShowS
show :: CSUInt -> String
$cshow :: CSUInt -> String
showsPrec :: Int -> CSUInt -> ShowS
$cshowsPrec :: Int -> CSUInt -> ShowS
Show)

data CSFloat = FloatT
             | DoubleT
             deriving (CSFloat -> CSFloat -> Bool
(CSFloat -> CSFloat -> Bool)
-> (CSFloat -> CSFloat -> Bool) -> Eq CSFloat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSFloat -> CSFloat -> Bool
$c/= :: CSFloat -> CSFloat -> Bool
== :: CSFloat -> CSFloat -> Bool
$c== :: CSFloat -> CSFloat -> Bool
Eq, Int -> CSFloat -> ShowS
[CSFloat] -> ShowS
CSFloat -> String
(Int -> CSFloat -> ShowS)
-> (CSFloat -> String) -> ([CSFloat] -> ShowS) -> Show CSFloat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSFloat] -> ShowS
$cshowList :: [CSFloat] -> ShowS
show :: CSFloat -> String
$cshow :: CSFloat -> String
showsPrec :: Int -> CSFloat -> ShowS
$cshowsPrec :: Int -> CSFloat -> ShowS
Show)

data CSType = Composite CSComp
            | PointerT CSType
            | Primitive CSPrim
            | CustomT String
            | StaticT CSType
            | OutT CSType
            | RefT CSType
            | VoidT
            deriving (CSType -> CSType -> Bool
(CSType -> CSType -> Bool)
-> (CSType -> CSType -> Bool) -> Eq CSType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSType -> CSType -> Bool
$c/= :: CSType -> CSType -> Bool
== :: CSType -> CSType -> Bool
$c== :: CSType -> CSType -> Bool
Eq, Int -> CSType -> ShowS
[CSType] -> ShowS
CSType -> String
(Int -> CSType -> ShowS)
-> (CSType -> String) -> ([CSType] -> ShowS) -> Show CSType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSType] -> ShowS
$cshowList :: [CSType] -> ShowS
show :: CSType -> String
$cshow :: CSType -> String
showsPrec :: Int -> CSType -> ShowS
$cshowsPrec :: Int -> CSType -> ShowS
Show)

data CSComp = ArrayT CSType
            | TupleT [CSType]
            | SystemTupleT [CSType]
            deriving (CSComp -> CSComp -> Bool
(CSComp -> CSComp -> Bool)
-> (CSComp -> CSComp -> Bool) -> Eq CSComp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSComp -> CSComp -> Bool
$c/= :: CSComp -> CSComp -> Bool
== :: CSComp -> CSComp -> Bool
$c== :: CSComp -> CSComp -> Bool
Eq, Int -> CSComp -> ShowS
[CSComp] -> ShowS
CSComp -> String
(Int -> CSComp -> ShowS)
-> (CSComp -> String) -> ([CSComp] -> ShowS) -> Show CSComp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSComp] -> ShowS
$cshowList :: [CSComp] -> ShowS
show :: CSComp -> String
$cshow :: CSComp -> String
showsPrec :: Int -> CSComp -> ShowS
$cshowsPrec :: Int -> CSComp -> ShowS
Show)

data CSPrim = CSInt CSInt
            | CSUInt CSUInt
            | CSFloat CSFloat
            | BoolT
            | ByteT
            | StringT
            | IntPtrT
            deriving (CSPrim -> CSPrim -> Bool
(CSPrim -> CSPrim -> Bool)
-> (CSPrim -> CSPrim -> Bool) -> Eq CSPrim
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSPrim -> CSPrim -> Bool
$c/= :: CSPrim -> CSPrim -> Bool
== :: CSPrim -> CSPrim -> Bool
$c== :: CSPrim -> CSPrim -> Bool
Eq, Int -> CSPrim -> ShowS
[CSPrim] -> ShowS
CSPrim -> String
(Int -> CSPrim -> ShowS)
-> (CSPrim -> String) -> ([CSPrim] -> ShowS) -> Show CSPrim
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSPrim] -> ShowS
$cshowList :: [CSPrim] -> ShowS
show :: CSPrim -> String
$cshow :: CSPrim -> String
showsPrec :: Int -> CSPrim -> ShowS
$cshowsPrec :: Int -> CSPrim -> ShowS
Show)

instance Pretty CSType where
  ppr :: CSType -> Doc
ppr (Composite CSComp
t) = CSComp -> Doc
forall a. Pretty a => a -> Doc
ppr CSComp
t
  ppr (PointerT CSType
t) = CSType -> Doc
forall a. Pretty a => a -> Doc
ppr CSType
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"*"
  ppr (Primitive CSPrim
t) = CSPrim -> Doc
forall a. Pretty a => a -> Doc
ppr CSPrim
t
  ppr (CustomT String
t) = String -> Doc
text String
t
  ppr (StaticT CSType
t) = String -> Doc
text String
"static" Doc -> Doc -> Doc
<+> CSType -> Doc
forall a. Pretty a => a -> Doc
ppr CSType
t
  ppr (OutT CSType
t) = String -> Doc
text String
"out" Doc -> Doc -> Doc
<+> CSType -> Doc
forall a. Pretty a => a -> Doc
ppr CSType
t
  ppr (RefT CSType
t) = String -> Doc
text String
"ref" Doc -> Doc -> Doc
<+> CSType -> Doc
forall a. Pretty a => a -> Doc
ppr CSType
t
  ppr CSType
VoidT = String -> Doc
text String
"void"

instance Pretty CSPrim where
  ppr :: CSPrim -> Doc
ppr CSPrim
BoolT = String -> Doc
text String
"bool"
  ppr CSPrim
ByteT = String -> Doc
text String
"byte"
  ppr (CSInt CSInt
t) = CSInt -> Doc
forall a. Pretty a => a -> Doc
ppr CSInt
t
  ppr (CSUInt CSUInt
t) = CSUInt -> Doc
forall a. Pretty a => a -> Doc
ppr CSUInt
t
  ppr (CSFloat CSFloat
t) = CSFloat -> Doc
forall a. Pretty a => a -> Doc
ppr CSFloat
t
  ppr CSPrim
StringT = String -> Doc
text String
"string"
  ppr CSPrim
IntPtrT = String -> Doc
text String
"IntPtr"

instance Pretty CSInt where
  ppr :: CSInt -> Doc
ppr CSInt
Int8T = String -> Doc
text String
"sbyte"
  ppr CSInt
Int16T = String -> Doc
text String
"short"
  ppr CSInt
Int32T = String -> Doc
text String
"int"
  ppr CSInt
Int64T = String -> Doc
text String
"long"

instance Pretty CSUInt where
  ppr :: CSUInt -> Doc
ppr CSUInt
UInt8T = String -> Doc
text String
"byte"
  ppr CSUInt
UInt16T = String -> Doc
text String
"ushort"
  ppr CSUInt
UInt32T = String -> Doc
text String
"uint"
  ppr CSUInt
UInt64T = String -> Doc
text String
"ulong"

instance Pretty CSFloat where
  ppr :: CSFloat -> Doc
ppr CSFloat
FloatT = String -> Doc
text String
"float"
  ppr CSFloat
DoubleT = String -> Doc
text String
"double"

data UnOp = Not -- ^ Boolean negation.
          | Complement -- ^ Bitwise complement.
          | Negate -- ^ Numerical negation.
          | Abs -- ^ Absolute/numerical value.
            deriving (UnOp -> UnOp -> Bool
(UnOp -> UnOp -> Bool) -> (UnOp -> UnOp -> Bool) -> Eq UnOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnOp -> UnOp -> Bool
$c/= :: UnOp -> UnOp -> Bool
== :: UnOp -> UnOp -> Bool
$c== :: UnOp -> UnOp -> Bool
Eq, Int -> UnOp -> ShowS
[UnOp] -> ShowS
UnOp -> String
(Int -> UnOp -> ShowS)
-> (UnOp -> String) -> ([UnOp] -> ShowS) -> Show UnOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnOp] -> ShowS
$cshowList :: [UnOp] -> ShowS
show :: UnOp -> String
$cshow :: UnOp -> String
showsPrec :: Int -> UnOp -> ShowS
$cshowsPrec :: Int -> UnOp -> ShowS
Show)

data CSExp = Integer Integer
           | Bool Bool
           | Float Double
           | String String
           | RawStringLiteral String
           | Var String
           | Addr CSExp
           | Ref CSExp
           | Out CSExp
           | Deref String
           | BinOp String CSExp CSExp
           | PreUnOp String CSExp
           | PostUnOp String CSExp
           | Ternary CSExp CSExp CSExp
           | Cond CSExp CSExp CSExp
           | Index CSExp CSIdx
           | Pair CSExp CSExp
           | Call CSExp [CSArg]
           | CallMethod CSExp CSExp [CSArg]
           | CreateObject CSExp [CSArg]
           | CreateArray CSType (Either Int [CSExp])
           | CreateSystemTuple [CSExp]
           | AllocArray CSType CSExp
           | Cast CSType CSExp
           | Tuple [CSExp]
           | Array [CSExp]
           | Field CSExp String
           | Lambda CSExp [CSStmt]
           | Collection String [CSExp]
           | This CSExp
           | Null
           deriving (CSExp -> CSExp -> Bool
(CSExp -> CSExp -> Bool) -> (CSExp -> CSExp -> Bool) -> Eq CSExp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSExp -> CSExp -> Bool
$c/= :: CSExp -> CSExp -> Bool
== :: CSExp -> CSExp -> Bool
$c== :: CSExp -> CSExp -> Bool
Eq, Int -> CSExp -> ShowS
[CSExp] -> ShowS
CSExp -> String
(Int -> CSExp -> ShowS)
-> (CSExp -> String) -> ([CSExp] -> ShowS) -> Show CSExp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSExp] -> ShowS
$cshowList :: [CSExp] -> ShowS
show :: CSExp -> String
$cshow :: CSExp -> String
showsPrec :: Int -> CSExp -> ShowS
$cshowsPrec :: Int -> CSExp -> ShowS
Show)

instance Pretty CSExp where
  ppr :: CSExp -> Doc
ppr (Integer Integer
x) = Integer -> Doc
forall a. Pretty a => a -> Doc
ppr Integer
x
  ppr (Float Double
x)
    | Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
x = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ if Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 then String
"Double.PositiveInfinity" else String
"Double.NegativeInfinity"
    | Bool
otherwise = Double -> Doc
forall a. Pretty a => a -> Doc
ppr Double
x
  ppr (Bool Bool
True) = String -> Doc
text String
"true"
  ppr (Bool Bool
False) = String -> Doc
text String
"false"
  ppr (String String
x) = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> String
show String
x
  ppr (RawStringLiteral String
s) = String -> Doc
text String
"@\"" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"\""
  ppr (Var String
n) = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' then Char
'm' else Char
x) String
n
  ppr (Addr CSExp
e) =  String -> Doc
text String
"&" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e
  ppr (Ref CSExp
e) =  String -> Doc
text String
"ref" Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e
  ppr (Out CSExp
e) =  String -> Doc
text String
"out" Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e
  ppr (Deref String
n) =  String -> Doc
text String
"*" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' then Char
'm' else Char
x) String
n)
  ppr (BinOp String
s CSExp
e1 CSExp
e2) = Doc -> Doc
parens(CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e1 Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e2)
  ppr (PreUnOp String
s CSExp
e) = String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e)
  ppr (PostUnOp String
s CSExp
e) = Doc -> Doc
parens (CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
s
  ppr (Ternary CSExp
b CSExp
e1 CSExp
e2) = CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
b Doc -> Doc -> Doc
<+> String -> Doc
text String
"?" Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e1 Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e2
  ppr (Cond CSExp
e1 CSExp
e2 CSExp
e3) = String -> Doc
text String
"if" Doc -> Doc -> Doc
<+> Doc -> Doc
parens(CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e1) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
braces(CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e2) Doc -> Doc -> Doc
<+> String -> Doc
text String
"else" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
braces(CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e3)
  ppr (Cast CSType
bt CSExp
src) = Doc -> Doc
parens(CSType -> Doc
forall a. Pretty a => a -> Doc
ppr CSType
bt) Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
src
  ppr (Index CSExp
src (IdxExp CSExp
idx)) = CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
src Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
brackets(CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
idx)
  ppr (Index CSExp
src (IdxRange CSExp
from CSExp
to)) = String -> Doc
text String
"MySlice" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens([Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSExp -> Doc) -> [CSExp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr [CSExp
src, CSExp
from, CSExp
to])
  ppr (Pair CSExp
e1 CSExp
e2) = Doc -> Doc
braces(CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
comma Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e2)
  ppr (Call CSExp
fun [CSArg]
args) = CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
fun Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens([Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSArg -> Doc) -> [CSArg] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSArg -> Doc
forall a. Pretty a => a -> Doc
ppr [CSArg]
args)
  ppr (CallMethod CSExp
obj CSExp
method [CSArg]
args) = CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
obj Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
dot Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
method Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens([Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSArg -> Doc) -> [CSArg] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSArg -> Doc
forall a. Pretty a => a -> Doc
ppr [CSArg]
args)
  ppr (CreateObject CSExp
className [CSArg]
args) = String -> Doc
text String
"new" Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
className Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens([Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSArg -> Doc) -> [CSArg] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSArg -> Doc
forall a. Pretty a => a -> Doc
ppr [CSArg]
args)
  ppr (CreateArray CSType
t (Left Int
n)) = String -> Doc
text String
"new" Doc -> Doc -> Doc
<+> CSType -> Doc
forall a. Pretty a => a -> Doc
ppr CSType
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
brackets (Int -> Doc
forall a. Pretty a => a -> Doc
ppr Int
n)
  ppr (CreateArray CSType
t (Right [CSExp]
vs)) = String -> Doc
text String
"new" Doc -> Doc -> Doc
<+> CSType -> Doc
forall a. Pretty a => a -> Doc
ppr CSType
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"[]" Doc -> Doc -> Doc
<+> Doc -> Doc
braces([Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSExp -> Doc) -> [CSExp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr [CSExp]
vs)
  ppr (CreateSystemTuple [CSExp]
exps) = String -> Doc
text String
"Tuple.Create" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens([Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSExp -> Doc) -> [CSExp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr [CSExp]
exps)
  ppr (Tuple [CSExp]
exps) = Doc -> Doc
parens([Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSExp -> Doc) -> [CSExp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr [CSExp]
exps)
  ppr (Array [CSExp]
exps) = Doc -> Doc
braces([Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSExp -> Doc) -> [CSExp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr [CSExp]
exps) -- uhoh is this right?
  ppr (Field CSExp
obj String
field) = CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
obj Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
dot Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
field
  ppr (Lambda CSExp
expr [Exp CSExp
e]) = CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
expr Doc -> Doc -> Doc
<+> String -> Doc
text String
"=>" Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e
  ppr (Lambda CSExp
expr [CSStmt]
stmts) = CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
expr Doc -> Doc -> Doc
<+> String -> Doc
text String
"=>" Doc -> Doc -> Doc
<+> Doc -> Doc
braces([Doc] -> Doc
stack ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSStmt -> Doc) -> [CSStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSStmt -> Doc
forall a. Pretty a => a -> Doc
ppr [CSStmt]
stmts)
  ppr (Collection String
collection [CSExp]
exps) = String -> Doc
text String
"new" Doc -> Doc -> Doc
<+> String -> Doc
text String
collection Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
braces([Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSExp -> Doc) -> [CSExp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr [CSExp]
exps)
  ppr (This CSExp
e) = String -> Doc
text String
"this" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
dot Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e
  ppr CSExp
Null = String -> Doc
text String
"null"
  ppr (AllocArray CSType
t CSExp
len) = String -> Doc
text String
"new" Doc -> Doc -> Doc
<+> CSType -> Doc
forall a. Pretty a => a -> Doc
ppr CSType
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
lbracket Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
len Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rbracket

data CSIdx = IdxRange CSExp CSExp
           | IdxExp CSExp
               deriving (CSIdx -> CSIdx -> Bool
(CSIdx -> CSIdx -> Bool) -> (CSIdx -> CSIdx -> Bool) -> Eq CSIdx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSIdx -> CSIdx -> Bool
$c/= :: CSIdx -> CSIdx -> Bool
== :: CSIdx -> CSIdx -> Bool
$c== :: CSIdx -> CSIdx -> Bool
Eq, Int -> CSIdx -> ShowS
[CSIdx] -> ShowS
CSIdx -> String
(Int -> CSIdx -> ShowS)
-> (CSIdx -> String) -> ([CSIdx] -> ShowS) -> Show CSIdx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSIdx] -> ShowS
$cshowList :: [CSIdx] -> ShowS
show :: CSIdx -> String
$cshow :: CSIdx -> String
showsPrec :: Int -> CSIdx -> ShowS
$cshowsPrec :: Int -> CSIdx -> ShowS
Show)

data CSArg = ArgKeyword String CSArg -- please don't assign multiple keywords with the same argument
           | Arg (Maybe ArgMemType) CSExp
           deriving (CSArg -> CSArg -> Bool
(CSArg -> CSArg -> Bool) -> (CSArg -> CSArg -> Bool) -> Eq CSArg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSArg -> CSArg -> Bool
$c/= :: CSArg -> CSArg -> Bool
== :: CSArg -> CSArg -> Bool
$c== :: CSArg -> CSArg -> Bool
Eq, Int -> CSArg -> ShowS
[CSArg] -> ShowS
CSArg -> String
(Int -> CSArg -> ShowS)
-> (CSArg -> String) -> ([CSArg] -> ShowS) -> Show CSArg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSArg] -> ShowS
$cshowList :: [CSArg] -> ShowS
show :: CSArg -> String
$cshow :: CSArg -> String
showsPrec :: Int -> CSArg -> ShowS
$cshowsPrec :: Int -> CSArg -> ShowS
Show)

instance Pretty CSArg where
  ppr :: CSArg -> Doc
ppr (ArgKeyword String
kw CSArg
arg) = String -> Doc
text String
kw Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
<+> CSArg -> Doc
forall a. Pretty a => a -> Doc
ppr CSArg
arg
  ppr (Arg (Just ArgMemType
mt) CSExp
arg) = ArgMemType -> Doc
forall a. Pretty a => a -> Doc
ppr ArgMemType
mt Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
arg
  ppr (Arg Maybe ArgMemType
Nothing CSExp
arg) = CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
arg

data CSStmt = If CSExp [CSStmt] [CSStmt]
            | Try [CSStmt] [CSExcept]
            | While CSExp [CSStmt]
            | For String CSExp [CSStmt]
            | ForEach String CSExp [CSStmt]
            | UsingWith CSStmt [CSStmt]
            | Unsafe [CSStmt]
            | Fixed CSExp CSExp [CSStmt]
            | Assign CSExp CSExp
            | Reassign CSExp CSExp
            | AssignOp String CSExp CSExp
            | AssignTyped CSType CSExp (Maybe CSExp)

            | Comment String [CSStmt]
            | Assert CSExp [CSExp]
            | Throw CSExp
            | Exp CSExp
            | Return CSExp
            | Pass
              -- Definition-like statements.
            | Using (Maybe String) String
            | StaticFunDef CSFunDef
            | PublicFunDef CSFunDef
            | PrivateFunDef CSFunDef
            | Namespace String [CSStmt]
            | ClassDef CSClassDef
            | ConstructorDef CSConstructorDef
            | StructDef String [(CSType, String)]

              -- Some arbitrary string of CS code.
            | Escape String
                deriving (CSStmt -> CSStmt -> Bool
(CSStmt -> CSStmt -> Bool)
-> (CSStmt -> CSStmt -> Bool) -> Eq CSStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSStmt -> CSStmt -> Bool
$c/= :: CSStmt -> CSStmt -> Bool
== :: CSStmt -> CSStmt -> Bool
$c== :: CSStmt -> CSStmt -> Bool
Eq, Int -> CSStmt -> ShowS
[CSStmt] -> ShowS
CSStmt -> String
(Int -> CSStmt -> ShowS)
-> (CSStmt -> String) -> ([CSStmt] -> ShowS) -> Show CSStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSStmt] -> ShowS
$cshowList :: [CSStmt] -> ShowS
show :: CSStmt -> String
$cshow :: CSStmt -> String
showsPrec :: Int -> CSStmt -> ShowS
$cshowsPrec :: Int -> CSStmt -> ShowS
Show)

instance Pretty CSStmt where
  ppr :: CSStmt -> Doc
ppr (If CSExp
cond [CSStmt]
tbranch []) =
    String -> Doc
text String
"if" Doc -> Doc -> Doc
<+> Doc -> Doc
parens(CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
cond) Doc -> Doc -> Doc
</>
    Doc
lbrace Doc -> Doc -> Doc
</>
    Int -> Doc -> Doc
indent Int
4 ([Doc] -> Doc
stack ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSStmt -> Doc) -> [CSStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSStmt -> Doc
forall a. Pretty a => a -> Doc
ppr [CSStmt]
tbranch) Doc -> Doc -> Doc
</>
    Doc
rbrace

  ppr (If CSExp
cond [CSStmt]
tbranch [CSStmt]
fbranch) =
    String -> Doc
text String
"if" Doc -> Doc -> Doc
<+> Doc -> Doc
parens(CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
cond) Doc -> Doc -> Doc
</>
    Doc
lbrace Doc -> Doc -> Doc
</>
    Int -> Doc -> Doc
indent Int
4 ([Doc] -> Doc
stack ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSStmt -> Doc) -> [CSStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSStmt -> Doc
forall a. Pretty a => a -> Doc
ppr [CSStmt]
tbranch) Doc -> Doc -> Doc
</>
    Doc
rbrace Doc -> Doc -> Doc
</>
    String -> Doc
text String
"else" Doc -> Doc -> Doc
</>
    Doc
lbrace Doc -> Doc -> Doc
</>
    Int -> Doc -> Doc
indent Int
4 ([Doc] -> Doc
stack ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSStmt -> Doc) -> [CSStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSStmt -> Doc
forall a. Pretty a => a -> Doc
ppr [CSStmt]
fbranch) Doc -> Doc -> Doc
</>
    Doc
rbrace

  ppr (Try [CSStmt]
stmts [CSExcept]
excepts) =
    String -> Doc
text String
"try" Doc -> Doc -> Doc
</>
    Doc
lbrace Doc -> Doc -> Doc
</>
    Int -> Doc -> Doc
indent Int
4 ([Doc] -> Doc
stack ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSStmt -> Doc) -> [CSStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSStmt -> Doc
forall a. Pretty a => a -> Doc
ppr [CSStmt]
stmts) Doc -> Doc -> Doc
</>
    Doc
rbrace Doc -> Doc -> Doc
</>
    [Doc] -> Doc
stack ((CSExcept -> Doc) -> [CSExcept] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSExcept -> Doc
forall a. Pretty a => a -> Doc
ppr [CSExcept]
excepts)

  ppr (While CSExp
cond [CSStmt]
body) =
    String -> Doc
text String
"while" Doc -> Doc -> Doc
<+> Doc -> Doc
parens(CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
cond) Doc -> Doc -> Doc
</>
    Doc
lbrace Doc -> Doc -> Doc
</>
    Int -> Doc -> Doc
indent Int
4 ([Doc] -> Doc
stack ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSStmt -> Doc) -> [CSStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSStmt -> Doc
forall a. Pretty a => a -> Doc
ppr [CSStmt]
body) Doc -> Doc -> Doc
</>
    Doc
rbrace

  ppr (For String
i CSExp
what [CSStmt]
body) =
    String -> Doc
text String
"for" Doc -> Doc -> Doc
<+> Doc -> Doc
parens(Doc
initialize Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
limit Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
inc) Doc -> Doc -> Doc
</>
    Doc
lbrace Doc -> Doc -> Doc
</>
    Int -> Doc -> Doc
indent Int
4 ([Doc] -> Doc
stack ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSStmt -> Doc) -> [CSStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSStmt -> Doc
forall a. Pretty a => a -> Doc
ppr [CSStmt]
body) Doc -> Doc -> Doc
</>
    Doc
rbrace
    where initialize :: Doc
initialize = String -> Doc
text String
"int" Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
<+> String -> Doc
text String
"= 0" Doc -> Doc -> Doc
<+> Doc
semi
          limit :: Doc
limit = String -> Doc
text String
i Doc -> Doc -> Doc
<+> Doc
langle Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
what Doc -> Doc -> Doc
<+> Doc
semi
          inc :: Doc
inc = String -> Doc
text String
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"++"

  ppr (ForEach String
i CSExp
what [CSStmt]
body) =
    String -> Doc
text String
"foreach" Doc -> Doc -> Doc
<+> Doc -> Doc
parens Doc
initialize Doc -> Doc -> Doc
</>
    Doc
lbrace Doc -> Doc -> Doc
</>
    Int -> Doc -> Doc
indent Int
4 ([Doc] -> Doc
stack ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSStmt -> Doc) -> [CSStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSStmt -> Doc
forall a. Pretty a => a -> Doc
ppr [CSStmt]
body) Doc -> Doc -> Doc
</>
    Doc
rbrace
    where initialize :: Doc
initialize = String -> Doc
text String
"var" Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
<+> String -> Doc
text String
"in " Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
what

  ppr (Using (Just String
as) String
from) =
    String -> Doc
text String
"using" Doc -> Doc -> Doc
<+> String -> Doc
text String
as Doc -> Doc -> Doc
<+> String -> Doc
text String
"=" Doc -> Doc -> Doc
<+> String -> Doc
text String
from Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi

  ppr (Using Maybe String
Nothing String
from) =
    String -> Doc
text String
"using" Doc -> Doc -> Doc
<+> String -> Doc
text String
from Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi

  ppr (Unsafe [CSStmt]
stmts) =
    String -> Doc
text String
"unsafe" Doc -> Doc -> Doc
</>
    Doc
lbrace Doc -> Doc -> Doc
</>
    Int -> Doc -> Doc
indent Int
4 ([Doc] -> Doc
stack ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSStmt -> Doc) -> [CSStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSStmt -> Doc
forall a. Pretty a => a -> Doc
ppr [CSStmt]
stmts) Doc -> Doc -> Doc
</>
    Doc
rbrace

  ppr (Fixed CSExp
ptr CSExp
e [CSStmt]
stmts) =
    String -> Doc
text String
"fixed" Doc -> Doc -> Doc
<+> Doc -> Doc
parens(String -> Doc
text String
"void*" Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
ptr Doc -> Doc -> Doc
<+> String -> Doc
text String
"=" Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e) Doc -> Doc -> Doc
</>
    Doc
lbrace Doc -> Doc -> Doc
</>
    Int -> Doc -> Doc
indent Int
4 ([Doc] -> Doc
stack ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSStmt -> Doc) -> [CSStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSStmt -> Doc
forall a. Pretty a => a -> Doc
ppr [CSStmt]
stmts) Doc -> Doc -> Doc
</>
    Doc
rbrace

  ppr (UsingWith CSStmt
assignment [CSStmt]
body) =
    String -> Doc
text String
"using" Doc -> Doc -> Doc
<+> Doc -> Doc
parens(CSStmt -> Doc
forall a. Pretty a => a -> Doc
ppr CSStmt
assignment) Doc -> Doc -> Doc
</>
    Doc
lbrace Doc -> Doc -> Doc
</>
    Int -> Doc -> Doc
indent Int
4 ([Doc] -> Doc
stack ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSStmt -> Doc) -> [CSStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSStmt -> Doc
forall a. Pretty a => a -> Doc
ppr [CSStmt]
body) Doc -> Doc -> Doc
</>
    Doc
rbrace

  ppr (Assign CSExp
e1 CSExp
e2) = String -> Doc
text String
"var" Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e1 Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e2 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
  ppr (Reassign CSExp
e1 CSExp
e2) = CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e1 Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e2 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
  ppr (AssignTyped CSType
t CSExp
e1 Maybe CSExp
Nothing) = CSType -> Doc
forall a. Pretty a => a -> Doc
ppr CSType
t Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
  ppr (AssignTyped CSType
t CSExp
e1 (Just CSExp
e2)) = CSType -> Doc
forall a. Pretty a => a -> Doc
ppr CSType
t Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e1 Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e2 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi

  ppr (AssignOp String
op CSExp
e1 CSExp
e2) = CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e1 Doc -> Doc -> Doc
<+> String -> Doc
text (String
op String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"=") Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e2 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi

  ppr (Comment String
s [CSStmt]
body) = String -> Doc
text String
"//" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
s Doc -> Doc -> Doc
</> [Doc] -> Doc
stack ((CSStmt -> Doc) -> [CSStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSStmt -> Doc
forall a. Pretty a => a -> Doc
ppr [CSStmt]
body)

  ppr (Assert CSExp
e []) =
    String -> Doc
text String
"FutharkAssert" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens(CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi

  ppr (Assert CSExp
e [CSExp]
exps) =
    let exps' :: Doc
exps' = [Doc] -> Doc
stack ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (String -> Doc
text String
",") ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (CSExp -> Doc) -> [CSExp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr [CSExp]
exps
        formattedString :: Doc
formattedString = String -> Doc
text String
"String.Format" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens Doc
exps'
    in String -> Doc
text String
"FutharkAssert" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens(CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"," Doc -> Doc -> Doc
<+> Doc
formattedString) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi

  ppr (Throw CSExp
e) = String -> Doc
text String
"throw" Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi

  ppr (Exp CSExp
e) = CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi

  ppr (Return CSExp
e) = String -> Doc
text String
"return" Doc -> Doc -> Doc
<+> CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi

  ppr (ClassDef CSClassDef
d) = CSClassDef -> Doc
forall a. Pretty a => a -> Doc
ppr CSClassDef
d

  ppr (StaticFunDef CSFunDef
d) = String -> Doc
text String
"static" Doc -> Doc -> Doc
<+> CSFunDef -> Doc
forall a. Pretty a => a -> Doc
ppr CSFunDef
d

  ppr (PublicFunDef CSFunDef
d) = String -> Doc
text String
"public" Doc -> Doc -> Doc
<+> CSFunDef -> Doc
forall a. Pretty a => a -> Doc
ppr CSFunDef
d

  ppr (PrivateFunDef CSFunDef
d) = String -> Doc
text String
"private" Doc -> Doc -> Doc
<+> CSFunDef -> Doc
forall a. Pretty a => a -> Doc
ppr CSFunDef
d

  ppr (ConstructorDef CSConstructorDef
d) = CSConstructorDef -> Doc
forall a. Pretty a => a -> Doc
ppr CSConstructorDef
d

  ppr (StructDef String
name [(CSType, String)]
assignments) = String -> Doc
text String
"public struct" Doc -> Doc -> Doc
<+> String -> Doc
text String
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
braces([Doc] -> Doc
stack ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((CSType, String) -> Doc) -> [(CSType, String)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(CSType
tp,String
field) -> String -> Doc
text String
"public" Doc -> Doc -> Doc
<+> CSType -> Doc
forall a. Pretty a => a -> Doc
ppr CSType
tp Doc -> Doc -> Doc
<+> String -> Doc
text String
field Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi) [(CSType, String)]
assignments)

  ppr (Namespace String
name [CSStmt]
csstms) = String -> Doc
text String
"namespace" Doc -> Doc -> Doc
<+> String -> Doc
text String
name Doc -> Doc -> Doc
</>
                                Doc
lbrace Doc -> Doc -> Doc
</>
                                Int -> Doc -> Doc
indent Int
4 ([Doc] -> Doc
stack ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CSStmt -> Doc) -> [CSStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSStmt -> Doc
forall a. Pretty a => a -> Doc
ppr [CSStmt]
csstms) Doc -> Doc -> Doc
</>
                                Doc
rbrace

  ppr (Escape String
s) = [Doc] -> Doc
stack ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text ([String] -> [Doc]) -> [String] -> [Doc]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
s

  ppr CSStmt
Pass = Doc
empty

instance Pretty CSFunDef where
  ppr :: CSFunDef -> Doc
ppr (Def String
fname CSType
retType [(CSType, String)]
args [CSStmt]
stmts) =
    CSType -> Doc
forall a. Pretty a => a -> Doc
ppr CSType
retType Doc -> Doc -> Doc
<+> String -> Doc
text String
fname Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens( [Doc] -> Doc
commasep(((CSType, String) -> Doc) -> [(CSType, String)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (CSType, String) -> Doc
forall a. Pretty a => (a, String) -> Doc
ppr' [(CSType, String)]
args) ) Doc -> Doc -> Doc
</>
    Doc
lbrace Doc -> Doc -> Doc
</>
    Int -> Doc -> Doc
indent Int
4 ([Doc] -> Doc
stack ((CSStmt -> Doc) -> [CSStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSStmt -> Doc
forall a. Pretty a => a -> Doc
ppr [CSStmt]
stmts)) Doc -> Doc -> Doc
</>
    Doc
rbrace
    where ppr' :: (a, String) -> Doc
ppr' (a
tp, String
var) = a -> Doc
forall a. Pretty a => a -> Doc
ppr a
tp Doc -> Doc -> Doc
<+> String -> Doc
text String
var

instance Pretty CSClassDef where
  ppr :: CSClassDef -> Doc
ppr (Class String
cname [CSStmt]
body) =
    String -> Doc
text String
"class" Doc -> Doc -> Doc
<+> String -> Doc
text String
cname Doc -> Doc -> Doc
</>
    Doc
lbrace Doc -> Doc -> Doc
</>
    Int -> Doc -> Doc
indent Int
4 ([Doc] -> Doc
stack ((CSStmt -> Doc) -> [CSStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSStmt -> Doc
forall a. Pretty a => a -> Doc
ppr [CSStmt]
body)) Doc -> Doc -> Doc
</>
    Doc
rbrace

  ppr (PublicClass String
cname [CSStmt]
body) =
    String -> Doc
text String
"public" Doc -> Doc -> Doc
<+> String -> Doc
text String
"class" Doc -> Doc -> Doc
<+> String -> Doc
text String
cname Doc -> Doc -> Doc
</>
    Doc
lbrace Doc -> Doc -> Doc
</>
    Int -> Doc -> Doc
indent Int
4 ([Doc] -> Doc
stack ((CSStmt -> Doc) -> [CSStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSStmt -> Doc
forall a. Pretty a => a -> Doc
ppr [CSStmt]
body)) Doc -> Doc -> Doc
</>
    Doc
rbrace

instance Pretty CSConstructorDef where
  ppr :: CSConstructorDef -> Doc
ppr (ClassConstructor String
cname [(CSType, String)]
params [CSStmt]
body) =
    String -> Doc
text String
"public" Doc -> Doc -> Doc
<+> String -> Doc
text String
cname Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens([Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((CSType, String) -> Doc) -> [(CSType, String)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (CSType, String) -> Doc
forall a. Pretty a => (a, String) -> Doc
ppr' [(CSType, String)]
params) Doc -> Doc -> Doc
</>
    Doc
lbrace Doc -> Doc -> Doc
</>
    Int -> Doc -> Doc
indent Int
4 ([Doc] -> Doc
stack ((CSStmt -> Doc) -> [CSStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSStmt -> Doc
forall a. Pretty a => a -> Doc
ppr [CSStmt]
body)) Doc -> Doc -> Doc
</>
    Doc
rbrace
    where ppr' :: (a, String) -> Doc
ppr' (a
tp, String
var) = a -> Doc
forall a. Pretty a => a -> Doc
ppr a
tp Doc -> Doc -> Doc
<+> String -> Doc
text String
var

instance Pretty CSExcept where
  ppr :: CSExcept -> Doc
ppr (Catch CSExp
csexp [CSStmt]
stmts) =
    String -> Doc
text String
"catch" Doc -> Doc -> Doc
<+> Doc -> Doc
parens(CSExp -> Doc
forall a. Pretty a => a -> Doc
ppr CSExp
csexp Doc -> Doc -> Doc
<+> String -> Doc
text String
"e") Doc -> Doc -> Doc
</>
    Doc
lbrace Doc -> Doc -> Doc
</>
    Int -> Doc -> Doc
indent Int
4 ([Doc] -> Doc
stack ((CSStmt -> Doc) -> [CSStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSStmt -> Doc
forall a. Pretty a => a -> Doc
ppr [CSStmt]
stmts)) Doc -> Doc -> Doc
</>
    Doc
rbrace

data CSExcept = Catch CSExp [CSStmt]
              deriving (CSExcept -> CSExcept -> Bool
(CSExcept -> CSExcept -> Bool)
-> (CSExcept -> CSExcept -> Bool) -> Eq CSExcept
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSExcept -> CSExcept -> Bool
$c/= :: CSExcept -> CSExcept -> Bool
== :: CSExcept -> CSExcept -> Bool
$c== :: CSExcept -> CSExcept -> Bool
Eq, Int -> CSExcept -> ShowS
[CSExcept] -> ShowS
CSExcept -> String
(Int -> CSExcept -> ShowS)
-> (CSExcept -> String) -> ([CSExcept] -> ShowS) -> Show CSExcept
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSExcept] -> ShowS
$cshowList :: [CSExcept] -> ShowS
show :: CSExcept -> String
$cshow :: CSExcept -> String
showsPrec :: Int -> CSExcept -> ShowS
$cshowsPrec :: Int -> CSExcept -> ShowS
Show)

type CSFunDefArg = (CSType, String)
data CSFunDef = Def String CSType [CSFunDefArg] [CSStmt]
                  deriving (CSFunDef -> CSFunDef -> Bool
(CSFunDef -> CSFunDef -> Bool)
-> (CSFunDef -> CSFunDef -> Bool) -> Eq CSFunDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSFunDef -> CSFunDef -> Bool
$c/= :: CSFunDef -> CSFunDef -> Bool
== :: CSFunDef -> CSFunDef -> Bool
$c== :: CSFunDef -> CSFunDef -> Bool
Eq, Int -> CSFunDef -> ShowS
[CSFunDef] -> ShowS
CSFunDef -> String
(Int -> CSFunDef -> ShowS)
-> (CSFunDef -> String) -> ([CSFunDef] -> ShowS) -> Show CSFunDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSFunDef] -> ShowS
$cshowList :: [CSFunDef] -> ShowS
show :: CSFunDef -> String
$cshow :: CSFunDef -> String
showsPrec :: Int -> CSFunDef -> ShowS
$cshowsPrec :: Int -> CSFunDef -> ShowS
Show)

data CSClassDef = Class String [CSStmt]
                | PublicClass String [CSStmt]
                deriving (CSClassDef -> CSClassDef -> Bool
(CSClassDef -> CSClassDef -> Bool)
-> (CSClassDef -> CSClassDef -> Bool) -> Eq CSClassDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSClassDef -> CSClassDef -> Bool
$c/= :: CSClassDef -> CSClassDef -> Bool
== :: CSClassDef -> CSClassDef -> Bool
$c== :: CSClassDef -> CSClassDef -> Bool
Eq, Int -> CSClassDef -> ShowS
[CSClassDef] -> ShowS
CSClassDef -> String
(Int -> CSClassDef -> ShowS)
-> (CSClassDef -> String)
-> ([CSClassDef] -> ShowS)
-> Show CSClassDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSClassDef] -> ShowS
$cshowList :: [CSClassDef] -> ShowS
show :: CSClassDef -> String
$cshow :: CSClassDef -> String
showsPrec :: Int -> CSClassDef -> ShowS
$cshowsPrec :: Int -> CSClassDef -> ShowS
Show)

data CSConstructorDef = ClassConstructor String [CSFunDefArg] [CSStmt]
                deriving (CSConstructorDef -> CSConstructorDef -> Bool
(CSConstructorDef -> CSConstructorDef -> Bool)
-> (CSConstructorDef -> CSConstructorDef -> Bool)
-> Eq CSConstructorDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSConstructorDef -> CSConstructorDef -> Bool
$c/= :: CSConstructorDef -> CSConstructorDef -> Bool
== :: CSConstructorDef -> CSConstructorDef -> Bool
$c== :: CSConstructorDef -> CSConstructorDef -> Bool
Eq, Int -> CSConstructorDef -> ShowS
[CSConstructorDef] -> ShowS
CSConstructorDef -> String
(Int -> CSConstructorDef -> ShowS)
-> (CSConstructorDef -> String)
-> ([CSConstructorDef] -> ShowS)
-> Show CSConstructorDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSConstructorDef] -> ShowS
$cshowList :: [CSConstructorDef] -> ShowS
show :: CSConstructorDef -> String
$cshow :: CSConstructorDef -> String
showsPrec :: Int -> CSConstructorDef -> ShowS
$cshowsPrec :: Int -> CSConstructorDef -> ShowS
Show)

newtype CSProg = CSProg [CSStmt]
                   deriving (CSProg -> CSProg -> Bool
(CSProg -> CSProg -> Bool)
-> (CSProg -> CSProg -> Bool) -> Eq CSProg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSProg -> CSProg -> Bool
$c/= :: CSProg -> CSProg -> Bool
== :: CSProg -> CSProg -> Bool
$c== :: CSProg -> CSProg -> Bool
Eq, Int -> CSProg -> ShowS
[CSProg] -> ShowS
CSProg -> String
(Int -> CSProg -> ShowS)
-> (CSProg -> String) -> ([CSProg] -> ShowS) -> Show CSProg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSProg] -> ShowS
$cshowList :: [CSProg] -> ShowS
show :: CSProg -> String
$cshow :: CSProg -> String
showsPrec :: Int -> CSProg -> ShowS
$cshowsPrec :: Int -> CSProg -> ShowS
Show)

instance Pretty CSProg where
  ppr :: CSProg -> Doc
ppr (CSProg [CSStmt]
stms) = [Doc] -> Doc
stack ((CSStmt -> Doc) -> [CSStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CSStmt -> Doc
forall a. Pretty a => a -> Doc
ppr [CSStmt]
stms)