git.iko.soy/elk
on 63243ca 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 qualified Data.Set as Set
6import System.FilePath as FP
7import Text.PrettyPrint (Doc)
9import SourceSyntax.Declaration
10import SourceSyntax.Module
11import qualified SourceSyntax.Expression as Expr
12import qualified SourceSyntax.Pattern as Pattern
13import qualified SourceSyntax.Type as Type
14import qualified Parse.Parse as Parse
15import qualified Metadata.Prelude as Prelude
16import qualified Transform.Check as Check
17import qualified Transform.SortDefinitions as SD
18import qualified Type.Inference as TI
19import qualified Type.Constrain.Declaration as TcDecl
20import qualified Transform.Canonicalize as Canonical
22build :: Bool -> Interfaces -> String -> Either [Doc] MetadataModule
23build noPrelude interfaces source =
24 do let add = Prelude.add noPrelude
25 infixes = Map.fromList . map (\(assoc,lvl,op) -> (op,(lvl,assoc)))
26 . concatMap iFixities $ Map.elems interfaces
28 Module names exs ims decls <- do
29 modul@(Module _ _ _ decls) <- add `fmap` Parse.program infixes source
30 case Check.mistakes decls of
31 [] -> return modul
32 ms -> Left ms
34 let exports'
35 | null exs =
36 let get = Set.toList . Pattern.boundVars in
37 concat [ get pattern | Definition (Expr.Definition pattern _ _) <- decls ] ++
38 concat [ map fst ctors | Datatype _ _ ctors _ <- decls ] ++
39 [ name | TypeAlias name _ (Type.Record _ _) _ <- decls ]
40 | otherwise = exs
42 metaModule <- Canonical.metadataModule interfaces $
43 MetadataModule
44 { names = names
45 , path = FP.joinPath names
46 , exports = exports'
47 , imports = ims
48 -- reorder AST into strongly connected components
49 , program = SD.sortDefs . Expr.dummyLet $ TcDecl.toExpr decls
50 , types = Map.empty
51 , datatypes = [ (name,vars,ctors,ds) | Datatype name vars ctors ds <- decls ]
52 , fixities = [ (assoc,level,op) | Fixity assoc level op <- decls ]
53 , aliases = [ (name,tvs,tipe,ds) | TypeAlias name tvs tipe ds <- decls ]
54 }
56 types <- TI.infer interfaces metaModule
58 return $ metaModule { types = types }