on dc795ca help sign in
elk/compiler/Build/Source.hs
58 lines 2.3 kB history raw
1{-# OPTIONS_GHC -W #-}
2module Build.Source (build) where
4import qualified Data.Map as Map
5import System.FilePath as FP
6import Text.PrettyPrint (Doc)
8import SourceSyntax.Declaration
9import SourceSyntax.Module
10import qualified SourceSyntax.Expression as Expr
11import qualified SourceSyntax.Pattern as Pattern
12import qualified SourceSyntax.Type as Type
13import qualified Parse.Parse as Parse
14import qualified Metadata.Prelude as Prelude
15import qualified Transform.Check as Check
16import qualified Transform.SortDefinitions as SD
17import qualified Type.Inference as TI
18import qualified Type.Constrain.Declaration as TcDecl
19import qualified Transform.Canonicalize as Canonical
21build :: Bool -> Interfaces -> String -> Either [Doc] MetadataModule
22build noPrelude interfaces source =
23 do let add = Prelude.add noPrelude
24 infixes = Map.fromList . map (\(assoc,lvl,op) -> (op,(lvl,assoc)))
25 . concatMap iFixities $ Map.elems interfaces
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
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
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 }
56 types <- TI.infer interfaces metaModule
58 return $ metaModule { types = types }