58 lines
2.2 KiB
Haskell
58 lines
2.2 KiB
Haskell
{-# OPTIONS_GHC -W #-}
|
|
module Build.Source (build) where
|
|
|
|
import qualified Data.Map as Map
|
|
import System.FilePath as FP
|
|
import Text.PrettyPrint (Doc)
|
|
|
|
import SourceSyntax.Declaration
|
|
import SourceSyntax.Module
|
|
import qualified SourceSyntax.Expression as Expr
|
|
import qualified SourceSyntax.Pattern as Pattern
|
|
import qualified SourceSyntax.Type as Type
|
|
import qualified Parse.Parse as Parse
|
|
import qualified Metadata.Prelude as Prelude
|
|
import qualified Transform.Check as Check
|
|
import qualified Transform.SortDefinitions as SD
|
|
import qualified Type.Inference as TI
|
|
import qualified Type.Constrain.Declaration as TcDecl
|
|
import qualified Transform.Canonicalize as Canonical
|
|
|
|
build :: Bool -> Interfaces -> String -> Either [Doc] MetadataModule
|
|
build noPrelude interfaces source =
|
|
do let add = Prelude.add noPrelude
|
|
infixes = Map.fromList . map (\(assoc,lvl,op) -> (op,(lvl,assoc)))
|
|
. concatMap iFixities $ Map.elems interfaces
|
|
|
|
Module names exs ims decls <- do
|
|
modul@(Module _ _ _ decls) <- add `fmap` Parse.program infixes source
|
|
case Check.mistakes decls of
|
|
[] -> return modul
|
|
ms -> Left ms
|
|
|
|
let exports'
|
|
| null exs =
|
|
let get = Pattern.boundVarList in
|
|
concat [ get pattern | Definition (Expr.Definition pattern _ _) <- decls ] ++
|
|
concat [ map fst ctors | Datatype _ _ ctors <- decls ] ++
|
|
[ name | TypeAlias name _ (Type.Record _ _) <- decls ]
|
|
| otherwise = exs
|
|
|
|
metaModule <- Canonical.metadataModule interfaces $
|
|
MetadataModule
|
|
{ names = names
|
|
, path = FP.joinPath names
|
|
, exports = exports'
|
|
, imports = ims
|
|
-- reorder AST into strongly connected components
|
|
, program = SD.sortDefs . Expr.dummyLet $ TcDecl.toExpr decls
|
|
, types = Map.empty
|
|
, datatypes = [ (name,vars,ctors) | Datatype name vars ctors <- decls ]
|
|
, fixities = [ (assoc,level,op) | Fixity assoc level op <- decls ]
|
|
, aliases = [ (name,tvs,tipe) | TypeAlias name tvs tipe <- decls ]
|
|
, ports = [ portName port | Port port <- decls ]
|
|
}
|
|
|
|
types <- TI.infer interfaces metaModule
|
|
|
|
return $ metaModule { types = types }
|