git.iko.soy/elk
on 06503fe 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.Pattern as Pattern
18import qualified SourceSyntax.Type as Type
19import qualified Parse.Parse as Parse
20import qualified Metadata.Prelude as Prelude
21import qualified Transform.Check as Check
22import qualified Transform.SortDefinitions as SD
23import qualified Type.Inference as TI
24import qualified Type.Constrain.Declaration as TcDecl
25import qualified Transform.Canonicalize as Canonical
27build :: Bool -> Interfaces -> String -> Either [Doc] MetadataModule
28build noPrelude interfaces source =
29 do let add = if noPrelude then id else Prelude.add
30 infixes = Map.fromList . map (\(assoc,lvl,op) -> (op,(lvl,assoc)))
31 . concatMap iFixities $ Map.elems interfaces
33 Module names exs ims decls <- do
34 modul@(Module _ _ _ decls) <- add `fmap` Parse.program infixes source
35 case Check.mistakes decls of
36 [] -> return modul
37 ms -> Left ms
39 let exports'
40 | null exs =
41 let get = Set.toList . Pattern.boundVars in
42 concat [ get pattern | Definition (Expr.Definition pattern _ _) <- decls ] ++
43 concat [ map fst ctors | Datatype _ _ ctors _ <- decls ] ++
44 [ name | TypeAlias name _ (Type.Record _ _) _ <- decls ]
45 | otherwise = exs
47 metaModule <- Canonical.metadataModule interfaces $
48 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,ds) | Datatype name vars ctors ds <- decls ]
57 , fixities = [ (assoc,level,op) | Fixity assoc level op <- decls ]
58 , aliases = [ (name,tvs,tipe,ds) | TypeAlias name tvs tipe ds <- decls ]
59 , sendPorts = [ (name,expr,tipe) | Port (Send name expr tipe) <- decls ]
60 , recvPorts = [ (name,expr,tipe) | Port (Recv name expr tipe) <- decls ]
61 }
63 types <- TI.infer interfaces metaModule
65 return $ metaModule { types = types }