git.iko.soy/elk
on 481a730 help sign in
elk/compiler/AST/Module.hs
125 lines 3.6 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 , iTypes :: Types
56 , iImports :: [(String, ImportMethod)]
57 , iAdts :: ADTs
58 , iAliases :: Aliases
59 , iFixities :: [(Decl.Assoc, Int, String)]
60 , iPorts :: [String]
61 }
63toInterface :: CanonicalModule -> Interface
64toInterface modul =
65 let body' = body modul in
66 Interface
67 { iVersion = Version.elmVersion
68 , iTypes = types body'
69 , iImports = imports modul
70 , iAdts = datatypes body'
71 , iAliases = aliases body'
72 , iFixities = fixities body'
73 , iPorts = ports body'
74 }
76instance Binary Interface where
77 get = Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get
78 put modul = do
79 put (iVersion modul)
80 put (iTypes modul)
81 put (iImports modul)
82 put (iAdts modul)
83 put (iAliases modul)
84 put (iFixities modul)
85 put (iPorts modul)
87data ImportMethod
88 = As !String
89 | Open !(Var.Listing Var.Value)
91open :: ImportMethod
92open = Open (Var.openListing)
94importing :: [Var.Value] -> ImportMethod
95importing xs = Open (Var.Listing xs False)
97instance Binary ImportMethod where
98 put method =
99 case method of
100 As alias -> putWord8 0 >> put alias
101 Open listing -> putWord8 1 >> put listing
103 get = do tag <- getWord8
104 case tag of
105 0 -> As <$> get
106 1 -> Open <$> get
107 _ -> error "Error reading valid ImportMethod type from serialized string"
109instance (Pretty exs, Pretty body) => Pretty (Module exs body) where
110 pretty (Module names _ exs ims body) =
111 P.vcat [modul, P.text "", prettyImports, P.text "", pretty body]
112 where
113 modul = P.text "module" <+> name <+> pretty exs <+> P.text "where"
114 name = P.text (List.intercalate "." names)
116 prettyImports = P.vcat $ map prettyMethod ims
118prettyMethod :: (String, ImportMethod) -> Doc
119prettyMethod (name, method) =
120 case method of
121 As alias
122 | name == alias -> P.empty
123 | otherwise -> P.text "as" <+> P.text alias
125 Open listing -> pretty listing