git.iko.soy/elk
on 89bbbb9 help sign in
elk/compiler/AST/Module.hs
128 lines 3.7 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
14import AST.PrettyPrint
15import Text.PrettyPrint as P
17import qualified Elm.Internal.Version as Version
19data Module exs body = Module
20 { names :: [String]
21 , path :: FilePath
22 , exports :: exs
23 , imports :: [(String, ImportMethod)]
24 , body :: body
25 }
27getName :: Module exs body -> String
28getName modul =
29 List.intercalate "." (names modul)
31data CanonicalBody = CanonicalBody
32 { program :: Canonical.Expr
33 , types :: Types
34 , fixities :: [(Decl.Assoc, Int, String)]
35 , aliases :: Aliases
36 , datatypes :: ADTs
37 , ports :: [String]
38 }
40type SourceModule = Module (Var.Listing Var.Value) [Decl.SourceDecl]
41type ValidModule = Module (Var.Listing Var.Value) [Decl.ValidDecl]
42type CanonicalModule = Module [Var.Value] CanonicalBody
44type Interfaces = Map.Map String Interface
46type Types = Map.Map String Type.CanonicalType
47type Aliases = Map.Map String ( [String], Type.CanonicalType )
48type ADTs = Map.Map String (AdtInfo String)
50type AdtInfo v = ( [String], [(v, [Type.CanonicalType])] )
51type CanonicalAdt = (Var.Canonical, AdtInfo Var.Canonical)
53data Interface = Interface
54 { iVersion :: Version.Version
55 , iExports :: [Var.Value]
56 , iTypes :: Types
57 , iImports :: [(String, ImportMethod)]
58 , iAdts :: ADTs
59 , iAliases :: Aliases
60 , iFixities :: [(Decl.Assoc, Int, String)]
61 , iPorts :: [String]
62 }
64toInterface :: CanonicalModule -> Interface
65toInterface modul =
66 let body' = body modul in
67 Interface
68 { iVersion = Version.elmVersion
69 , iExports = exports modul
70 , iTypes = types body'
71 , iImports = imports modul
72 , iAdts = datatypes body'
73 , iAliases = aliases body'
74 , iFixities = fixities body'
75 , iPorts = ports body'
76 }
78instance Binary Interface where
79 get = Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get
80 put modul = do
81 put (iVersion modul)
82 put (iExports modul)
83 put (iTypes modul)
84 put (iImports modul)
85 put (iAdts modul)
86 put (iAliases modul)
87 put (iFixities modul)
88 put (iPorts modul)
90data ImportMethod
91 = As !String
92 | Open !(Var.Listing Var.Value)
94open :: ImportMethod
95open = Open (Var.openListing)
97importing :: [Var.Value] -> ImportMethod
98importing xs = Open (Var.Listing xs False)
100instance Binary ImportMethod where
101 put method =
102 case method of
103 As alias -> putWord8 0 >> put alias
104 Open listing -> putWord8 1 >> put listing
106 get = do tag <- getWord8
107 case tag of
108 0 -> As <$> get
109 1 -> Open <$> get
110 _ -> error "Error reading valid ImportMethod type from serialized string"
112instance (Pretty exs, Pretty body) => Pretty (Module exs body) where
113 pretty (Module names _ exs ims body) =
114 P.vcat [modul, P.text "", prettyImports, P.text "", pretty body]
115 where
116 modul = P.text "module" <+> name <+> pretty exs <+> P.text "where"
117 name = P.text (List.intercalate "." names)
119 prettyImports = P.vcat $ map prettyMethod ims
121prettyMethod :: (String, ImportMethod) -> Doc
122prettyMethod (name, method) =
123 case method of
124 As alias
125 | name == alias -> P.empty
126 | otherwise -> P.text "as" <+> P.text alias
128 Open listing -> pretty listing