1{-
2  SkateTypes: All defined builtin types
3
4  Part of Skate: a Schema specification languge
5
6  Copyright (c) 2017, ETH Zurich.
7  All rights reserved.
8
9  This file is distributed under the terms in the attached LICENSE file.
10  If you do not find this file, copies can be found by writing to:
11  ETH Zurich D-INFK, Universit\"atstr. 6, CH-8092 Zurich. Attn: Systems Group.
12-}
13
14
15module SkateTypes where
16
17import qualified CAbsSyntax as C
18
19
20data TypeBuiltIn = UInt8 | UInt16 | UInt32 | UInt64 | UIntPtr
21                  | Int8 | Int16  | Int32  | Int64  | IntPtr
22                  | Size | Char   | Bool   | String | Capref
23                    deriving (Enum, Eq)
24
25
26{-types -}
27data TypeRef = TEnum String String
28             | TConstant String String
29             | TFact String String
30             | TBuiltIn TypeBuiltIn
31             | TFlags String String
32             deriving(Eq)
33
34instance Show TypeRef where
35    show (TEnum t _ ) = "TEnum(" ++ t ++ ")"
36    show (TConstant t _ ) = "TConstant(" ++ t ++ ")"
37    show (TFact t _ ) = "TFact(" ++ t ++ ")"
38    show (TBuiltIn t) = "TBuiltIn(" ++ (show t) ++ ")"
39    show (TFlags t _ )  = "TFlags(" ++ t ++ ")"
40
41
42{- -}
43instance Show TypeBuiltIn where
44    show UInt8   = "uint8"
45    show UInt16  = "uint16"
46    show UInt32  = "uint32"
47    show UInt64  = "uint64"
48    show UIntPtr = "uintptr"
49    show Int8    = "int8"
50    show Int16   = "int16"
51    show Int32   = "int32"
52    show Int64   = "int64"
53    show IntPtr  = "intptr"
54    show Size    = "size"
55    show Bool    = "bool"
56    show String  = "string"
57    show Char    = "char"
58    show Capref  = "capref"
59
60
61instance Read TypeBuiltIn where
62    readsPrec _ = \s -> case s of
63        "uint8" -> [(UInt8, "")]
64        "uint16" -> [(UInt16, "")]
65        "uint32" -> [(UInt32, "")]
66        "uint64" -> [(UInt64, "")]
67        "uintptr" -> [(UIntPtr, "")]
68        "int8" -> [(Int8, "")]
69        "int16" -> [(Int16, "")]
70        "int32" -> [(Int32, "")]
71        "int64" -> [(Int64, "")]
72        "intptr" -> [(IntPtr, "")]
73        "size" -> [(Size, "")]
74        "bool" -> [(Bool, "")]
75        "string" -> [(String, "")]
76        "char" -> [(Char, "")]
77        "capref" -> [(Capref, "")]
78        _ -> error  $ "Undefined builtin type " ++ s
79
80findBuiltIntType :: String -> TypeBuiltIn
81findBuiltIntType "uint8" = UInt8
82findBuiltIntType "uint16" = UInt16
83findBuiltIntType "uint32" = UInt32
84findBuiltIntType "uint64" = UInt64
85findBuiltIntType "uintptr" = UIntPtr
86findBuiltIntType "int8" = Int8
87findBuiltIntType "int16" = Int16
88findBuiltIntType "int32" = Int32
89findBuiltIntType "int64" = Int64
90findBuiltIntType "intptr" = IntPtr
91findBuiltIntType "size" = Size
92findBuiltIntType "bool" = Bool
93findBuiltIntType "string" = String
94findBuiltIntType "char" = Char
95findBuiltIntType "capref" = Capref
96findBuiltIntType s = error  $ "Undefined builtin type " ++ s
97
98
99builtin_fmt_wr :: TypeBuiltIn -> String
100builtin_fmt_wr (UInt8)   = "PRIu8"
101builtin_fmt_wr (UInt16)  = "PRIu16"
102builtin_fmt_wr (UInt32)  = "PRIu32"
103builtin_fmt_wr (UInt64)  = "PRIu64"
104builtin_fmt_wr (UIntPtr) = "PRIuPTR"
105builtin_fmt_wr (Int8)    = "PRIi8"
106builtin_fmt_wr (Int16)   = "PRIi16"
107builtin_fmt_wr (Int32)   = "PRIi32"
108builtin_fmt_wr (Int64)   = "PRIi64"
109builtin_fmt_wr (IntPtr)  = "PRIuPTR"
110builtin_fmt_wr (Size)    = "PRIuSIZE"
111builtin_fmt_wr (Bool)    = "\"i\""
112builtin_fmt_wr (String)  = "\"s\""
113builtin_fmt_wr (Char)    = "\"c\""
114
115
116builtin_fmt_rd :: TypeBuiltIn -> String
117builtin_fmt_rd (UInt8)   = "SCNu8"
118builtin_fmt_rd (UInt16)  = "SCNu16"
119builtin_fmt_rd (UInt32)  = "SCNu32"
120builtin_fmt_rd (UInt64)  = "SCNu64"
121builtin_fmt_rd (UIntPtr) = "SCNuPTR"
122builtin_fmt_rd (Int8)    = "SCNi8"
123builtin_fmt_rd (Int16)   = "SCNi16"
124builtin_fmt_rd (Int32)   = "SCNi32"
125builtin_fmt_rd (Int64)   = "SCNi64"
126builtin_fmt_rd (IntPtr)  = "SCNuPTR"
127builtin_fmt_rd (Size)    = "SCNuSIZE"
128builtin_fmt_rd (Bool)    = "\"i\""
129builtin_fmt_rd (String)  = "\"s\""
130builtin_fmt_rd (Char)    = "\"c\""
131
132builtin_get_bits:: TypeBuiltIn -> Integer
133builtin_get_bits (UInt8)   = 8
134builtin_get_bits (UInt16)  = 16
135builtin_get_bits (UInt32)  = 32
136builtin_get_bits (UInt64)  = 64
137builtin_get_bits (UIntPtr) = 64 -- xxx: make this arch specific!
138builtin_get_bits (Int8)    = 8
139builtin_get_bits (Int16)   = 16
140builtin_get_bits (Int32)   = 32
141builtin_get_bits (Int64)   = 64
142builtin_get_bits (IntPtr)  = 64 -- xxx: make this arch specific!
143builtin_get_bits (Size)    = 64 -- xxx: make this arch specific!
144builtin_get_bits (Bool)    = 8
145builtin_get_bits (Char)    = 8
146
147builtin_flag_type :: Integer -> TypeBuiltIn
148builtin_flag_type 64 = UInt64
149builtin_flag_type 32 = UInt32
150builtin_flag_type 16 = UInt16
151builtin_flag_type  8 = UInt8
152