git.iko.soy/elk
on 2f8b048 help sign in
elk/compiler/AST/Module.hs
131 lines 3.7 kB history raw
1{-# OPTIONS_GHC -W #-}
2module AST.Module where
4import Data.Binary
5import qualified Data.Map as Map
6import Control.Applicative ((<$>),(<*>))
8import qualified AST.Expression.Canonical as Canonical
9import qualified AST.Type as Type
10import qualified AST.Variable as Var
11import qualified SourceSyntax.Declaration as Decl
13import qualified Elm.Internal.Version as Version
15data Module exs body = Module
16 { names :: [String]
17 , path :: FilePath
18 , exports :: exs
19 , imports :: [(String, ImportMethod)]
20 , body :: body
21 }
23data CanonicalBody = CanonicalBody
24 { program :: Canonical.Expr
25 , types :: Types
26 , fixities :: [(Decl.Assoc, Int, String)]
27 , aliases :: [Alias]
28 , datatypes :: [ADT]
29 , ports :: [String]
30 }
32type SourceModule = Module (Var.Listing Var.Value) [Decl.SourceDecl]
33type ValidModule = Module (Var.Listing Var.Value) [Decl.ValidDecl]
34type CanonicalModule = Module [Var.Value] CanonicalBody
36type Interfaces = Map.Map String Interface
38type Types = Map.Map String (Type.Type Var.Canonical)
39type ADT = ( String, [String], [(String, [Type.Type Var.Canonical])] )
40type Alias = (String, [String], Type.Type Var.Canonical )
42data Interface = Interface
43 { iVersion :: Version.Version
44 , iTypes :: Types
45 , iImports :: [(String, ImportMethod)]
46 , iAdts :: [ADT]
47 , iAliases :: [Alias]
48 , iFixities :: [(Decl.Assoc, Int, String)]
49 , iPorts :: [String]
50 }
52toInterface :: CanonicalModule -> Interface
53toInterface modul =
54 let body' = body modul in
55 Interface
56 { iVersion = Version.elmVersion
57 , iTypes = types body'
58 , iImports = imports modul
59 , iAdts = datatypes body'
60 , iAliases = aliases body'
61 , iFixities = fixities body'
62 , iPorts = ports body'
63 }
65instance Binary Interface where
66 get = Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get
67 put modul = do
68 put (iVersion modul)
69 put (iTypes modul)
70 put (iImports modul)
71 put (iAdts modul)
72 put (iAliases modul)
73 put (iFixities modul)
74 put (iPorts modul)
76data ImportMethod
77 = As !String
78 | Open !(Var.Listing Var.Value)
80open :: ImportMethod
81open = Open (Var.openListing)
83importing :: [String] -> ImportMethod
84importing xs = Open (Var.Listing (map Var.Value xs) False)
86instance Binary ImportMethod where
87 put method =
88 let put' n info = putWord8 n >> put info in
89 case method of
90 As alias -> put' 0 alias
91 Open listing -> put' 1 listing
93 get = do tag <- getWord8
94 case tag of
95 0 -> As <$> get
96 1 -> Open <$> get
97 _ -> error "Error reading valid ImportMethod type from serialized string"
99{-
100data Module port def = Module
101 { name :: [String]
102 , exports :: Var.Listing Var.Value
103 , imports :: [(String, ImportMethod)]
104 , decls :: [Declaration' port def]
105 }
107instance (Pretty port, Pretty def) => Pretty (Module port def) where
108 pretty (Module names exs ims decls) =
109 P.vcat [modul, P.text "", prettyImports, P.text "", prettyDecls]
110 where
111 modul = P.text "module" <+> name <+> prettyExports <+> P.text "where"
112 name = P.text (List.intercalate "." names)
114 prettyExports
115 | Var._open exs = P.empty
116 | otherwise = pretty exs
118 prettyImports = P.vcat $ map prettyMethod ims
120 prettyDecls = P.sep $ map pretty decls
122prettyMethod :: (String, ImportMethod) -> Doc
123prettyMethod (name, method) =
124 case method of
125 As alias
126 | name == alias -> P.empty
127 | otherwise -> P.text "as" <+> P.text alias
129 Open listing -> pretty listing
131-}