git.iko.soy/elk
on 2da9009 help sign in
elk/compiler/Build/Source.hs
65 lines 2.6 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.Declaration
15import SourceSyntax.Module
16import qualified SourceSyntax.Expression as Expr
17import qualified SourceSyntax.Type as Type
18import qualified Parse.Parse as Parse
19import qualified Metadata.Prelude as Prelude
20import qualified Transform.Check as Check
21import qualified Transform.SortDefinitions as SD
22import qualified Type.Inference as TI
23import qualified Type.Constrain.Declaration as TcDecl
24import qualified Transform.Canonicalize as Canonical
26build :: Bool -> Interfaces -> String -> Either [Doc] (MetadataModule () ())
27build noPrelude interfaces source =
28 do let add = if noPrelude then id else Prelude.add
29 infixes = Map.fromList . map (\(assoc,lvl,op) -> (op,(lvl,assoc)))
30 . concatMap iFixities $ Map.elems interfaces
32 modul@(Module _ _ _ decls') <- add `fmap` Parse.program infixes source
34 -- check for structural errors
35 Module names exs ims decls <-
36 case Check.mistakes decls' of
37 [] -> return modul
38 ms -> Left ms
40 let exports'
41 | null exs =
42 let get = Set.toList . SD.boundVars in
43 concat [ get pattern | Definition (Expr.Def pattern _) <- decls ] ++
44 concat [ map fst ctors | Datatype _ _ ctors <- decls ] ++
45 [ name | TypeAlias name _ (Type.Record _ _) <- decls ]
46 | otherwise = exs
48 metaModule <- Canonical.metadataModule interfaces $ MetadataModule {
49 names = names,
50 path = FP.joinPath names,
51 exports = exports',
52 imports = ims,
53 -- reorder AST into strongly connected components
54 program = SD.sortDefs . Expr.dummyLet $ TcDecl.toExpr decls,
55 types = Map.empty,
56 datatypes = [ (name,vars,ctors) | Datatype name vars ctors <- decls ],
57 fixities = [ (assoc,level,op) | Fixity assoc level op <- decls ],
58 aliases = [ (name,tvs,tipe) | TypeAlias name tvs tipe <- decls ],
59 foreignImports = [ (evt,v,name,typ) | ImportEvent evt v name typ <- decls ],
60 foreignExports = [ (evt,name,typ) | ExportEvent evt name typ <- decls ]
61 }
63 types <- TI.infer interfaces metaModule
65 return $ metaModule { types = types }