git.iko.soy/elk
on 3a4863f help sign in
elk/compiler/SourceSyntax/Module.hs
101 lines 3.5 kB history raw
1{-# LANGUAGE DeriveDataTypeable #-}
2module SourceSyntax.Module where
4import Data.Data
5import Data.Binary
6import Data.List (intercalate)
7import qualified Data.Map as Map
8import Control.Applicative ((<$>), (<*>))
9import Control.Arrow (second)
11import SourceSyntax.Expression (LExpr)
12import SourceSyntax.Declaration
13import SourceSyntax.Type
14import System.FilePath (joinPath)
15import qualified Type.Type as Type
17data Module tipe var =
18 Module [String] Exports Imports [Declaration tipe var]
19 deriving (Show)
21type Exports = [String]
23type Imports = [(String, ImportMethod)]
24data ImportMethod = As String | Importing [String] | Hiding [String]
25 deriving (Eq, Ord, Show, Data, Typeable)
27data MetadataModule t v = MetadataModule {
28 names :: [String],
29 path :: FilePath,
30 exports :: [String],
31 imports :: [(String, ImportMethod)],
32 program :: LExpr t v,
33 types :: Map.Map String Type.Variable,
34 fixities :: [(Assoc, Int, String)],
35 aliases :: [(String, [String], Type)],
36 datatypes :: [ (String, [String], [(String,[Type])]) ],
37 foreignImports :: [(String, LExpr t v, String, Type)],
38 foreignExports :: [(String, String, Type)]
41type Interfaces = Map.Map String ModuleInterface
42type ADT = (String, [String], [(String,[Type])])
44data ModuleInterface = ModuleInterface {
45 iTypes :: Map.Map String Type,
46 iAdts :: [ADT],
47 iAliases :: [(String, [String], Type)]
48} deriving Show
50instance Binary ModuleInterface where
51 put modul = put (iTypes modul) >> put (iAdts modul) >> put (iAliases modul)
52 get = ModuleInterface <$> get <*> get <*> get
55canonicalize :: String -> [ImportMethod] -> ModuleInterface -> ModuleInterface
56canonicalize prefix importMethods interface =
57 ModuleInterface { iTypes = Map.unions (map iTypes ifaces)
58 , iAdts = concatMap iAdts ifaces
59 , iAliases = concatMap iAliases ifaces }
60 where
61 ifaces = map (canonicalizeHelp prefix interface) importMethods
64canonicalizeHelp :: String -> ModuleInterface -> ImportMethod -> ModuleInterface
65canonicalizeHelp prefix interface importMethod =
66 ModuleInterface {
67 iTypes = renameNames $ Map.map (renameType rename) (iTypes interface),
68 iAdts = map renameADT (iAdts interface),
69 iAliases = iAliases interface
70 }
71 where
72 addPrefix name = prefix ++ "." ++ name
74 newName (tipe,_,_) =
75 case importMethod of
76 As name -> (tipe, name ++ "." ++ tipe)
77 Hiding vs -> (tipe, if tipe `elem` vs then addPrefix tipe else tipe)
78 Importing vs -> (tipe, if tipe `elem` vs then tipe else addPrefix tipe)
79 newNames = Map.fromList . map newName $ iAdts interface
81 rename name = Map.findWithDefault name name newNames
83 renameADT (name, tvars, ctors) =
84 (rename name, tvars, map (second (map (renameType rename))) ctors)
86 renameNames tipes =
87 case importMethod of
88 As alias -> Map.mapKeys (\v -> alias ++ "." ++ v) tipes
89 Hiding hidens -> foldr Map.delete tipes hidens
90 Importing visibles ->
91 Map.intersection tipes (Map.fromList [ (v,()) | v <- visibles ])
93renameType :: (String -> String) -> Type -> Type
94renameType find tipe =
95 let rnm = renameType find in
96 case tipe of
97 Lambda a b -> Lambda (rnm a) (rnm b)
98 Var x -> Var x
99 Data name ts -> Data (find name) (map rnm ts)
100 EmptyRecord -> EmptyRecord
101 Record fields ext -> Record (map (second rnm) fields) (rnm ext)