From 03d38eb3190eb5e51fb18847fe0792013285bde5 Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Tue, 8 Apr 2014 15:06:40 +1000
Subject: Reorganising source code

---
 src/Library/TypeVar.hs | 99 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 99 insertions(+)
 create mode 100644 src/Library/TypeVar.hs

(limited to 'src/Library/TypeVar.hs')

diff --git a/src/Library/TypeVar.hs b/src/Library/TypeVar.hs
new file mode 100644
index 0000000..d2915e6
--- /dev/null
+++ b/src/Library/TypeVar.hs
@@ -0,0 +1,99 @@
+module Library.TypeVar (
+	Number,
+
+	Name(..),
+
+	TypeOp(..),
+
+	Type(..),
+
+	Const(..),
+
+	Var(..),
+
+	mkEqualsType,
+	typeFunc,
+	typeBool,
+	typeVarsInType,
+	isTypeVar,
+	typeVarSub
+	) where
+
+
+
+import Data.List
+import Data.Maybe
+import qualified Data.Set as Set
+import Data.Map( Map, (!) )
+import qualified Data.Map as Map
+
+
+
+type Number = Int
+
+data Name = Name { nameSpace :: [String]
+                 , nameId :: String } deriving (Eq, Ord)
+
+data TypeOp = TypeOp { tyOp :: Name } deriving (Eq, Ord)
+
+data Type = TypeVar { typeVar :: Name }
+          | AType { aType :: [Type]
+                  , aTypeOp :: TypeOp } deriving (Eq, Ord)
+
+data Const = Const { constName :: Name } deriving (Eq, Ord)
+
+data Var = Var { varName :: Name
+               , varTy :: Type } deriving (Eq, Ord)
+
+
+
+instance Show Name where
+    show a   =   intercalate "." (nameSpace a ++ [nameId a])
+
+instance Show TypeOp where
+    show a   =   "typeOp " ++ (show $ tyOp a)
+
+instance Show Type where
+    show (TypeVar tyVar)   =   "V " ++ (show tyVar)
+    show (AType [] (TypeOp (Name [] "bool"))) = "bool"
+    show (AType [d,r] (TypeOp (Name [] "->"))) = "(" ++ show d ++ " -> " ++ show r ++ ")"
+    show (AType list typeOp) =   "type " ++ (show $ tyOp typeOp) ++ " " ++ (show list)
+
+instance Show Const where
+    show (Const a)   =   show a
+
+instance Show Var where
+    show (Var a _)   =   show a
+
+
+
+mkEqualsType :: Type -> Type
+mkEqualsType ty = typeFunc ty (typeFunc ty typeBool)
+
+
+typeFunc :: Type -> Type -> Type
+typeFunc ty1 ty2 = AType [ty1,ty2] (TypeOp (Name [] "->"))
+
+
+typeBool :: Type
+typeBool = AType [] (TypeOp (Name [] "bool"))
+
+
+typeVarsInType :: Type -> Set.Set Type
+typeVarsInType (TypeVar t) = Set.singleton (TypeVar t)
+typeVarsInType (AType list _) = Set.unions . (map typeVarsInType) $ list
+
+
+isTypeVar :: Type -> Bool
+isTypeVar (TypeVar _) = True
+isTypeVar _ = False
+
+
+typeVarSub :: Map Name Type -> Type -> Type
+typeVarSub m (TypeVar a) = 
+	if (Map.member a m)
+	then fromJust (Map.lookup a m)
+	else TypeVar a
+typeVarSub m (AType list op) =
+	AType (map (typeVarSub m) list) op
+
-- 
cgit