forked from carp-lang/Carp
-
Notifications
You must be signed in to change notification settings - Fork 0
/
TypesToC.hs
60 lines (55 loc) · 2.16 KB
/
TypesToC.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
module TypesToC
( tyToC,
tyToCLambdaFix,
tyToCRawFunctionPtrFix,
)
where
import Data.List
import Data.Text (pack, splitOn, unpack)
import SymPath
import Types
import Util
tyToC :: Ty -> String
tyToC = tyToCManglePtr False
tyToCLambdaFix :: Ty -> String
tyToCLambdaFix FuncTy {} = "Lambda"
tyToCLambdaFix (RefTy FuncTy {} _) = "Lambda*"
tyToCLambdaFix (RefTy (RefTy FuncTy {} _) _) = "Lambda**"
tyToCLambdaFix (RefTy (RefTy (RefTy FuncTy {} _) _) _) = "Lambda***" -- TODO: More cases needed?! What's a better way to do it..?
tyToCLambdaFix t = tyToCManglePtr False t
tyToCRawFunctionPtrFix :: Ty -> String
tyToCRawFunctionPtrFix FuncTy {} = "void*"
tyToCRawFunctionPtrFix t = tyToCManglePtr False t
tyToCManglePtr :: Bool -> Ty -> String
tyToCManglePtr b (StructTy (ConcreteNameTy (SymPath [] "Box")) [t]) = tyToCManglePtr b t ++ (if b then mangle "*" else "*")
tyToCManglePtr b (PointerTy p) = tyToCManglePtr b p ++ (if b then mangle "*" else "*")
tyToCManglePtr b (RefTy r _) = tyToCManglePtr b r ++ (if b then mangle "*" else "*")
tyToCManglePtr _ ty = f ty
where
f IntTy = "int"
f BoolTy = "bool"
f FloatTy = "float"
f DoubleTy = "double"
f LongTy = "Long"
f ByteTy = "uint8_t"
f StringTy = "String"
f PatternTy = "Pattern"
f CharTy = "Char"
f CCharTy = "CChar"
f UnitTy = "void"
f (VarTy x) = x
f (FuncTy argTys retTy _) = "Fn__" ++ joinWithUnderscore (map (tyToCManglePtr True) argTys) ++ "_" ++ tyToCManglePtr True retTy
f (StructTy s []) = tyToCManglePtr False s
f (StructTy s typeArgs) = tyToCManglePtr False s ++ "__" ++ joinWithUnderscore (map (tyToCManglePtr True) typeArgs)
f (ConcreteNameTy spath) = mangle (intercalate "" (map unpack (splitOn (pack ".") (pack (show spath)))))
f ModuleTy = err "modules"
f TypeTy = err "types"
f MacroTy = err "macros"
f DynamicTy = err "dynamic functions"
f StaticLifetimeTy = err "lifetimes"
f InterfaceTy = err "interfaces"
f Universe = err "universe"
f (PointerTy _) = err "pointers"
f (RefTy _ _) = err "references"
f CTy = "c_code" -- Literal C; we shouldn't emit anything.
err s = error ("Can't emit the type of " ++ s ++ ".")