@@ -2,57 +2,28 @@
22module Build.Source (build) where
33
44import qualified Data.Map as Map
5−import System.FilePath as FP
65import Text.PrettyPrint (Doc)
76
8−import AST.Declaration
97import AST.Module
10−import qualified AST.Expression.General as Expr
11−import qualified AST.Pattern as Pattern
12−import qualified AST.Type as Type
138import qualified Parse.Parse as Parse
149import qualified Metadata.Prelude as Prelude
1510import qualified Transform.Check as Check
16−import qualified Transform.SortDefinitions as SD
1711import qualified Type.Inference as TI
18−import qualified Transform.Declaration as TcDecl
1912import qualified Transform.Canonicalize as Canonical
2013
21−build :: Bool -> Interfaces -> String -> Either [Doc] MetadataModule
14+build :: Bool -> Interfaces -> String -> Either [Doc] CanonicalModule
2215build noPrelude interfaces source =
23− do let add = Prelude.add noPrelude
24− infixes = Map.fromList . map (\(assoc,lvl,op) -> (op,(lvl,assoc)))
16+ do let infixes = Map.fromList . map (\(assoc,lvl,op) -> (op,(lvl,assoc)))
2517 . concatMap iFixities $ Map.elems interfaces
2618
27− Module names exs ims decls <- do
28− modul@(Module _ _ _ decls) <- add `fmap` Parse.program infixes source
29− case Check.mistakes decls of
30− [] -> return modul
31− ms -> Left ms
19+ validModule <- do
20+ modul <- Prelude.add noPrelude `fmap` Parse.program infixes source
21+ case Check.mistakes (body modul) of
22+ [] -> return modul
23+ ms -> Left ms
3224
33− let exports'
34− | null exs =
35− let get = Pattern.boundVarList in
36− concat [ get pattern | Definition (Expr.Definition pattern _ _) <- decls ] ++
37− concat [ map fst ctors | Datatype _ _ ctors <- decls ] ++
38− [ name | TypeAlias name _ (Type.Record _ _) <- decls ]
39− | otherwise = exs
25+ canonicalModule <- Canonical.module' interfaces validModule
4026
41− metaModule <- Canonical.metadataModule interfaces $
42− MetadataModule
43− { names = names
44− , path = FP.joinPath names
45− , exports = exports'
46− , imports = ims
47− -- reorder AST into strongly connected components
48− , program = SD.sortDefs . Expr.dummyLet $ TcDecl.toExpr decls
49− , types = Map.empty
50− , datatypes = [ (name,vars,ctors) | Datatype name vars ctors <- decls ]
51− , fixities = [ (assoc,level,op) | Fixity assoc level op <- decls ]
52− , aliases = [ (name,tvs,tipe) | TypeAlias name tvs tipe <- decls ]
53− , ports = [ portName port | Port port <- decls ]
54− }
27+ types <- TI.infer interfaces canonicalModule
5528
56− types <- TI.infer interfaces metaModule
57−
58− return $ metaModule { types = types }
29+ return $ canonicalModule { body = (body canonicalModule) { types = types } }