{- Data type annotations. These are enough to represent C primitives,
stuctures and pointers/arrays. -}
module Type (Type(..),
TypeName(..),
TypeTree(..),
TypeOrder,
typeHash,
-- FIXME
typed
) where
data TypeName = AFloat | AInt | ABool | AVoid -- atomic
| ATree TypeTree -- composite
| AType Int -- indexed type (see PrettyC.hs)
deriving (Eq,Show)
data TypeTree = AAtom Type
| ANil
| ACons Type Type
deriving (Eq,Show)
data Type = Type TypeName TypeOrder
deriving (Eq,Show)
{- At first these were array bounds, but it seems a lot simpler to
just record pointer order instead. Solve bounding somewhere
else. -}
type TypeOrder = Int
{-
instance Show TypeName where
show AFloat = "float"
show AInt = "int"
show ABool = "bool"
show AVoid = "void" -- only used in C
show (AStruct ts) = "struct " ++ show ts
-}
typed t v o = (showOrder o) ++ (show t) ++ "." ++ v
showAs as = concat $ map (" " ++) $ map show as
showOrder 0 = ""
showOrder n = "*" ++ (showOrder $ n - 1)
-- Hashing a type as an Integer. Is there an automatic way to do
-- this? Seems it should be possible.
-- http://stackoverflow.com/a/3596536
-- this is not the Sieve of Eratosthenes
primes :: [Integer]
primes = sieve [2..]
where
sieve (p:xs) = p : sieve [x|x <- xs, x `mod` p > 0]
hashPos :: [Integer] -> Integer
hashPos is = hp is primes where
hp [] _ = 1
hp (i:is) (p:ps) = p ^ i * hp is ps
typePos :: Type -> [Integer]
typePos = typ where
name AFloat = [1]
name AInt = [2]
name ABool = [3]
name AVoid = [4]
name (AType i) = [5, 1 + toInteger i]
name (ATree t) = [6] ++ tree t
tree ANil = [1]
tree (AAtom t) = [2] ++ typ t
tree (ACons t1 t2) = [2] ++ typ t1 ++ typ t2
typ (Type n o) = name n ++ [1 + toInteger o]
-- Actually it's much simpler: encode as binary sequence, then turn
-- that into a number. Just serialize, making sure that everything is
-- self-delimiting, meaning unique prefixes and delimited numbers.
hashBin :: [Integer] -> Integer
hashBin = hb where
hb [] = 1
hb (b:bs) = b + 2 * (hb bs)
typeBin :: Type -> [Integer]
typeBin = typ where
-- One case, no prefix.
typ (Type n o) = (name n) ++ (num $ toInteger o)
-- 6 Unique prefixes.
name AFloat = [0,0,0]
name AInt = [0,0,1]
name ABool = [0,1,0]
name AVoid = [0,1,1]
name (AType n) = [1,0] ++ (num $ toInteger n)
name (ATree t) = [1,1] ++ (tree t)
-- 3 Unique prefixes
tree ANil = [0]
tree (AAtom t) = [1,0] ++ (typ t)
tree (ACons t1 t2) = [1,1] ++ (typ t1) ++ (typ t2)
-- Self-delimiting numbers.
num 0 = [0]
num n = [1, mod n 2] ++ (num $ div n 2)
-- typeHash = hashPos . typePos
typeHash = hashBin . typeBin