git.iko.soy/elk
on 89ba043 help sign in
elk/compiler/AST/Module.hs
162 lines 4.2 kB history raw
1{-# OPTIONS_GHC -W #-}
2module AST.Module where
4import Data.Binary
5import qualified Data.List as List
6import qualified Data.Map as Map
7import Control.Applicative ((<$>),(<*>))
9import qualified AST.Expression.Canonical as Canonical
10import qualified AST.Declaration as Decl
11import qualified AST.Type as Type
12import qualified AST.Variable as Var
13import AST.PrettyPrint
14import Text.PrettyPrint as P
15import qualified Elm.Internal.Version as Version
18-- HELPFUL TYPE ALIASES
20type Interfaces = Map.Map String Interface
22type Types = Map.Map String Type.CanonicalType
23type Aliases = Map.Map String ([String], Type.CanonicalType)
24type ADTs = Map.Map String (AdtInfo String)
26type AdtInfo v = ( [String], [(v, [Type.CanonicalType])] )
27type CanonicalAdt = (Var.Canonical, AdtInfo Var.Canonical)
30-- MODULES
32type SourceModule =
33 Module (Var.Listing Var.Value) [Decl.SourceDecl]
35type ValidModule =
36 Module (Var.Listing Var.Value) [Decl.ValidDecl]
38type CanonicalModule =
39 Module [Var.Value] CanonicalBody
41getName :: Module exs body -> String
42getName modul =
43 nameToString (names modul)
45data Module exports body = Module
46 { names :: Name
47 , path :: FilePath
48 , exports :: exports
49 , imports :: [(String, ImportMethod)]
50 , body :: body
51 }
53data CanonicalBody = CanonicalBody
54 { program :: Canonical.Expr
55 , types :: Types
56 , fixities :: [(Decl.Assoc, Int, String)]
57 , aliases :: Aliases
58 , datatypes :: ADTs
59 , ports :: [String]
60 }
63-- HEADERS
65{-| Basic info needed to identify modules and determine dependencies. -}
66data HeaderAndImports = HeaderAndImports
67 { _names :: Name
68 , _exports :: Var.Listing Var.Value
69 , _imports :: [(Name, ImportMethod)]
70 }
72type Name = [String] -- must be non-empty
74nameToString :: Name -> String
75nameToString = List.intercalate "."
78-- INTERFACES
80{-| Key facts about a module, used when reading info from .elmi files. -}
81data Interface = Interface
82 { iVersion :: Version.Version
83 , iExports :: [Var.Value]
84 , iTypes :: Types
85 , iImports :: [(String, ImportMethod)]
86 , iAdts :: ADTs
87 , iAliases :: Aliases
88 , iFixities :: [(Decl.Assoc, Int, String)]
89 , iPorts :: [String]
90 }
92toInterface :: CanonicalModule -> Interface
93toInterface modul =
94 let body' = body modul in
95 Interface
96 { iVersion = Version.elmVersion
97 , iExports = exports modul
98 , iTypes = types body'
99 , iImports = imports modul
100 , iAdts = datatypes body'
101 , iAliases = aliases body'
102 , iFixities = fixities body'
103 , iPorts = ports body'
104 }
106instance Binary Interface where
107 get = Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get
108 put modul = do
109 put (iVersion modul)
110 put (iExports modul)
111 put (iTypes modul)
112 put (iImports modul)
113 put (iAdts modul)
114 put (iAliases modul)
115 put (iFixities modul)
116 put (iPorts modul)
119-- IMPORT METHOD
121data ImportMethod
122 = As !String
123 | Open !(Var.Listing Var.Value)
125open :: ImportMethod
126open = Open (Var.openListing)
128importing :: [Var.Value] -> ImportMethod
129importing xs = Open (Var.Listing xs False)
131instance Binary ImportMethod where
132 put method =
133 case method of
134 As alias -> putWord8 0 >> put alias
135 Open listing -> putWord8 1 >> put listing
137 get = do tag <- getWord8
138 case tag of
139 0 -> As <$> get
140 1 -> Open <$> get
141 _ -> error "Error reading valid ImportMethod type from serialized string"
144-- PRETTY PRINTING
146instance (Pretty exs, Pretty body) => Pretty (Module exs body) where
147 pretty (Module names _ exs ims body) =
148 P.vcat [modul, P.text "", prettyImports, P.text "", pretty body]
149 where
150 modul = P.text "module" <+> name <+> pretty exs <+> P.text "where"
151 name = P.text (List.intercalate "." names)
153 prettyImports = P.vcat $ map prettyMethod ims
155prettyMethod :: (String, ImportMethod) -> Doc
156prettyMethod (name, method) =
157 case method of
158 As alias
159 | name == alias -> P.empty
160 | otherwise -> P.text "as" <+> P.text alias
162 Open listing -> pretty listing