diff --git a/src/Tessera/Env.hs b/src/Tessera/Env.hs new file mode 100644 index 0000000..c63a311 --- /dev/null +++ b/src/Tessera/Env.hs @@ -0,0 +1,76 @@ +module Tessera.Env where + +import Data.List (foldl') +import qualified Data.Map.Strict as Map + +import Tessera.Syntax + +data TypeDef = TypeDef + { typeDefinitionParams :: [String] + , typeDefinitionConstructors :: [Constructor] + } deriving (Eq, Show) + +data Env = Env + { envTypes :: Map.Map String TypeDef + , envConstructorTypes :: Map.Map String (String, [Type]) + } deriving (Eq, Show) + +builtinTypes :: Map.Map String TypeDef +builtinTypes = Map.fromList + [ ("Int", TypeDef [] []) + , ("Bool", TypeDef [] [Constructor "True" [], Constructor "False" []]) + ] + +builtinConstructors :: Map.Map String (String, [Type]) +builtinConstructors = Map.fromList + [ ("True", ("Bool", [])) + , ("False", ("Bool", [])) + ] + +buildEnv :: Program -> Either Diagnostic Env +buildEnv program = do + types <- foldl' addType (Right builtinTypes) [d | d <- program, isData d] + let constructors = foldl' addConstructors builtinConstructors [d | d <- program, isData d] + return (Env types constructors) + where + isData (DataDeclaration _ _ _) = True + isData _ = False + + addType acc (DataDeclaration name params constructors) + | name `elem` ["Int", "Bool"] = Left (Diagnostic (Span 0 0) ("cannot redeclare builtin type " ++ name)) + | otherwise = do + table <- acc + case Map.lookup name table of + Just _ -> Left (Diagnostic (Span 0 0) ("duplicate type declaration " ++ name)) + Nothing -> Right (Map.insert name (TypeDef params constructors) table) + addType acc _ = acc + + addConstructors table (DataDeclaration name _ constructors) = + foldl' (\m c -> Map.insert (constructorName c) (name, constructorArgs c) m) table constructors + addConstructors table _ = table + +lookupConstructor :: Env -> String -> Maybe (String, [Type]) +lookupConstructor env name = Map.lookup name (envConstructorTypes env) + +lookupType :: Env -> String -> Maybe TypeDef +lookupType env name = Map.lookup name (envTypes env) + +constructorArity :: Env -> String -> Maybe Int +constructorArity env name = length . snd <$> lookupConstructor env name + +substitute :: Map.Map String Type -> Type -> Type +substitute mapping ty = case ty of + TVar name -> Map.findWithDefault (TVar name) name mapping + TName name arguments -> TName name (map (substitute mapping) arguments) + TTuple elements -> TTuple (map (substitute mapping) elements) + +instantiate :: [String] -> [Type] -> [Type] -> [Type] +instantiate params arguments = map (substitute mapping) + where mapping = Map.fromList (zip params arguments) + +typeEquals :: Type -> Type -> Bool +typeEquals left right = case (left, right) of + (TName a as, TName b bs) -> a == b && length as == length bs && and (zipWith typeEquals as bs) + (TVar a, TVar b) -> a == b + (TTuple as, TTuple bs) -> length as == length bs && and (zipWith typeEquals as bs) + _ -> False