Initial commit

.editorconfig

+root = true
+
+[*]
+charset = utf-8
+indent_size = 4
+indent_style = space

.gitattributes

+* text=auto

.gitignore

+*.save*
+*~
+.vs
+dist/

LICENSE

+Copyright (c) 2018 Klaus Hartke
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

Setup.hs

+import Distribution.Simple
+main = defaultMain

mango-compiler.cabal

+name:                mango-compiler
+version:             0.1.0.0
+author:              Klaus Hartke
+license:             MIT
+license-file:        LICENSE
+build-type:          Simple
+cabal-version:       >=1.10
+
+executable mango
+  main-is:             Main.hs
+  other-modules:       Mango.Compiler.Binder, Mango.Compiler.CodeGen, Mango.Compiler.Emitter, Mango.Compiler.Error, Mango.Compiler.Lexer, Mango.Compiler.Parser, Mango.Compiler.Symbols, Mango.Compiler.Syntax, Mango.Compiler.Verifier
+  other-extensions:    NoImplicitPrelude, FlexibleInstances, TypeFamilies, OverloadedStrings, BangPatterns, ScopedTypeVariables
+  build-depends:       base >=4.10 && <4.11, mtl >=2.2 && <2.3, vector >=0.12 && <0.13, bytestring >=0.10 && <0.11, megaparsec >=6.3 && <6.4, containers >=0.5 && <0.6, parser-combinators >=0.2 && <0.3, text >=1.2 && <1.3, transformers >=0.5 && <0.6, parallel >=3.2 && <3.3, cryptonite >=0.24 && <0.25, memory >=0.14 && <0.15, array >=0.5 && <0.6
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  ghc-options:         -Wall -Werror -O -threaded -rtsopts -with-rtsopts=-N

src/Main.hs

+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Main (
+    main
+    ) where
+
+import Control.Monad
+import Control.Monad.IO.Class
+import Data.Bool
+import Data.Either
+import Data.Function
+import Data.List
+import Data.Maybe
+import Data.String
+import Mango.Compiler.CodeGen
+import Mango.Compiler.Emitter
+import Mango.Compiler.Error
+import Mango.Compiler.Parser
+import Mango.Compiler.Syntax
+import Mango.Compiler.Verifier
+import System.Console.GetOpt
+import System.Environment (getArgs)
+import System.Exit (exitFailure, exitSuccess)
+import System.IO (IO, FilePath, putStr, putStrLn)
+
+data Options = Options { options_outputFile :: !(Maybe String), options_defaultOutputFile :: !String, options_asC :: !Bool, options_asDump :: !Bool, options_help :: !Bool }
+
+defaultOptions :: Options
+defaultOptions = Options Nothing "a.package" False False False
+
+optDescrs :: [OptDescr (Options -> Options)]
+optDescrs = [
+    Option ['o'] [      ] (ReqArg (\f o -> o { options_outputFile = Just f                                                     }) "<file>") "write output to <file>",
+    Option ['c'] [      ] (NoArg  (\  o -> o { options_defaultOutputFile = "a.inc", options_asC = True, options_asDump = False })         ) "emit modules as C code",
+    Option [   ] ["dump"] (NoArg  (\  o -> o { options_defaultOutputFile = "a.txt", options_asDump = True, options_asC = False })         ) "emit modules as text dump",
+    Option [   ] ["help"] (NoArg  (\  o -> o { options_help = True                                                             })         ) "display this help and exit"]
+
+compiler :: (Options, [FilePath]) -> CompilerT Diagnostic IO ()
+compiler (options, paths) = do
+    syntaxTrees <- parseFiles paths
+    verified <- verify (Compilation syntaxTrees)
+    package <- compile verified
+    let outputPath = fromMaybe (options_defaultOutputFile options) (options_outputFile options)
+    if options_asC options then
+        liftIO (emitPackageAsC outputPath package)
+    else if options_asDump options then
+        liftIO (dumpPackage outputPath package)
+    else
+        liftIO (emitPackage outputPath package)
+
+main :: IO ()
+main = do
+    args <- getArgs
+    case getOpt Permute optDescrs args of
+        (options, paths, []) -> do
+            let options' = foldl (flip id) defaultOptions options
+            if options_help options' then do
+                putStrLn (usageInfo header optDescrs)
+            else do
+                result <- runCompilerT (compiler (options', paths))
+                case result of
+                    Left diagnostics -> do
+                        mapM_ (putStr . ("\n" ++) . diagnosticPretty' 4) diagnostics
+                        exitFailure
+                    Right () -> do
+                        exitSuccess
+        (_, _, errors) -> do
+            putStr (concat errors)
+            putStrLn (usageInfo header optDescrs)
+    where
+        header = "Usage: mango [options] <inputs>"

src/Mango/Compiler/Binder.hs

+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Mango.Compiler.Binder (
+    -- Semantic Model
+    createSemanticModel,
+    -- Declared Symbols
+    declaredModule,
+    declaredType,
+    declaredField,
+    declaredFunction,
+    declaredParameter,
+    declaredLocal,
+    declaredLabel,
+    -- Instructions
+    bindModule,
+    bindType,
+    bindField,
+    bindFunction,
+    bindParameter,
+    bindLocal,
+    bindLabel,
+    ) where
+
+import Data.Bits
+import Data.Bool
+import Data.Either (Either (..))
+import Data.Eq
+import Data.Function
+import Data.Int (Int)
+import Data.List
+import Data.Maybe (Maybe (..), fromJust, maybe)
+import Data.Ord
+import Mango.Compiler.Error
+import Mango.Compiler.Symbols
+import Mango.Compiler.Syntax
+import Prelude (Num (..), Integer, fromIntegral, undefined)
+
+import qualified Data.Array as A
+import qualified Data.ByteString as B
+import qualified Data.Vector as V
+
+--------------------------------------------------------------------------------
+
+createSemanticModel :: Compilation -> SemanticModel
+createSemanticModel compilation =
+    semanticModel
+    where
+        semanticModel = SemanticModel modules moduleGraph
+        modules       = map (makeModuleSymbol semanticModel) $ zip [0..] $ concatMap (compilationUnitSyntax_modules . syntaxTree_root) (compilation_syntaxTrees compilation)
+        adjacencyList = [[moduleSymbol_index import_ | import_@ModuleSymbol {} <- moduleSymbol_imports module_] | module_ <- modules]
+        moduleGraph   = A.listArray (0, length adjacencyList - 1) adjacencyList
+
+makeModuleSymbol :: SemanticModel -> (Int, ModuleDeclarationSyntax) -> ModuleSymbol
+makeModuleSymbol semanticModel (index, moduleDeclaration) =
+    symbol
+    where
+        symbol        = ModuleSymbol semanticModel name index imports types functions entryPoint (syntaxLocation moduleDeclaration) []
+        name          = displayName (moduleDeclarationSyntax_name moduleDeclaration)
+        imports       = [bindModule         symbol importDirective     | importDirective <- moduleDeclarationSyntax_imports moduleDeclaration]
+        types         = [makeTypeSymbol     symbol typeDeclaration     | typeDeclaration@TypeDeclarationSyntax {} <- moduleDeclarationSyntax_members moduleDeclaration]
+        functions     = [makeFunctionSymbol symbol functionDeclaration | functionDeclaration@FunctionDeclarationSyntax {} <- moduleDeclarationSyntax_members moduleDeclaration]
+        entryPoint    = findEntryPoint symbol
+
+makeTypeSymbol :: ModuleSymbol -> ModuleMemberSyntax -> TypeSymbol
+makeTypeSymbol container typeDeclaration =
+    symbol
+    where
+        symbol        = StructuredTypeSymbol container name fields layout (syntaxLocation typeDeclaration) []
+        name          = displayName (typeDeclarationSyntax_name typeDeclaration)
+        ((alignment, size), fields) = case typeDeclarationSyntax_fields typeDeclaration of
+            [] -> ((1, 1), [])
+            fs -> mapAccumL (makeFieldSymbol symbol) (1, 0) fs
+        layout        = TypeLayout alignment ((size + (alignment - 1)) .&. (complement (alignment - 1)))
+
+makeFieldSymbol :: TypeSymbol -> (Int, Int) -> FieldDeclarationSyntax -> ((Int, Int), FieldSymbol)
+makeFieldSymbol container (alignment, offset) fieldDeclaration =
+    ((alignment', offset'), symbol)
+    where
+        symbol        = FieldSymbol container name fieldType fieldOffset (syntaxLocation fieldDeclaration) []
+        name          = displayName (fieldDeclarationSyntax_name fieldDeclaration)
+        fieldType     = resolveType (containingModule container) (fieldDeclarationSyntax_type fieldDeclaration)
+        fieldOffset   = (offset + (fieldAlignment - 1)) .&. (complement (fieldAlignment - 1))
+        alignment'    = max alignment fieldAlignment
+        offset'       = fieldOffset + fieldSize
+        TypeLayout fieldAlignment fieldSize = typeLayout fieldType
+
+makeFunctionSymbol :: ModuleSymbol -> ModuleMemberSyntax -> FunctionSymbol
+makeFunctionSymbol moduleSymbol functionDeclaration@FunctionDeclarationSyntax { functionDeclarationSyntax_body = Left functionBody } =
+    symbol
+    where
+        symbol        = FunctionSymbol moduleSymbol name returnType parameters locals labels Nothing (syntaxLocation functionDeclaration) []
+        name          = displayName (functionDeclarationSyntax_name functionDeclaration)
+        returnType    = resolveType moduleSymbol (functionDeclarationSyntax_returnType functionDeclaration)
+        parameters    = [makeParameterSymbol symbol parameterDeclaration | parameterDeclaration <- functionDeclarationSyntax_parameters functionDeclaration]
+        locals        = [makeLocalSymbol     symbol localDeclaration     | localDeclaration <- functionBodySyntax_locals functionBody]
+        labels        = concatMap (makeLabelSymbols symbol) (V.indexed (functionBodySyntax_instructions functionBody))
+makeFunctionSymbol moduleSymbol functionDeclaration@FunctionDeclarationSyntax { functionDeclarationSyntax_body = Right ordinal } =
+    symbol
+    where
+        symbol        = FunctionSymbol moduleSymbol name returnType parameters [] [] (Just (parseLiteral ordinal)) (syntaxLocation functionDeclaration) []
+        name          = displayName (functionDeclarationSyntax_name functionDeclaration)
+        returnType    = resolveType moduleSymbol (functionDeclarationSyntax_returnType functionDeclaration)
+        parameters    = [makeParameterSymbol symbol parameterDeclaration | parameterDeclaration <- functionDeclarationSyntax_parameters functionDeclaration]
+makeFunctionSymbol _ TypeDeclarationSyntax {} =
+    undefined
+
+makeParameterSymbol :: FunctionSymbol -> ParameterDeclarationSyntax -> ParameterSymbol
+makeParameterSymbol container parameterDeclaration =
+    symbol
+    where
+        symbol        = ParameterSymbol container name parameterType (syntaxLocation parameterDeclaration) []
+        name          = displayName (parameterDeclarationSyntax_name parameterDeclaration)
+        parameterType = resolveType (containingModule container) (parameterDeclarationSyntax_type parameterDeclaration)
+
+makeLocalSymbol :: FunctionSymbol -> LocalDeclarationSyntax -> LocalSymbol
+makeLocalSymbol container localDeclaration =
+    symbol
+    where
+        symbol        = LocalSymbol container name localType (syntaxLocation localDeclaration) []
+        name          = displayName (localDeclarationSyntax_name localDeclaration)
+        localType     = resolveType (containingModule container) (localDeclarationSyntax_type localDeclaration)
+
+makeLabelSymbols :: FunctionSymbol -> (Int, InstructionSyntax) -> [LabelSymbol]
+makeLabelSymbols container (index, instruction@LabeledInstructionSyntax {}) =
+    symbol:symbols
+    where
+        symbol        = LabelSymbol container name index (syntaxLocation instruction) []
+        name          = displayName (labeledInstructionSyntax_label instruction)
+        symbols       = makeLabelSymbols container (index, labeledInstructionSyntax_instruction instruction)
+makeLabelSymbols _ _ =
+    []
+
+--------------------------------------------------------------------------------
+
+declaredModule :: SemanticModel -> ModuleDeclarationSyntax -> ModuleSymbol
+declaredModule SemanticModel { semanticModel_modules = modules } moduleDeclaration =
+    fromJust (find match modules)
+    where
+        match symbol = syntaxLocation moduleDeclaration == symbolLocation symbol
+
+declaredType :: ModuleSymbol -> ModuleMemberSyntax -> TypeSymbol
+declaredType ModuleSymbol { moduleSymbol_types = types } typeDeclaration@TypeDeclarationSyntax {} =
+    fromJust (find match types)
+    where
+        match symbol = syntaxLocation typeDeclaration == symbolLocation symbol
+declaredType _ _ =
+    undefined
+
+declaredField :: TypeSymbol -> FieldDeclarationSyntax -> FieldSymbol
+declaredField StructuredTypeSymbol { structuredTypeSymbol_fields = fields } fieldDeclaration =
+    fromJust (find match fields)
+    where
+        match symbol = syntaxLocation fieldDeclaration == symbolLocation symbol
+declaredField  _ _ =
+    undefined
+
+declaredFunction :: ModuleSymbol -> ModuleMemberSyntax -> FunctionSymbol
+declaredFunction ModuleSymbol { moduleSymbol_functions = functions } functionDeclaration@FunctionDeclarationSyntax {} =
+    fromJust (find match functions)
+    where
+        match symbol = syntaxLocation functionDeclaration == symbolLocation symbol
+declaredFunction _ _ =
+    undefined
+
+declaredParameter :: FunctionSymbol -> ParameterDeclarationSyntax -> ParameterSymbol
+declaredParameter FunctionSymbol { functionSymbol_parameters = parameters } parameterDeclaration =
+    fromJust (find match parameters)
+    where
+        match symbol = syntaxLocation parameterDeclaration == symbolLocation symbol
+declaredParameter _ _ =
+    undefined
+
+declaredLocal :: FunctionSymbol -> LocalDeclarationSyntax -> LocalSymbol
+declaredLocal FunctionSymbol { functionSymbol_locals = locals } localDeclarationSyntax =
+    fromJust (find match locals)
+    where
+        match symbol = syntaxLocation localDeclarationSyntax == symbolLocation symbol
+declaredLocal _ _ =
+    undefined
+
+declaredLabel :: FunctionSymbol -> InstructionSyntax -> LabelSymbol
+declaredLabel FunctionSymbol { functionSymbol_labels = labels } labeledInstruction@LabeledInstructionSyntax {} =
+    fromJust (find match labels)
+    where
+        match symbol = syntaxLocation labeledInstruction == symbolLocation symbol
+declaredLabel _ _ =
+    undefined
+
+--------------------------------------------------------------------------------
+
+bindModule :: (Symbol a) => a -> ImportDirectiveSyntax -> ModuleSymbol
+bindModule context importDirective =
+    findModule (containingModel context) (importDirectiveSyntax_name importDirective)
+
+bindType :: (Symbol a) => a -> InstructionSyntax -> TypeSymbol
+bindType context instruction =
+    resolveType context (typedInstructionSyntax_type instruction)
+
+bindField :: (Symbol a) => a -> InstructionSyntax -> FieldSymbol
+bindField context instruction = do
+    findField containingType_ (fieldInstructionSyntax_fieldName instruction) fieldType
+    where
+        containingModule_   = case fieldInstructionSyntax_moduleName instruction of
+            Nothing         -> containingModule context
+            Just moduleName -> findModule (containingModel context) moduleName
+        containingType_     = findType containingModule_ (fieldInstructionSyntax_typeName instruction)
+        fieldType           = resolveType context (fieldInstructionSyntax_fieldType instruction)
+
+bindFunction :: (Symbol a) => a -> InstructionSyntax -> FunctionSymbol
+bindFunction context instruction =
+    findFunction containingModule_ (functionInstructionSyntax_functionName instruction) returnType parameterTypes
+    where
+        containingModule_   = case functionInstructionSyntax_moduleName instruction of
+            Nothing         -> containingModule context
+            Just moduleName -> findModule (containingModel context) moduleName
+        returnType          = resolveType context (functionInstructionSyntax_returnType instruction)
+        parameterTypes      = map (resolveType context) (functionInstructionSyntax_parameterTypes instruction)
+
+bindParameter :: (Symbol a) => a -> InstructionSyntax -> ParameterSymbol
+bindParameter context instruction =
+    findParameter (containingFunction context) (argumentInstructionSyntax_parameterName instruction)
+
+bindLocal :: (Symbol a) => a -> InstructionSyntax -> LocalSymbol
+bindLocal context instruction =
+    findLocal (containingFunction context) (localInstructionSyntax_localName instruction)
+
+bindLabel :: (Symbol a) => a -> InstructionSyntax -> LabelSymbol
+bindLabel context instruction =
+    findLabel (containingFunction context) (branchInstructionSyntax_target instruction)
+
+--------------------------------------------------------------------------------
+
+resolveType :: (Symbol a) => a -> TypeSyntax -> TypeSymbol
+resolveType context =
+    go
+    where
+        go (BoolTypeSyntax _)                              = BoolTypeSymbol
+        go (Int8TypeSyntax _)                              = Int8TypeSymbol
+        go (Int16TypeSyntax _)                             = Int16TypeSymbol
+        go (Int32TypeSyntax _)                             = Int32TypeSymbol
+        go (Int64TypeSyntax _)                             = Int64TypeSymbol
+        go (UInt8TypeSyntax _)                             = UInt8TypeSymbol
+        go (UInt16TypeSyntax _)                            = UInt16TypeSymbol
+        go (UInt32TypeSyntax _)                            = UInt32TypeSymbol
+        go (UInt64TypeSyntax _)                            = UInt64TypeSymbol
+        go (Float32TypeSyntax _)                           = Float32TypeSymbol
+        go (Float64TypeSyntax _)                           = Float64TypeSymbol
+        go (VoidTypeSyntax _)                              = VoidTypeSymbol
+        go (ArrayTypeSyntax elementType length_)           = ArrayTypeSymbol (go elementType) (parseLiteral length_)
+        go (DeclaredTypeSyntax Nothing typeName)           = findType (containingModule context) typeName
+        go (DeclaredTypeSyntax (Just moduleName) typeName) = findType (findModule (containingModel context) moduleName) typeName
+        go (FunctionTypeSyntax returnType parameterTypes)  = FunctionTypeSymbol (go returnType) (map go parameterTypes)
+        go (ReferenceTypeSyntax referencedType)            = ReferenceTypeSymbol (go referencedType)
+        go (SpanTypeSyntax elementType)                    = SpanTypeSymbol (go elementType)
+
+parseLiteral :: LiteralSyntax -> Integer
+parseLiteral NumericLiteralSyntax { numericLiteralSyntax_minus = minus, numericLiteralSyntax_token = token } =
+    maybe id (const negate) minus $ B.foldl' (\a w -> a * 10 + fromIntegral (w - 48)) 0 (syntaxToken_value token)
+
+--------------------------------------------------------------------------------
+
+findModule :: SemanticModel -> ModuleNameSyntax -> ModuleSymbol
+findModule semanticModel moduleName =
+    case filter match (semanticModel_modules semanticModel) of
+        [symbol] -> symbol
+        symbols  -> ErrorModuleSymbol semanticModel (displayName moduleName) [] [] [] Nothing (syntaxLocation moduleName) [bindError moduleName symbols]
+    where
+        match ModuleSymbol { moduleSymbol_name = moduleName' } = moduleName' == displayName moduleName
+        match _ = False
+
+findType :: ModuleSymbol -> SimpleNameSyntax -> TypeSymbol
+findType container typeName =
+    case filter match (moduleSymbol_types container) of
+        [symbol] -> symbol
+        symbols  -> ErrorTypeSymbol container (displayName typeName) [] (TypeLayout 1 0) (syntaxLocation typeName) [bindError typeName symbols]
+    where
+        match StructuredTypeSymbol { structuredTypeSymbol_name = typeName' } = typeName' == displayName typeName
+        match _ = False
+
+findField :: TypeSymbol -> SimpleNameSyntax -> TypeSymbol -> FieldSymbol
+findField container fieldName fieldType =
+    case filter match (structuredTypeSymbol_fields container) of
+        [symbol] -> symbol
+        symbols  -> ErrorFieldSymbol container (displayName fieldName) fieldType 0 (syntaxLocation fieldName) [bindError fieldName symbols]
+    where
+        match FieldSymbol { fieldSymbol_name = fieldName' } = fieldName' == displayName fieldName
+        match _ = False
+
+findFunction :: ModuleSymbol -> SimpleNameSyntax -> TypeSymbol -> [TypeSymbol] -> FunctionSymbol
+findFunction container functionName returnType parameterTypes =
+    case filter match (moduleSymbol_functions container) of
+        [symbol] -> symbol
+        symbols  -> let symbol = ErrorFunctionSymbol container (displayName functionName) returnType (map (\t -> ParameterSymbol symbol "?" t (syntaxLocation functionName) []) parameterTypes) [] [] Nothing (syntaxLocation functionName) [bindError functionName symbols] in symbol
+    where
+        match FunctionSymbol { functionSymbol_name = functionName', functionSymbol_returnType = returnType', functionSymbol_parameters = parameters' } = functionName' == displayName functionName && returnType' == returnType && map parameterSymbol_parameterType parameters' == parameterTypes
+        match _ = False
+
+findParameter :: FunctionSymbol -> SimpleNameSyntax -> ParameterSymbol
+findParameter container parameterName =
+    case filter match (functionSymbol_parameters container) of
+        [symbol] -> symbol
+        symbols  -> ErrorParameterSymbol container (displayName parameterName) (syntaxLocation parameterName) [bindError parameterName symbols]
+    where
+        match ParameterSymbol { parameterSymbol_name = parameterName' } = parameterName' == displayName parameterName
+        match _ = False
+
+findLocal :: FunctionSymbol -> SimpleNameSyntax -> LocalSymbol
+findLocal container localName =
+    case filter match (functionSymbol_locals container) of
+        [symbol] -> symbol
+        symbols  -> ErrorLocalSymbol container (displayName localName) (syntaxLocation localName) [bindError localName symbols]
+    where
+        match LocalSymbol { localSymbol_name = localName' } = localName' == displayName localName
+        match _ = False
+
+findLabel :: FunctionSymbol -> SimpleNameSyntax -> LabelSymbol
+findLabel container labelName =
+    case filter match (functionSymbol_labels container) of
+        [symbol] -> symbol
+        symbols  -> ErrorLabelSymbol container (displayName labelName) (syntaxLocation labelName) [bindError labelName symbols]
+    where
+        match LabelSymbol { labelSymbol_name = labelName' } = labelName' == displayName labelName
+        match _ = False
+
+findEntryPoint :: ModuleSymbol -> Maybe FunctionSymbol
+findEntryPoint container =
+    case filter match (moduleSymbol_functions container) of
+        [symbol] -> Just symbol
+        _        -> Nothing
+    where
+        match FunctionSymbol { functionSymbol_name = "@main", functionSymbol_returnType = VoidTypeSymbol, functionSymbol_parameters = [] } = True
+        match _ = False
+
+bindError :: (SyntaxNode n, NameSyntax n, Symbol a) => n -> [a] -> Diagnostic
+bindError name candidates = BindError (syntaxLocation name) (displayName name) (map symbolPretty candidates)
+
+--------------------------------------------------------------------------------

src/Mango/Compiler/Error.hs

+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Mango.Compiler.Error (
+    -- Error Reporting
+    CompilerT,
+    compilerT,
+    runCompilerT,
+    mapCompilerT,
+    sequentialC,
+    parallelC,
+    report,
+    reportMany,
+    stop,
+    stopOnError,
+    mapAccumM,
+    -- Diagnostics
+    Diagnostic (..),
+    diagnosticPretty,
+    diagnosticPretty',
+    ) where
+
+import Control.Monad
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
+import Control.Monad.Trans.State (StateT (..), runStateT, get, put)
+import Control.Monad.Trans.Writer.Strict (WriterT (..), runWriterT)
+import Control.Parallel.Strategies (parMap, rseq)
+import Data.Bool
+import Data.ByteString (ByteString)
+import Data.Either (Either (..), partitionEithers)
+import Data.Eq
+import Data.Function
+import Data.Functor.Identity
+import Data.Int (Int)
+import Data.List
+import Data.Maybe (Maybe (..), maybe)
+import Data.Ord
+import Data.Semigroup
+import Data.String (String)
+import Data.Tuple
+import Mango.Compiler.Syntax
+import Prelude (Num (..), mod)
+import Text.Megaparsec.Error (ErrorItem, showErrorComponent)
+import Text.Megaparsec.Pos (unPos)
+import Text.Show
+
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as C
+import qualified Data.Set as E
+
+--------------------------------------------------------------------------------
+
+type CompilerT e m = MaybeT (WriterT [e] m)
+
+compilerT :: (Monad m) => m (Either [e] a) -> CompilerT e m a
+compilerT = MaybeT . WriterT . fmap go
+    where
+        go (Right x) = (Just x,  [])
+        go (Left es) = (Nothing, es)
+
+runCompilerT :: (Monad m) => CompilerT e m a -> m (Either [e] a)
+runCompilerT = fmap go . runWriterT . runMaybeT
+    where
+        go (Just x, []) = Right x
+        go (_,      es) = Left es
+
+mapCompilerT :: (Monad m, Monad n) => (m (Either [e] a) -> n (Either [e'] b)) -> CompilerT e m a -> CompilerT e' n b
+mapCompilerT f = compilerT . f . runCompilerT
+
+sequentialC :: (Monad m) => [CompilerT e m a] -> CompilerT e m [a]
+sequentialC = MaybeT . fmap sequence . mapM runMaybeT
+
+parallelC :: (Monad m) => [CompilerT e Identity a] -> CompilerT e m [a]
+parallelC = compilerT . return . eitherPartitions . partitionEithers . parMap rseq (runIdentity . runCompilerT)
+    where
+        eitherPartitions :: ([[a]], b) -> Either [a] b
+        eitherPartitions ([], x) = Right x
+        eitherPartitions (es, _) = Left (concat es)
+
+report :: (Monad m) => e -> CompilerT e m ()
+report = reportMany . (:[])
+
+reportMany :: (Monad m) => [e] -> CompilerT e m ()
+reportMany = MaybeT . WriterT . return . (,) (Just ())
+
+stop :: (Monad m) => CompilerT e m a
+stop = (MaybeT . WriterT . return . (,) Nothing) []
+
+stopOnError :: (Monad m) => CompilerT e m a -> CompilerT e m a
+stopOnError = mapCompilerT id
+
+mapAccumM :: (Monad m) => (a -> b -> m (a, c)) -> a -> [b] -> m (a, [c])
+mapAccumM f a l = fmap swap (runStateT (mapM go l) a)
+    where
+        go i = do
+            s <- get
+            (s', r) <- lift (f s i)
+            put s'
+            return r
+
+--------------------------------------------------------------------------------
+
+data Diagnostic
+    = GenericError { diagnostic_location :: !Location, genericError_message :: String }
+    | SyntaxError  { diagnostic_location :: !Location, syntaxError_unexpected :: Maybe (ErrorItem SyntaxToken), syntaxError_expecting :: E.Set (ErrorItem SyntaxToken) }
+    | BindError    { diagnostic_location :: !Location, bindError_name :: String, bindError_candidates :: [String] }
+
+diagnosticPretty :: Diagnostic -> String
+diagnosticPretty diagnostic =
+    show (diagnostic_location diagnostic) <> ":\n" <>
+    errorMessage diagnostic
+
+diagnosticPretty' :: Int -> Diagnostic -> String
+diagnosticPretty' tabWidth diagnostic =
+    show (diagnostic_location diagnostic) <> ":\n" <>
+    linePretty tabWidth (location_sourceText (diagnostic_location diagnostic)) (location_sourcePos (diagnostic_location diagnostic)) <>
+    errorMessage diagnostic
+
+errorMessage :: Diagnostic -> String
+errorMessage GenericError { genericError_message = message } =
+    message ++ "\n"
+errorMessage SyntaxError { syntaxError_unexpected = unexpected, syntaxError_expecting = expecting } =
+    errorItemsPretty "unexpected " (maybe E.empty E.singleton unexpected) ++
+    errorItemsPretty "expecting " expecting
+errorMessage BindError { bindError_name = name, bindError_candidates = [] } =
+    "\"" ++ name ++ "\" is not declared\n"
+errorMessage BindError { bindError_name = name, bindError_candidates = candidates } = 
+    "\"" ++ name ++ "\" is ambiguous between the following declarations:" ++ concatMap ("\n    " ++) candidates ++ "\n"
+
+errorItemsPretty :: String -> E.Set (ErrorItem SyntaxToken) -> String
+errorItemsPretty prefix ts
+    | E.null ts = ""
+    | otherwise = prefix <> orList (E.toAscList (E.map showErrorComponent ts)) <> "\n"
+
+orList :: [String] -> String
+orList []     = ""
+orList [x]    = x
+orList [x, y] = x <> " or " <> y
+orList xs     = intercalate ", " (init xs) <> ", or " <> last xs
+
+linePretty :: Int -> ByteString -> SourcePos -> String
+linePretty w s p =
+    padding    <> " |\n" <>
+    lineNumber <> " | " <> rline <> "\n" <>
+    padding    <> " | " <> rpadding <> "^\n"
+    where
+        line       = C.unpack (selectLine (unPos (sourceLine p) - 1) s)
+        lineNumber = show (unPos (sourceLine p))
+        padding    = replicate (length lineNumber) ' '
+        rline      = expandTab w line
+        rpadding   = expandPad w (take (unPos (sourceColumn p) - 1) line)
+
+selectLine :: Int -> ByteString -> ByteString
+selectLine l = go 0
+    where
+        go !n !s
+            | n == l                                                   = s1
+            | B.null s2                                                = B.empty
+            | B.head s2 == 13 && B.length s2 > 1 && B.index s2 1 == 10 = go (n + 1) (B.drop 2 s2)
+            | otherwise                                                = go (n + 1) (B.tail s2)
+            where
+                (s1, s2) = B.break (\x -> x == 13 || x == 10) s
+
+expandTab :: Int -> String -> String
+expandTab w = go 0
+    where
+        go  _ []        = []
+        go !n ('\t':xs) = replicate (w - mod n w) ' ' <> go 0 xs
+        go !n (   x:xs) = (if x < ' ' then ' ' else x):go (n + 1) xs
+
+expandPad :: Int -> String -> String
+expandPad w = go 0
+    where
+        go  _ []        = []
+        go !n ('\t':xs) = replicate (w - mod n w) ' ' <> go 0 xs
+        go !n (   _:xs) = ' ':go (n + 1) xs
+
+--------------------------------------------------------------------------------

src/Mango/Compiler/Lexer.hs

+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Mango.Compiler.Lexer (
+    tokenizeText,
+    tokenizeBytes,
+    tokenizeFile,
+    tokenizeFiles,
+    ) where
+
+import Control.Applicative (Applicative (..))
+import Control.Monad (Monad (..), ap, mapM)
+import Data.Bool
+import Data.ByteString
+import Data.Eq
+import Data.Function
+import Data.Functor
+import Data.Int (Int)
+import Data.Maybe (Maybe (..))
+import Data.Ord
+import Data.Semigroup
+import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
+import Data.Word (Word8)
+import Mango.Compiler.Syntax
+import Prelude (Num (..))
+import System.IO (IO, FilePath)
+import Text.Megaparsec.Pos
+
+import qualified Data.Set as E
+
+--------------------------------------------------------------------------------
+
+newtype Lexer a
+    = Lexer { runLexer :: (ByteString, SourcePos, ByteString) -> (a, ByteString, SourcePos, ByteString) }
+
+instance Functor Lexer where
+    fmap f x = x >>= (pure . f)
+
+instance Applicative Lexer where
+    pure = return
+    (<*>) = ap
+
+instance Monad Lexer where
+    return a = Lexer (\(b, p, t) -> (a, b, p, t))
+    m >>= k  = Lexer (\s -> let (a, b', p', t') = runLexer m s in runLexer (k a) (b', p', t'))
+
+at :: Lexer Location
+at = Lexer (\(b, p, t) -> (Location p t, b, p, t))
+
+eol :: Lexer ()
+eol = Lexer (\(b, p, t) -> ((), b, p { sourceLine = sourceLine p <> pos1, sourceColumn = pos1 }, t))
+
+eat :: (ByteString -> (a, ByteString)) -> Lexer a
+eat f = Lexer (\(b, p, t) -> let (x, b') = f b in (x, b', p { sourceColumn = mkPos (unPos (sourceColumn p) + (length b - length b')) }, t))
+
+set :: (ByteString -> ByteString) -> Lexer ()
+set f = eat (\b -> ((), f b))
+
+get :: (ByteString -> a) -> Lexer a
+get f = Lexer (\(b, p, t) -> (f b, b, p, t))
+
+peek :: Int -> Lexer (Maybe Word8)
+peek i = get (\b -> if i < length b then Just (index b i) else Nothing)
+
+run :: Lexer a -> Lexer (a, ByteString)
+run m = Lexer (\(b, p, t) -> let (x, b', p', t') = runLexer m (b, p, t) in ((x, take (length b - length b') b), b', p', t'))
+
+--------------------------------------------------------------------------------
+
+keywords :: E.Set ByteString
+keywords = E.fromList [
+    "bool", "i8", "u8", "i16", "u16", "i32", "u32", "i64", "u64", "f32" , "f64", "void",
+    "module", "import", "type", "field", "declare", "define", "local",
+    "nop", "break", "pop", "dup",
+    "newobj", "newarr", "ldlen",
+    "call", "calli", "syscall", "ret",
+    "br", "brfalse", "brtrue", "beq", "bge", "bgt", "ble", "blt", "bne",
+    "ldc", "ldftn", "ldnull",
+    "ldarg", "ldarga", "starg",
+    "ldloc", "ldloca", "stloc",
+    "ldind", "stind",
+    "ldfld", "ldflda", "stfld",
+    "ldelem", "ldelema", "stelem",
+    "add", "div", "mul", "rem", "sub", "neg",
+    "and", "or", "xor", "shl", "shr", "not",
+    "ceq", "cge", "cgt", "cle", "clt", "cne",
+    "conv",
+    "_", "$", "%", "@", "null", "true", "false"]
+
+--------------------------------------------------------------------------------
+
+scanMultiLineComment :: Lexer Bool
+scanMultiLineComment =
+    set (drop 2) >> go
+    where
+        go = do
+            set (dropWhile (\x -> not (x == 42 || x == 13 || x == 10)))
+            eof <- get null
+            if eof then
+                return False
+            else do
+                next <- get head
+                case next of
+                    42 -> do
+                        next' <- peek 1
+                        case next' of
+                            Just 47 -> set (drop 2) >> return True
+                            _       -> set (drop 1) >> go
+                    13 -> do
+                        next' <- peek 1
+                        case next' of
+                            Just 10 -> set (drop 2)
+                            _       -> set (drop 1)
+                        eol
+                        go
+                    10 -> do
+                        set (drop 1)
+                        eol
+                        go
+                    _ -> do
+                        set (drop 1)
+                        go
+
+scanTrivia :: Bool -> Lexer [SyntaxTrivia]
+scanTrivia isTrailing = do
+    eof <- get null
+    if eof then
+        return []
+    else do
+        next <- get head
+        case next of
+            32 -> do
+                value <- eat (span isWhiteSpace)
+                rest <- scanTrivia isTrailing
+                return (WhitespaceTrivia value:rest)
+            13 -> do
+                next' <- peek 1
+                value <- case next' of
+                    Just 10 -> eat (splitAt 2)
+                    _       -> eat (splitAt 1)
+                eol
+                rest <- if isTrailing then pure [] else scanTrivia isTrailing
+                return (EndOfLineTrivia value:rest)
+            10 -> do
+                value <- eat (splitAt 1)
+                eol
+                rest <- if isTrailing then pure [] else scanTrivia isTrailing
+                return (EndOfLineTrivia value:rest)
+            47 -> do
+                next' <- peek 1
+                case next' of
+                    Just 47 -> do
+                        value <- eat (break (\x -> x == 13 || x == 10))
+                        rest <- scanTrivia isTrailing
+                        return (SingleLineCommentTrivia value:rest)
+                    Just 42 -> do
+                        (success, value) <- run scanMultiLineComment
+                        rest <- scanTrivia isTrailing
+                        if success then
+                            return (MultiLineCommentTrivia value:rest)
+                        else
+                            return (ErrorTrivia value:rest)
+                    _ -> return []
+            x | isWhiteSpace x -> do
+                value <- eat (span isWhiteSpace)
+                rest <- scanTrivia isTrailing
+                return (WhitespaceTrivia value:rest)
+              | otherwise -> do
+                return []
+    where
+        isWhiteSpace x = (x == 32) || (x == 9) || (x == 11) || (x == 12)
+
+scanIdentifierOrKeyword :: [SyntaxTrivia] -> Lexer SyntaxToken
+scanIdentifierOrKeyword leadingTrivia = do
+    pos <- at
+    end <- get (\s -> 1 + length (takeWhile isIdContinue (tail s)))
+    identifier <- get (take end)
+    if E.member identifier keywords then do
+        next <- peek end
+        end' <- case next of
+            Just 46 -> get (\s -> end + length (takeWhile isIdContinue' (drop end s)))
+            _       -> return end
+        keyword <- eat (splitAt end')
+        trailingTrivia <- scanTrivia True
+        return (KeywordToken leadingTrivia keyword trailingTrivia pos)
+    else do
+        set (drop end)
+        trailingTrivia <- scanTrivia True
+        return (IdentifierToken leadingTrivia identifier trailingTrivia pos)
+    where
+        isIdContinue  x = (x >= 65) && (x <= 90) || (x >= 97) && (x <= 122) || (x >= 48) && (x <= 57) || (x == 95)
+        isIdContinue' x = (isIdContinue x) || (x == 46)
+
+scanNumericLiteral :: [SyntaxTrivia] -> Lexer SyntaxToken
+scanNumericLiteral leadingTrivia = do
+    pos <- at
+    literal <- eat (span isDigit)
+    trailingTrivia <- scanTrivia True
+    return (NumericLiteralToken leadingTrivia literal trailingTrivia pos)
+    where
+        isDigit x = (x >= 48) && (x <= 57)
+
+scanPunctuator :: [SyntaxTrivia] -> Lexer SyntaxToken
+scanPunctuator leadingTrivia = do
+    pos <- at
+    punctuator <- eat (splitAt 1)
+    trailingTrivia <- scanTrivia True
+    return (PunctuatorToken leadingTrivia punctuator trailingTrivia pos)
+
+scanBad :: [SyntaxTrivia] -> Lexer SyntaxToken
+scanBad leadingTrivia = do
+    pos <- at
+    character <- eat (splitAt 1)
+    trailingTrivia <- scanTrivia True
+    return (BadToken leadingTrivia character trailingTrivia pos)
+
+scanToken :: Lexer SyntaxToken
+scanToken = do
+    leadingTrivia <- scanTrivia False
+    eof <- get null
+    if eof then do
+        pos <- at
+        return (EndOfFileToken leadingTrivia empty [] pos)
+    else do
+        next <- get head
+        case next of
+            33              -> scanPunctuator          leadingTrivia
+            35              -> scanPunctuator          leadingTrivia
+            38              -> scanPunctuator          leadingTrivia
+            40              -> scanPunctuator          leadingTrivia
+            41              -> scanPunctuator          leadingTrivia
+            42              -> scanPunctuator          leadingTrivia
+            43              -> scanPunctuator          leadingTrivia
+            44              -> scanPunctuator          leadingTrivia
+            45              -> scanPunctuator          leadingTrivia
+            46              -> scanPunctuator          leadingTrivia
+            47              -> scanPunctuator          leadingTrivia
+            58              -> scanPunctuator          leadingTrivia
+            59              -> scanPunctuator          leadingTrivia
+            60              -> scanPunctuator          leadingTrivia
+            61              -> scanPunctuator          leadingTrivia
+            62              -> scanPunctuator          leadingTrivia
+            63              -> scanPunctuator          leadingTrivia
+            91              -> scanPunctuator          leadingTrivia
+            92              -> scanPunctuator          leadingTrivia
+            93              -> scanPunctuator          leadingTrivia
+            94              -> scanPunctuator          leadingTrivia
+            96              -> scanPunctuator          leadingTrivia
+            123             -> scanPunctuator          leadingTrivia
+            124             -> scanPunctuator          leadingTrivia
+            125             -> scanPunctuator          leadingTrivia
+            126             -> scanPunctuator          leadingTrivia
+            x | isIdStart x -> scanIdentifierOrKeyword leadingTrivia
+              | isDigit x   -> scanNumericLiteral      leadingTrivia
+              | otherwise   -> scanBad                 leadingTrivia
+    where
+        isIdStart x = (x >= 65) && (x <= 90) || (x >= 97) && (x <= 122) || (x == 95) || (x == 36) || (x == 37) || (x == 64)
+        isDigit x = (x >= 48) && (x <= 57)
+
+scanTokens :: Lexer [SyntaxToken]
+scanTokens = do
+    token <- scanToken
+    case token of
+        EndOfFileToken {} -> do
+            return [token]
+        _ -> do
+            tokens <- scanTokens
+            return (token:tokens)
+
+--------------------------------------------------------------------------------
+
+tokenizeText :: FilePath -> Text -> [SyntaxToken]
+tokenizeText path text =
+    tokenizeBytes path (encodeUtf8 text)
+
+tokenizeBytes :: FilePath -> ByteString -> [SyntaxToken]
+tokenizeBytes path text =
+    tokens
+    where
+        (tokens, _, _, _) = runLexer scanTokens (text, initialPos path, text)
+
+tokenizeFile :: FilePath -> IO [SyntaxToken]
+tokenizeFile path =
+    tokenizeBytes path <$> readFile path
+
+tokenizeFiles :: [FilePath] -> IO [[SyntaxToken]]
+tokenizeFiles paths =
+    mapM tokenizeFile paths
+
+--------------------------------------------------------------------------------

src/Mango/Compiler/Parser.hs

+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Mango.Compiler.Parser (
+    parseText,
+    parseBytes,
+    parseFile,
+    parseFiles,
+    ) where
+
+import Control.Applicative
+import Control.Applicative.Combinators
+import Control.Monad
+import Control.Monad.IO.Class
+import Data.ByteString (ByteString, readFile)
+import Data.Char (Char)
+import Data.Either (Either (..))
+import Data.Eq
+import Data.Function
+import Data.Functor.Identity
+import Data.List.NonEmpty (NonEmpty (..))
+import Data.Maybe (Maybe (..))
+import Data.String (String)
+import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
+import Data.Void (Void)
+import Mango.Compiler.Error
+import Mango.Compiler.Lexer
+import Mango.Compiler.Syntax
+import System.IO (FilePath)
+import Text.Megaparsec (ParsecT, MonadParsec (token), (<?>), runParser)
+import Text.Megaparsec.Error (ErrorItem (..), ErrorFancy (..), ParseError (..))
+import Text.Show
+
+import qualified Data.ByteString.Char8 as C
+import qualified Data.List as L
+import qualified Data.Set as E
+import qualified Data.Vector as V
+
+--------------------------------------------------------------------------------
+
+type Parser = ParsecT Void [SyntaxToken] Identity
+
+--------------------------------------------------------------------------------
+
+identifierToken :: Parser SyntaxToken
+identifierToken = token test Nothing <?> "identifier"
+    where
+        test x@IdentifierToken {} = Right x
+        test x = Left (pure (Tokens (x:|[])), E.empty)
+
+numericLiteralToken :: Parser SyntaxToken
+numericLiteralToken = token test Nothing <?> "numeric literal"
+    where
+        test x@NumericLiteralToken {} = Right x
+        test x = Left (pure (Tokens (x:|[])), E.empty)
+
+keywordToken :: String -> Parser SyntaxToken
+keywordToken k = token test Nothing <?> show k
+    where
+        test x@KeywordToken { syntaxToken_value = value } | C.pack k == value = Right x
+        test x = Left (pure (Tokens (x:|[])), E.empty)
+
+punctuatorToken :: Char -> Parser SyntaxToken
+punctuatorToken p = token test Nothing <?> show p
+    where
+        test x@PunctuatorToken { syntaxToken_value = value } | C.singleton p == value = Right x
+        test x = Left (pure (Tokens (x:|[])), E.empty)
+
+endOfFileToken :: Parser SyntaxToken
+endOfFileToken = token test Nothing <?> "end of file"
+    where
+        test x@EndOfFileToken {} = Right x
+        test x = Left (pure (Tokens (x:|[])), E.empty)
+
+--------------------------------------------------------------------------------
+
+simpleNameSyntax :: Parser SimpleNameSyntax
+simpleNameSyntax = SimpleNameSyntax <$> identifierToken
+
+moduleNameSyntax :: Parser ModuleNameSyntax
+moduleNameSyntax = ModuleNameSyntax <$> sepBy1 identifierToken (punctuatorToken '.')
+
+--------------------------------------------------------------------------------
+
+literalSyntax :: Parser LiteralSyntax
+literalSyntax = NumericLiteralSyntax <$> optional (punctuatorToken '-') <*> numericLiteralToken
+
+--------------------------------------------------------------------------------
+
+typeSyntax :: Parser TypeSyntax
+typeSyntax = flip (L.foldl (flip (.)) id) <$> (predefinedTypeSyntax <|> declaredTypeSyntax) <*> many (referenceTypeSyntax <|> arrayOrSpanTypeSyntax <|> functionTypeSyntax)
+    where
+        predefinedTypeSyntax  = choice [
+            BoolTypeSyntax    <$> keywordToken "bool",
+            Int8TypeSyntax    <$> keywordToken "i8",
+            Int16TypeSyntax   <$> keywordToken "i16",
+            Int32TypeSyntax   <$> keywordToken "i32",
+            Int64TypeSyntax   <$> keywordToken "i64",
+            UInt8TypeSyntax   <$> keywordToken "u8",
+            UInt16TypeSyntax  <$> keywordToken "u16",
+            UInt32TypeSyntax  <$> keywordToken "u32",
+            UInt64TypeSyntax  <$> keywordToken "u64",
+            Float32TypeSyntax <$> keywordToken "f32",
+            Float64TypeSyntax <$> keywordToken "f64",
+            VoidTypeSyntax    <$> keywordToken "void"]
+        declaredTypeSyntax    = DeclaredTypeSyntax <$> option Nothing (Just <$> between (punctuatorToken '<') (punctuatorToken '>') moduleNameSyntax) <*> simpleNameSyntax
+        referenceTypeSyntax   = ReferenceTypeSyntax <$ punctuatorToken '&'
+        functionTypeSyntax    = flip FunctionTypeSyntax <$> between (punctuatorToken '(') (punctuatorToken ')') (sepBy typeSyntax (punctuatorToken ','))
+        arrayOrSpanTypeSyntax = between (punctuatorToken '[') (punctuatorToken ']') (option SpanTypeSyntax (flip ArrayTypeSyntax <$> literalSyntax))
+
+--------------------------------------------------------------------------------
+
+compilationUnitSyntax :: Parser CompilationUnitSyntax
+compilationUnitSyntax = do
+    modules                 <- many moduleDeclarationSyntax
+    _                       <- endOfFileToken
+    return (CompilationUnitSyntax modules)
+
+moduleDeclarationSyntax :: Parser ModuleDeclarationSyntax
+moduleDeclarationSyntax = do
+    moduleKeyword           <- keywordToken "module"
+    moduleName              <- moduleNameSyntax
+    _                       <- punctuatorToken '{'
+    importDirectives        <- many importDirectiveSyntax
+    moduleMembers           <- many moduleMemberSyntax
+    _                       <- punctuatorToken '}'
+    return (ModuleDeclarationSyntax moduleKeyword moduleName importDirectives moduleMembers)
+
+importDirectiveSyntax :: Parser ImportDirectiveSyntax
+importDirectiveSyntax = do
+    importKeyword           <- keywordToken "import"
+    moduleName              <- moduleNameSyntax
+    return (ImportDirectiveSyntax importKeyword moduleName)
+
+moduleMemberSyntax :: Parser ModuleMemberSyntax
+moduleMemberSyntax = typeDeclarationSyntax <|> functionDeclarationSyntax
+
+typeDeclarationSyntax :: Parser ModuleMemberSyntax
+typeDeclarationSyntax = do
+    typeKeyword             <- keywordToken "type"
+    typeName                <- simpleNameSyntax
+    _                       <- punctuatorToken '{'
+    fieldDeclarations       <- many fieldDeclarationSyntax
+    _                       <- punctuatorToken '}'
+    return (TypeDeclarationSyntax typeKeyword typeName fieldDeclarations)
+
+fieldDeclarationSyntax :: Parser FieldDeclarationSyntax
+fieldDeclarationSyntax = do
+    fieldKeyword            <- keywordToken "field"
+    fieldType               <- typeSyntax
+    fieldName               <- simpleNameSyntax
+    return (FieldDeclarationSyntax fieldKeyword fieldType fieldName)
+
+functionDeclarationSyntax :: Parser ModuleMemberSyntax
+functionDeclarationSyntax =
+    functionDeclaration <|> functionDefinition
+
+functionDeclaration :: Parser ModuleMemberSyntax
+functionDeclaration = do
+    functionKeyword         <- keywordToken "declare"
+    returnType              <- typeSyntax
+    functionName            <- simpleNameSyntax
+    parameterDeclarations   <- between (punctuatorToken '(') (punctuatorToken ')') (sepBy parameterDeclarationSyntax (punctuatorToken ','))
+    systemCallOrdinal       <- literalSyntax
+    return (FunctionDeclarationSyntax functionKeyword returnType functionName parameterDeclarations (Right systemCallOrdinal))
+
+functionDefinition :: Parser ModuleMemberSyntax
+functionDefinition = do
+    functionKeyword         <- keywordToken "define"
+    returnType              <- typeSyntax
+    functionName            <- simpleNameSyntax
+    parameterDeclarations   <- between (punctuatorToken '(') (punctuatorToken ')') (sepBy parameterDeclarationSyntax (punctuatorToken ','))
+    functionBody            <- functionBodySyntax
+    return (FunctionDeclarationSyntax functionKeyword returnType functionName parameterDeclarations (Left functionBody))
+
+parameterDeclarationSyntax :: Parser ParameterDeclarationSyntax
+parameterDeclarationSyntax = do
+    parameterType           <- typeSyntax
+    parameterName           <- simpleNameSyntax
+    return (ParameterDeclarationSyntax parameterType parameterName)
+
+functionBodySyntax :: Parser FunctionBodySyntax
+functionBodySyntax = do
+    _                       <- punctuatorToken '{'
+    localDeclarations       <- many localDeclarationSyntax
+    instructions            <- many (instructionSyntax <|> labeledInstructionSyntax)
+    _                       <- punctuatorToken '}'
+    return (FunctionBodySyntax localDeclarations (V.fromList instructions))
+
+localDeclarationSyntax :: Parser LocalDeclarationSyntax
+localDeclarationSyntax = do
+    localKeyword            <- keywordToken "local"
+    localType               <- typeSyntax
+    localName               <- simpleNameSyntax
+    return (LocalDeclarationSyntax localKeyword localType localName)
+
+labeledInstructionSyntax :: Parser InstructionSyntax
+labeledInstructionSyntax = do
+    name                    <- simpleNameSyntax
+    _                       <- punctuatorToken ':'
+    instruction             <- instructionSyntax
+    return (LabeledInstructionSyntax name instruction)
+
+instructionSyntax :: Parser InstructionSyntax
+instructionSyntax =
+    choice [
+        noneInstruction     AddInstructionSyntax        "add",
+        noneInstruction     AndInstructionSyntax        "and",
+        nameInstruction     BeqSInstructionSyntax       "beq.s",
+        nameInstruction     BeqInstructionSyntax        "beq",
+        nameInstruction     BgeUnSInstructionSyntax     "bge.un.s",
+        nameInstruction     BgeUnInstructionSyntax      "bge.un",
+        nameInstruction     BgeSInstructionSyntax       "bge.s",
+        nameInstruction     BgeInstructionSyntax        "bge",
+        nameInstruction     BgtUnSInstructionSyntax     "bgt.un.s",
+        nameInstruction     BgtUnInstructionSyntax      "bgt.un",
+        nameInstruction     BgtSInstructionSyntax       "bgt.s",
+        nameInstruction     BgtInstructionSyntax        "bgt",
+        nameInstruction     BleUnSInstructionSyntax     "ble.un.s",
+        nameInstruction     BleUnInstructionSyntax      "ble.un",
+        nameInstruction     BleSInstructionSyntax       "ble.s",
+        nameInstruction     BleInstructionSyntax        "ble",
+        nameInstruction     BltUnSInstructionSyntax     "blt.un.s",
+        nameInstruction     BltUnInstructionSyntax      "blt.un",
+        nameInstruction     BltSInstructionSyntax       "blt.s",
+        nameInstruction     BltInstructionSyntax        "blt",
+        nameInstruction     BneUnSInstructionSyntax     "bne.un.s",
+        nameInstruction     BneUnInstructionSyntax      "bne.un",
+        noneInstruction     BreakInstructionSyntax      "break",
+        nameInstruction     BrfalseSInstructionSyntax   "brfalse.s",
+        nameInstruction     BrfalseInstructionSyntax    "brfalse",
+        nameInstruction     BrSInstructionSyntax        "br.s",
+        nameInstruction     BrInstructionSyntax         "br",
+        nameInstruction     BrtrueSInstructionSyntax    "brtrue.s",
+        nameInstruction     BrtrueInstructionSyntax     "brtrue",
+        typeInstruction     CalliInstructionSyntax      "calli",
+        functionInstruction CallInstructionSyntax       "call",
+        noneInstruction     CeqInstructionSyntax        "ceq",
+        noneInstruction     CgtUnInstructionSyntax      "cgt.un",
+        noneInstruction     CgtInstructionSyntax        "cgt",
+        noneInstruction     CltUnInstructionSyntax      "clt.un",
+        noneInstruction     CltInstructionSyntax        "clt",
+        typeInstruction     ConvUnInstructionSyntax     "conv.un",
+        typeInstruction     ConvInstructionSyntax       "conv",
+        noneInstruction     DivUnInstructionSyntax      "div.un",
+        noneInstruction     DivInstructionSyntax        "div",
+        noneInstruction     DupInstructionSyntax        "dup",
+        nameInstruction     LdargaInstructionSyntax     "ldarga",
+        nameInstruction     LdargInstructionSyntax      "ldarg",
+        constantInstruction LdcInstructionSyntax        "ldc",
+        typeInstruction     LdelemaInstructionSyntax    "ldelema",
+        typeInstruction     LdelemInstructionSyntax     "ldelem",
+        fieldInstruction    LdfldaInstructionSyntax     "ldflda",
+        fieldInstruction    LdfldInstructionSyntax      "ldfld",
+        functionInstruction LdftnInstructionSyntax      "ldftn",
+        typeInstruction     LdindInstructionSyntax      "ldind",
+        noneInstruction     LdlenInstructionSyntax      "ldlen",
+        nameInstruction     LdlocaInstructionSyntax     "ldloca",
+        nameInstruction     LdlocInstructionSyntax      "ldloc",
+        noneInstruction     LdnullInstructionSyntax     "ldnull",
+        noneInstruction     MulInstructionSyntax        "mul",
+        noneInstruction     NegInstructionSyntax        "neg",
+        typeInstruction     NewarrInstructionSyntax     "newarr",
+        functionInstruction NewobjInstructionSyntax     "newobj",
+        noneInstruction     NopInstructionSyntax        "nop",
+        noneInstruction     NotInstructionSyntax        "not",
+        noneInstruction     OrInstructionSyntax         "or",
+        noneInstruction     PopInstructionSyntax        "pop",
+        noneInstruction     RemUnInstructionSyntax      "rem.un",
+        noneInstruction     RemInstructionSyntax        "rem",
+        noneInstruction     RetInstructionSyntax        "ret",
+        noneInstruction     ShlInstructionSyntax        "shl",
+        noneInstruction     ShrUnInstructionSyntax      "shr.un",
+        noneInstruction     ShrInstructionSyntax        "shr",
+        nameInstruction     StargInstructionSyntax      "starg",
+        typeInstruction     StelemInstructionSyntax     "stelem",
+        fieldInstruction    StfldInstructionSyntax      "stfld",
+        typeInstruction     StindInstructionSyntax      "stind",
+        nameInstruction     StlocInstructionSyntax      "stloc",
+        noneInstruction     SubInstructionSyntax        "sub",
+        functionInstruction SyscallInstructionSyntax    "syscall",
+        noneInstruction     XorInstructionSyntax        "xor"]
+    where
+        constantInstruction constructor keyword = do
+            keyword'        <- keywordToken keyword
+            constantType    <- typeSyntax
+            constantValue   <- literalSyntax
+            return (constructor keyword' constantType constantValue)
+
+        fieldInstruction constructor keyword = do
+            keyword'        <- keywordToken keyword
+            fieldType       <- typeSyntax
+            moduleName      <- option Nothing (Just <$> between (punctuatorToken '<') (punctuatorToken '>') moduleNameSyntax)
+            typeName        <- simpleNameSyntax
+            _               <- punctuatorToken '/'
+            fieldName       <- simpleNameSyntax
+            return (constructor keyword' fieldType moduleName typeName fieldName)
+
+        functionInstruction constructor keyword = do
+            keyword'        <- keywordToken keyword
+            returnType      <- typeSyntax
+            moduleName      <- option Nothing (Just <$> between (punctuatorToken '<') (punctuatorToken '>') moduleNameSyntax)
+            functionName    <- simpleNameSyntax
+            parameterTypes  <- between (punctuatorToken '(') (punctuatorToken ')') (sepBy typeSyntax (punctuatorToken ','))
+            return (constructor keyword' returnType moduleName functionName parameterTypes)
+
+        nameInstruction constructor keyword = do
+            keyword'        <- keywordToken keyword
+            name            <- simpleNameSyntax
+            return (constructor keyword' name)
+
+        noneInstruction constructor keyword = do
+            keyword'        <- keywordToken keyword
+            return (constructor keyword')
+
+        typeInstruction constructor keyword = do
+            keyword'        <- keywordToken keyword
+            instructionType <- typeSyntax
+            return (constructor keyword' instructionType)
+
+--------------------------------------------------------------------------------
+
+parseText :: (Monad m) => FilePath -> Text -> CompilerT Diagnostic m SyntaxTree
+parseText path text =
+    parseBytes path (encodeUtf8 text)
+
+parseBytes :: (Monad m) => FilePath -> ByteString -> CompilerT Diagnostic m SyntaxTree
+parseBytes path text =
+    case runParser compilationUnitSyntax path (tokenizeBytes path text) of
+        Right root                         -> return (SyntaxTree root path text)
+        Left (TrivialError (pos:|_) us ps) -> report (SyntaxError (Location pos text) us ps) >> stop
+        Left (FancyError   (pos:|_) es)    -> reportMany [GenericError (Location pos text) e | ErrorFail e <- E.toAscList es] >> stop
+
+parseFile :: (MonadIO m) => FilePath -> CompilerT Diagnostic m SyntaxTree
+parseFile path =
+    liftIO (readFile path) >>= parseBytes path
+
+parseFiles :: (MonadIO m) => [FilePath] -> CompilerT Diagnostic m [SyntaxTree]
+parseFiles paths =
+    sequentialC (fmap parseFile paths)
+
+--------------------------------------------------------------------------------

src/Mango/Compiler/Symbols.hs

+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Mango.Compiler.Symbols (
+    -- Semantic Model
+    SemanticModel (..),
+    ModuleSymbol (..),
+    TypeSymbol (..),
+    FieldSymbol (..),
+    FunctionSymbol (..),
+    ParameterSymbol (..),
+    LocalSymbol (..),
+    LabelSymbol (..),
+    Symbol (..),
+    TypeLayout (..),
+    typeLayout,
+    moduleDependencies,
+    functionType,
+    returnsVoid,
+    ) where
+
+import Data.Bool
+import Data.Eq
+import Data.Function
+import Data.Graph (Graph, reachable)
+import Data.Int (Int)
+import Data.List
+import Data.Maybe
+import Data.String (String)
+import Mango.Compiler.Error
+import Mango.Compiler.Syntax (Location (..), SourcePos (..))
+import Prelude (Num (..), Integer, fromIntegral, undefined)
+import Text.Show
+
+--------------------------------------------------------------------------------
+
+data SemanticModel
+    = SemanticModel { semanticModel_modules :: [ModuleSymbol], semanticModel_moduleGraph :: Graph }
+
+data ModuleSymbol
+    = ModuleSymbol      { moduleSymbol_containingModel :: !SemanticModel, moduleSymbol_name :: !String, moduleSymbol_index :: {-# UNPACK #-} !Int, moduleSymbol_imports :: [ModuleSymbol], moduleSymbol_types :: [TypeSymbol], moduleSymbol_functions :: [FunctionSymbol], moduleSymbol_entryPoint :: Maybe FunctionSymbol, moduleSymbol_location :: !Location, moduleSymbol_diagnostics :: [Diagnostic] }
+    | ErrorModuleSymbol { moduleSymbol_containingModel :: !SemanticModel, moduleSymbol_name :: !String,                                            moduleSymbol_imports :: [ModuleSymbol], moduleSymbol_types :: [TypeSymbol], moduleSymbol_functions :: [FunctionSymbol], moduleSymbol_entryPoint :: Maybe FunctionSymbol, moduleSymbol_location :: !Location, moduleSymbol_diagnostics :: [Diagnostic] }
+
+data TypeSymbol
+    = BoolTypeSymbol
+    | Int8TypeSymbol
+    | Int16TypeSymbol
+    | Int32TypeSymbol
+    | Int64TypeSymbol
+    | UInt8TypeSymbol
+    | UInt16TypeSymbol
+    | UInt32TypeSymbol
+    | UInt64TypeSymbol
+    | Float32TypeSymbol
+    | Float64TypeSymbol
+    | VoidTypeSymbol
+    | ArrayTypeSymbol      { arrayTypeSymbol_elementType :: !TypeSymbol, arrayTypeSymbol_length :: !Integer }
+    | StructuredTypeSymbol { structuredTypeSymbol_containingSymbol :: !ModuleSymbol, structuredTypeSymbol_name :: !String, structuredTypeSymbol_fields :: ![FieldSymbol], structuredTypeSymbol_layout :: TypeLayout, structuredTypeSymbol_location :: !Location, structuredTypeSymbol_diagnostics :: [Diagnostic] }
+    | ErrorTypeSymbol      { structuredTypeSymbol_containingSymbol :: !ModuleSymbol, structuredTypeSymbol_name :: !String, structuredTypeSymbol_fields :: ![FieldSymbol], structuredTypeSymbol_layout :: TypeLayout, structuredTypeSymbol_location :: !Location, structuredTypeSymbol_diagnostics :: [Diagnostic] }
+    | FunctionTypeSymbol   { functionTypeSymbol_returnType :: !TypeSymbol, functionTypeSymbol_parameterTypes :: ![TypeSymbol] }
+    | ReferenceTypeSymbol  { referenceTypeSymbol_referencedType :: !TypeSymbol }
+    | SpanTypeSymbol       { spanTypeSymbol_elementType :: !TypeSymbol }
+    | NullTypeSymbol
+
+data FieldSymbol
+    = FieldSymbol      { fieldSymbol_containingSymbol :: !TypeSymbol, fieldSymbol_name :: !String, fieldSymbol_fieldType :: TypeSymbol, fieldSymbol_offset :: Int, fieldSymbol_location :: !Location, fieldSymbol_diagnostics :: [Diagnostic] }
+    | ErrorFieldSymbol { fieldSymbol_containingSymbol :: !TypeSymbol, fieldSymbol_name :: !String, fieldSymbol_fieldType :: TypeSymbol, fieldSymbol_offset :: Int, fieldSymbol_location :: !Location, fieldSymbol_diagnostics :: [Diagnostic] }
+
+data FunctionSymbol
+    = FunctionSymbol      { functionSymbol_containingSymbol :: !ModuleSymbol, functionSymbol_name :: !String, functionSymbol_returnType :: TypeSymbol, functionSymbol_parameters :: [ParameterSymbol], functionSymbol_locals :: [LocalSymbol], functionSymbol_labels :: [LabelSymbol], functionSymbol_ordinal :: !(Maybe Integer), functionSymbol_location :: !Location, functionSymbol_diagnostics :: [Diagnostic] }
+    | ErrorFunctionSymbol { functionSymbol_containingSymbol :: !ModuleSymbol, functionSymbol_name :: !String, functionSymbol_returnType :: TypeSymbol, functionSymbol_parameters :: [ParameterSymbol], functionSymbol_locals :: [LocalSymbol], functionSymbol_labels :: [LabelSymbol], functionSymbol_ordinal :: !(Maybe Integer), functionSymbol_location :: !Location, functionSymbol_diagnostics :: [Diagnostic] }
+
+data ParameterSymbol
+    = ParameterSymbol      { parameterSymbol_containingSymbol :: !FunctionSymbol, parameterSymbol_name :: !String, parameterSymbol_parameterType :: TypeSymbol, parameterSymbol_location :: !Location, parameterSymbol_diagnostics :: [Diagnostic] }
+    | ErrorParameterSymbol { parameterSymbol_containingSymbol :: !FunctionSymbol, parameterSymbol_name :: !String,                                              parameterSymbol_location :: !Location, parameterSymbol_diagnostics :: [Diagnostic] }
+
+data LocalSymbol
+    = LocalSymbol      { localSymbol_containingSymbol :: !FunctionSymbol, localSymbol_name :: !String, localSymbol_localType :: TypeSymbol, localSymbol_location :: !Location, localSymbol_diagnostics :: [Diagnostic] }
+    | ErrorLocalSymbol { localSymbol_containingSymbol :: !FunctionSymbol, localSymbol_name :: !String,                                      localSymbol_location :: !Location, localSymbol_diagnostics :: [Diagnostic] }
+
+data LabelSymbol
+    = LabelSymbol      { labelSymbol_containingSymbol :: !FunctionSymbol, labelSymbol_name :: !String, labelSymbol_index :: !Int, labelSymbol_location :: !Location, labelSymbol_diagnostics :: [Diagnostic] }
+    | ErrorLabelSymbol { labelSymbol_containingSymbol :: !FunctionSymbol, labelSymbol_name :: !String,                            labelSymbol_location :: !Location, labelSymbol_diagnostics :: [Diagnostic] }
+
+class Symbol a where
+    containingModel    :: a -> SemanticModel
+    containingModule   :: a -> ModuleSymbol
+    containingType     :: a -> TypeSymbol
+    containingFunction :: a -> FunctionSymbol
+    symbolName         :: a -> String
+    symbolLocation     :: a -> Location
+    symbolPretty       :: a -> String
+
+instance Symbol ModuleSymbol where
+    containingModel    = moduleSymbol_containingModel
+    containingModule   = id
+    containingType     = undefined
+    containingFunction = undefined
+    symbolName         = moduleSymbol_name
+    symbolLocation     = moduleSymbol_location
+    symbolPretty s     = concat ["module ", moduleSymbol_name s, " at ", show (moduleSymbol_location s)]
+
+instance Symbol TypeSymbol where
+    containingModel    = moduleSymbol_containingModel . structuredTypeSymbol_containingSymbol
+    containingModule   = structuredTypeSymbol_containingSymbol
+    containingType     = undefined
+    containingFunction = undefined
+    symbolName         = structuredTypeSymbol_name
+    symbolLocation     = structuredTypeSymbol_location
+    symbolPretty s     = concat ["type ", structuredTypeSymbol_name s, " at ", show (structuredTypeSymbol_location s)]
+
+instance Symbol FieldSymbol where
+    containingModel    = moduleSymbol_containingModel . structuredTypeSymbol_containingSymbol . fieldSymbol_containingSymbol
+    containingModule   = structuredTypeSymbol_containingSymbol . fieldSymbol_containingSymbol
+    containingType     = fieldSymbol_containingSymbol
+    containingFunction = undefined
+    symbolName         = fieldSymbol_name
+    symbolLocation     = fieldSymbol_location
+    symbolPretty s     = concat ["field ", fieldSymbol_name s, " at ", show (fieldSymbol_location s)]
+
+instance Symbol FunctionSymbol where
+    containingModel    = moduleSymbol_containingModel . functionSymbol_containingSymbol
+    containingModule   = functionSymbol_containingSymbol
+    containingType     = undefined
+    containingFunction = id
+    symbolName         = functionSymbol_name
+    symbolLocation     = functionSymbol_location
+    symbolPretty s     = concat ["function ", show (functionSymbol_returnType s), " ", functionSymbol_name s, "(", intercalate ", " (map (show . parameterSymbol_parameterType) (functionSymbol_parameters s)), ") at ", show (functionSymbol_location s)]
+
+instance Symbol ParameterSymbol where
+    containingModel    = moduleSymbol_containingModel . functionSymbol_containingSymbol . parameterSymbol_containingSymbol
+    containingModule   = functionSymbol_containingSymbol . parameterSymbol_containingSymbol
+    containingType     = undefined
+    containingFunction = parameterSymbol_containingSymbol
+    symbolName         = parameterSymbol_name
+    symbolLocation     = parameterSymbol_location
+    symbolPretty s     = concat ["parameter ", show (parameterSymbol_parameterType s), " ", show (parameterSymbol_name s), " at ", show (parameterSymbol_location s)]
+
+instance Symbol LocalSymbol where
+    containingModel    = moduleSymbol_containingModel . functionSymbol_containingSymbol . localSymbol_containingSymbol
+    containingModule   = functionSymbol_containingSymbol . localSymbol_containingSymbol
+    containingType     = undefined
+    containingFunction = localSymbol_containingSymbol
+    symbolName         = localSymbol_name
+    symbolLocation     = localSymbol_location
+    symbolPretty s     = concat ["local ", show (localSymbol_localType s), " ", show (localSymbol_name s), " at ", show (localSymbol_location s)]
+
+instance Symbol LabelSymbol where
+    containingModel    = moduleSymbol_containingModel . functionSymbol_containingSymbol . labelSymbol_containingSymbol
+    containingModule   = functionSymbol_containingSymbol . labelSymbol_containingSymbol
+    containingType     = undefined
+    containingFunction = labelSymbol_containingSymbol
+    symbolName         = labelSymbol_name
+    symbolLocation     = labelSymbol_location
+    symbolPretty s     = concat ["label ", show (labelSymbol_name s), " at ", show (labelSymbol_location s), ")"]
+
+instance Eq ModuleSymbol where
+    (ModuleSymbol _ _ _ _ _ _ _ location _)                 == (ModuleSymbol _ _ _ _ _ _ _ location' _)                 = location == location'
+    (ErrorModuleSymbol _ name _ _ _ _ location _)           == (ErrorModuleSymbol _ name' _ _ _ _ location' _)          = sourceName (location_sourcePos location) == sourceName (location_sourcePos location') && name == name'
+    _                                                       == _                                                        = False
+
+instance Eq TypeSymbol where
+    BoolTypeSymbol                                          == BoolTypeSymbol                                           = True
+    Int8TypeSymbol                                          == Int8TypeSymbol                                           = True
+    Int16TypeSymbol                                         == Int16TypeSymbol                                          = True
+    Int32TypeSymbol                                         == Int32TypeSymbol                                          = True
+    Int64TypeSymbol                                         == Int64TypeSymbol                                          = True
+    UInt8TypeSymbol                                         == UInt8TypeSymbol                                          = True
+    UInt16TypeSymbol                                        == UInt16TypeSymbol                                         = True
+    UInt32TypeSymbol                                        == UInt32TypeSymbol                                         = True
+    UInt64TypeSymbol                                        == UInt64TypeSymbol                                         = True
+    Float32TypeSymbol                                       == Float32TypeSymbol                                        = True
+    Float64TypeSymbol                                       == Float64TypeSymbol                                        = True
+    VoidTypeSymbol                                          == VoidTypeSymbol                                           = True
+    (ArrayTypeSymbol elementType length_)                   == (ArrayTypeSymbol elementType' length_')                  = elementType == elementType' && length_ == length_'
+    (StructuredTypeSymbol _ _ _ _ location _)               == (StructuredTypeSymbol _ _ _ _ location' _)               = location == location'
+    (ErrorTypeSymbol container name _ _ _ _)                == (ErrorTypeSymbol container' name' _ _ _ _)               = container == container' && name == name'
+    (FunctionTypeSymbol returnType parameterTypes)          == (FunctionTypeSymbol returnType' parameterTypes')         = returnType == returnType' && parameterTypes == parameterTypes'
+    (ReferenceTypeSymbol referencedType)                    == (ReferenceTypeSymbol referencedType')                    = referencedType == referencedType'
+    (SpanTypeSymbol elementType)                            == (SpanTypeSymbol elementType')                            = elementType == elementType'
+    NullTypeSymbol                                          == NullTypeSymbol                                           = True
+    _                                                       == _                                                        = False
+
+instance Eq FieldSymbol where
+    (FieldSymbol _ _ _ _ location _)                        == (FieldSymbol _ _ _ _ location' _)                        = location == location'
+    (ErrorFieldSymbol container name _ _ _ _)               == (ErrorFieldSymbol container' name' _ _ _ _)              = container == container' && name == name'
+    _                                                       == _                                                        = False
+
+instance Eq FunctionSymbol where
+    (FunctionSymbol _ _ _ _ _ _ _ location _)               == (FunctionSymbol _ _ _ _ _ _ _ location' _)               = location == location'
+    (ErrorFunctionSymbol container name _ _ _ _ _ _ _)      == (ErrorFunctionSymbol container' name' _ _ _ _ _ _ _)     = container == container' && name == name'
+    _                                                       == _                                                        = False
+
+instance Eq ParameterSymbol where
+    (ParameterSymbol _ _ _ location _)                      == (ParameterSymbol _ _ _ location' _)                      = location == location'
+    (ErrorParameterSymbol container name _ _)               == (ErrorParameterSymbol container' name' _ _)              = container == container' && name == name'
+    _                                                       == _                                                        = False
+
+instance Eq LocalSymbol where
+    (LocalSymbol _ _ _ location _)                          == (LocalSymbol _ _ _ location' _)                          = location == location'
+    (ErrorLocalSymbol container name _ _)                   == (ErrorLocalSymbol container' name' _ _)                  = container == container' && name == name'
+    _                                                       == _                                                        = False
+
+instance Eq LabelSymbol where
+    (LabelSymbol _ _ _ location _)                          == (LabelSymbol _ _ _ location' _)                          = location == location'
+    (ErrorLabelSymbol container name _ _)                   == (ErrorLabelSymbol container' name' _ _)                  = container == container' && name == name'
+    _                                                       == _                                                        = False
+
+instance Show TypeSymbol where
+    show BoolTypeSymbol                                 = "bool"
+    show Int8TypeSymbol                                 = "i8"
+    show Int16TypeSymbol                                = "i16"
+    show Int32TypeSymbol                                = "i32"
+    show Int64TypeSymbol                                = "i64"
+    show UInt8TypeSymbol                                = "u8"
+    show UInt16TypeSymbol                               = "u16"
+    show UInt32TypeSymbol                               = "u32"
+    show UInt64TypeSymbol                               = "u64"
+    show Float32TypeSymbol                              = "f32"
+    show Float64TypeSymbol                              = "f64"
+    show VoidTypeSymbol                                 = "void"
+    show (ArrayTypeSymbol elementType length_)          = concat [show elementType, "[", show length_, "]"]
+    show (StructuredTypeSymbol container name _ _ _ _)  = concat ["<", symbolName container, "> ", name]
+    show (ErrorTypeSymbol container name _ _ _ _)       = concat ["<", symbolName container, "> ", name]
+    show (FunctionTypeSymbol returnType parameterTypes) = concat [show returnType, "(", intercalate ", " (map show parameterTypes), ")"]
+    show (ReferenceTypeSymbol referencedType)           = concat [show referencedType, "&"]
+    show (SpanTypeSymbol elementType)                   = concat [show elementType, "[]"]
+    show NullTypeSymbol                                 = "null"
+
+--------------------------------------------------------------------------------
+
+data TypeLayout
+    = TypeLayout { typeLayout_alignment :: Int, typeLayout_size :: Int }
+
+typeLayout :: TypeSymbol -> TypeLayout
+typeLayout   BoolTypeSymbol       {} = TypeLayout 1 1
+typeLayout   Int8TypeSymbol       {} = TypeLayout 1 1
+typeLayout   Int16TypeSymbol      {} = TypeLayout 2 2
+typeLayout   Int32TypeSymbol      {} = TypeLayout 4 4
+typeLayout   Int64TypeSymbol      {} = TypeLayout 4 8
+typeLayout   UInt8TypeSymbol      {} = TypeLayout 1 1
+typeLayout   UInt16TypeSymbol     {} = TypeLayout 2 2
+typeLayout   UInt32TypeSymbol     {} = TypeLayout 4 4
+typeLayout   UInt64TypeSymbol     {} = TypeLayout 4 8
+typeLayout   Float32TypeSymbol    {} = TypeLayout 4 4
+typeLayout   Float64TypeSymbol    {} = TypeLayout 4 8
+typeLayout   VoidTypeSymbol       {} = TypeLayout 1 0
+typeLayout t@ArrayTypeSymbol      {} = TypeLayout a (s * (fromIntegral (arrayTypeSymbol_length t))) where TypeLayout a s = typeLayout (arrayTypeSymbol_elementType t)
+typeLayout t@StructuredTypeSymbol {} = structuredTypeSymbol_layout t
+typeLayout t@ErrorTypeSymbol      {} = structuredTypeSymbol_layout t
+typeLayout   FunctionTypeSymbol   {} = TypeLayout 4 4
+typeLayout   ReferenceTypeSymbol  {} = TypeLayout 4 4
+typeLayout   SpanTypeSymbol       {} = TypeLayout 4 8 
+typeLayout   NullTypeSymbol       {} = TypeLayout 4 4
+
+--------------------------------------------------------------------------------
+
+moduleDependencies :: ModuleSymbol -> [ModuleSymbol]
+moduleDependencies moduleSymbol =
+    map (modules!!) $ nub $ concat [reachable moduleGraph (moduleSymbol_index symbol) | symbol@ModuleSymbol {} <- moduleSymbol_imports moduleSymbol]
+    where
+        modules = semanticModel_modules (containingModel moduleSymbol)
+        moduleGraph = semanticModel_moduleGraph (containingModel moduleSymbol)
+
+functionType :: FunctionSymbol -> TypeSymbol
+functionType functionSymbol =
+    FunctionTypeSymbol (functionSymbol_returnType functionSymbol) (map parameterSymbol_parameterType (functionSymbol_parameters functionSymbol))
+
+returnsVoid :: FunctionSymbol -> Bool
+returnsVoid FunctionSymbol { functionSymbol_returnType = VoidTypeSymbol } = True
+returnsVoid _ = False
+
+--------------------------------------------------------------------------------