git.iko.soy/elk
on cbbd42d help sign in
elk/compiler/Build/Source.hs
63 lines 2.5 kB history raw
1module Build.Source (build) where
3import Data.Data
4import Control.Monad.State
5import qualified Data.Graph as Graph
6import qualified Data.List as List
7import qualified Data.Map as Map
8import qualified Data.Set as Set
9import System.Directory
10import System.Exit
11import System.FilePath as FP
12import Text.PrettyPrint (Doc)
14import SourceSyntax.Everything
15import qualified SourceSyntax.Type as Type
16import qualified Parse.Parse as Parse
17import qualified Metadata.Prelude as Prelude
18import qualified Transform.Check as Check
19import qualified Transform.SortDefinitions as SD
20import qualified Type.Inference as TI
21import qualified Type.Constrain.Declaration as TcDecl
22import qualified Transform.Canonicalize as Canonical
24build :: Bool -> Interfaces -> String -> Either [Doc] (MetadataModule () ())
25build noPrelude interfaces source =
26 do let add = if noPrelude then id else Prelude.add
27 infixes = Map.fromList . map (\(assoc,lvl,op) -> (op,(lvl,assoc)))
28 . concatMap iFixities $ Map.elems interfaces
30 modul@(Module _ _ _ decls') <- add `fmap` Parse.program infixes source
32 -- check for structural errors
33 Module names exs ims decls <-
34 case Check.mistakes decls' of
35 [] -> return modul
36 ms -> Left ms
38 let exports'
39 | null exs =
40 let get = Set.toList . SD.boundVars in
41 concat [ get pattern | Definition (Def pattern _) <- decls ] ++
42 concat [ map fst ctors | Datatype _ _ ctors <- decls ] ++
43 [ name | TypeAlias name _ (Type.Record _ _) <- decls ]
44 | otherwise = exs
46 metaModule <- Canonical.metadataModule interfaces $ MetadataModule {
47 names = names,
48 path = FP.joinPath names,
49 exports = exports',
50 imports = ims,
51 -- reorder AST into strongly connected components
52 program = SD.sortDefs . dummyLet $ TcDecl.toExpr decls,
53 types = Map.empty,
54 datatypes = [ (name,vars,ctors) | Datatype name vars ctors <- decls ],
55 fixities = [ (assoc,level,op) | Fixity assoc level op <- decls ],
56 aliases = [ (name,tvs,tipe) | TypeAlias name tvs tipe <- decls ],
57 foreignImports = [ (evt,v,name,typ) | ImportEvent evt v name typ <- decls ],
58 foreignExports = [ (evt,name,typ) | ExportEvent evt name typ <- decls ]
59 }
61 types <- TI.infer interfaces metaModule
63 return $ metaModule { types = types }