Moved modules into a proper folder structure.
This commit is contained in:
Samuel Hammersberg
parent
ac0ac2dac7
commit
d5dd7896d8
9 changed files with 66 additions and 180 deletions
|
|
@ -32,11 +32,11 @@ executable language
|
|||
Grammar.Print
|
||||
Grammar.Skel
|
||||
Grammar.ErrM
|
||||
LambdaLifter
|
||||
LambdaLifter.LambdaLifter
|
||||
Auxiliary
|
||||
Renamer
|
||||
TypeChecker
|
||||
TypeCheckerIr
|
||||
Renamer.Renamer
|
||||
TypeChecker.TypeChecker
|
||||
TypeChecker.TypeCheckerIr
|
||||
-- Interpreter
|
||||
Codegen.Codegen
|
||||
Codegen.LlvmIr
|
||||
|
|
|
|||
|
|
@ -3,22 +3,23 @@
|
|||
|
||||
module Codegen.Codegen (generateCode) where
|
||||
|
||||
import Auxiliary (snoc)
|
||||
import Codegen.LlvmIr (CallingConvention (..), LLVMComp (..),
|
||||
LLVMIr (..), LLVMType (..),
|
||||
LLVMValue (..), Visibility (..),
|
||||
llvmIrToString)
|
||||
import Control.Monad.State (StateT, execStateT, foldM_, gets, modify)
|
||||
import qualified Data.Bifunctor as BI
|
||||
import Data.List.Extra (trim)
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Tuple.Extra (dupe, first, second)
|
||||
import qualified Grammar.Abs as GA
|
||||
import Grammar.ErrM (Err)
|
||||
import System.Process.Extra (readCreateProcess, shell)
|
||||
import TypeCheckerIr (Bind (..), Case (..), Exp (..), Id,
|
||||
Ident (..), Program (..), Type (..))
|
||||
import Auxiliary (snoc)
|
||||
import Codegen.LlvmIr (CallingConvention (..),
|
||||
LLVMComp (..), LLVMIr (..),
|
||||
LLVMType (..), LLVMValue (..),
|
||||
Visibility (..), llvmIrToString)
|
||||
import Control.Monad.State (StateT, execStateT, foldM_, gets,
|
||||
modify)
|
||||
import qualified Data.Bifunctor as BI
|
||||
import Data.List.Extra (trim)
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Tuple.Extra (dupe, first, second)
|
||||
import qualified Grammar.Abs as GA
|
||||
import Grammar.ErrM (Err)
|
||||
import System.Process.Extra (readCreateProcess, shell)
|
||||
import TypeChecker.TypeCheckerIr (Bind (..), Case (..), Exp (..), Id,
|
||||
Ident (..), Program (..), Type (..))
|
||||
-- | The record used as the code generator state
|
||||
data CodeGenerator = CodeGenerator
|
||||
{ instructions :: [LLVMIr]
|
||||
|
|
|
|||
|
|
@ -10,8 +10,8 @@ module Codegen.LlvmIr (
|
|||
CallingConvention (..)
|
||||
) where
|
||||
|
||||
import Data.List (intercalate)
|
||||
import TypeCheckerIr
|
||||
import Data.List (intercalate)
|
||||
import TypeChecker.TypeCheckerIr
|
||||
|
||||
data CallingConvention = TailCC | FastCC | CCC | ColdCC
|
||||
instance Show CallingConvention where
|
||||
|
|
|
|||
|
|
@ -1,116 +0,0 @@
|
|||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedRecordDot #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Interpreter where
|
||||
|
||||
import Auxiliary (maybeToRightM)
|
||||
import Control.Applicative (Applicative)
|
||||
import Control.Monad.Except (Except, MonadError (throwError),
|
||||
liftEither)
|
||||
import Control.Monad.State (MonadState, StateT, evalStateT)
|
||||
import Data.Either.Combinators (maybeToRight)
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe (maybe)
|
||||
import Grammar.Abs
|
||||
import Grammar.ErrM (Err)
|
||||
import Grammar.Print (printTree)
|
||||
|
||||
interpret :: Program -> Err Integer
|
||||
interpret (Program scs) = do
|
||||
main <- findMain scs
|
||||
eval (initCxt scs) main >>=
|
||||
\case
|
||||
VClosure {} -> throwError "main evaluated to a function"
|
||||
VInt i -> pure i
|
||||
|
||||
|
||||
initCxt :: [Bind] -> Cxt
|
||||
initCxt scs =
|
||||
Cxt { env = mempty
|
||||
, sig = foldr insert mempty $ map expandLambdas scs
|
||||
}
|
||||
where insert (Bind name _ rhs) = Map.insert name rhs
|
||||
|
||||
expandLambdas :: Bind -> Bind
|
||||
expandLambdas (Bind name parms rhs) = Bind name [] $ foldr EAbs rhs parms
|
||||
|
||||
findMain :: [Bind] -> Err Exp
|
||||
findMain [] = throwError "No main!"
|
||||
findMain (sc:scs) = case sc of
|
||||
Bind "main" _ rhs -> pure rhs
|
||||
_ -> findMain scs
|
||||
|
||||
data Val = VInt Integer
|
||||
| VClosure Env Ident Exp
|
||||
deriving (Show, Eq)
|
||||
|
||||
type Env = Map Ident Val
|
||||
type Sig = Map Ident Exp
|
||||
|
||||
data Cxt = Cxt
|
||||
{ env :: Map Ident Val
|
||||
, sig :: Map Ident Exp
|
||||
} deriving (Show, Eq)
|
||||
|
||||
eval :: Cxt -> Exp -> Err Val
|
||||
eval cxt = \case
|
||||
|
||||
-- ------------ x ∈ γ
|
||||
-- γ ⊢ x ⇓ γ(x)
|
||||
|
||||
EId x -> do
|
||||
case Map.lookup x cxt.env of
|
||||
Just e -> pure e
|
||||
Nothing ->
|
||||
case Map.lookup x cxt.sig of
|
||||
Just e -> eval (emptyEnv cxt) e
|
||||
Nothing -> throwError ("Unbound variable: " ++ printTree x)
|
||||
|
||||
-- ---------
|
||||
-- γ ⊢ i ⇓ i
|
||||
|
||||
EInt i -> pure $ VInt i
|
||||
|
||||
-- γ ⊢ e ⇓ let δ in λx. f
|
||||
-- γ ⊢ e₁ ⇓ v
|
||||
-- δ,x=v ⊢ f ⇓ v₁
|
||||
-- ------------------------------
|
||||
-- γ ⊢ e e₁ ⇓ v₁
|
||||
|
||||
EApp e e1 ->
|
||||
eval cxt e >>= \case
|
||||
VInt _ -> throwError "Not a function"
|
||||
VClosure delta x f -> do
|
||||
v <- eval cxt e1
|
||||
let cxt' = putEnv (Map.insert x v delta) cxt
|
||||
eval cxt' f
|
||||
|
||||
|
||||
--
|
||||
-- -----------------------------
|
||||
-- γ ⊢ λx. f ⇓ let γ in λx. f
|
||||
|
||||
EAbs par e -> pure $ VClosure cxt.env par e
|
||||
|
||||
|
||||
-- γ ⊢ e ⇓ v
|
||||
-- γ ⊢ e₁ ⇓ v₁
|
||||
-- ------------------
|
||||
-- γ ⊢ e e₁ ⇓ v + v₁
|
||||
|
||||
EAdd e e1 -> do
|
||||
v <- eval cxt e
|
||||
v1 <- eval cxt e1
|
||||
case (v, v1) of
|
||||
(VInt i, VInt i1) -> pure $ VInt (i + i1)
|
||||
_ -> throwError "Can't add a function"
|
||||
|
||||
ELet _ _ -> throwError "ELet pattern match should never occur!"
|
||||
|
||||
|
||||
emptyEnv :: Cxt -> Cxt
|
||||
emptyEnv cxt = cxt { env = mempty }
|
||||
|
||||
putEnv :: Env -> Cxt -> Cxt
|
||||
putEnv env cxt = cxt { env = env }
|
||||
|
|
@ -2,18 +2,19 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
|
||||
module LambdaLifter (lambdaLift, freeVars, abstract, rename, collectScs) where
|
||||
module LambdaLifter.LambdaLifter (lambdaLift, freeVars, abstract, rename, collectScs) where
|
||||
|
||||
import Auxiliary (snoc)
|
||||
import Control.Applicative (Applicative (liftA2))
|
||||
import Control.Monad.State (MonadState (get, put), State, evalState)
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
import Debug.Trace (trace)
|
||||
import qualified Grammar.Abs as GA
|
||||
import Prelude hiding (exp)
|
||||
import Renamer
|
||||
import TypeCheckerIr
|
||||
import Auxiliary (snoc)
|
||||
import Control.Applicative (Applicative (liftA2))
|
||||
import Control.Monad.State (MonadState (get, put), State,
|
||||
evalState)
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
import Debug.Trace (trace)
|
||||
import qualified Grammar.Abs as GA
|
||||
import Prelude hiding (exp)
|
||||
import Renamer.Renamer
|
||||
import TypeChecker.TypeCheckerIr
|
||||
|
||||
|
||||
-- | Lift lambdas and let expression into supercombinators.
|
||||
36
src/Main.hs
36
src/Main.hs
|
|
@ -2,26 +2,26 @@
|
|||
|
||||
module Main where
|
||||
|
||||
import Codegen.Codegen (generateCode)
|
||||
import GHC.IO.Handle.Text (hPutStrLn)
|
||||
import Grammar.ErrM (Err)
|
||||
import Grammar.Par (myLexer, pProgram)
|
||||
import Grammar.Print (printTree)
|
||||
import Codegen.Codegen (generateCode)
|
||||
import GHC.IO.Handle.Text (hPutStrLn)
|
||||
import Grammar.ErrM (Err)
|
||||
import Grammar.Par (myLexer, pProgram)
|
||||
import Grammar.Print (printTree)
|
||||
|
||||
-- import Interpreter (interpret)
|
||||
import Control.Monad (when)
|
||||
import Data.List.Extra (isSuffixOf)
|
||||
import LambdaLifter (lambdaLift)
|
||||
import Renamer (rename)
|
||||
import System.Directory (createDirectory, doesPathExist,
|
||||
getDirectoryContents,
|
||||
removeDirectoryRecursive,
|
||||
setCurrentDirectory)
|
||||
import System.Environment (getArgs)
|
||||
import System.Exit (exitFailure, exitSuccess)
|
||||
import System.IO (stderr)
|
||||
import System.Process.Extra (spawnCommand, waitForProcess)
|
||||
import TypeChecker (typecheck)
|
||||
import Control.Monad (when)
|
||||
import Data.List.Extra (isSuffixOf)
|
||||
import LambdaLifter.LambdaLifter (lambdaLift)
|
||||
import Renamer.Renamer (rename)
|
||||
import System.Directory (createDirectory, doesPathExist,
|
||||
getDirectoryContents,
|
||||
removeDirectoryRecursive,
|
||||
setCurrentDirectory)
|
||||
import System.Environment (getArgs)
|
||||
import System.Exit (exitFailure, exitSuccess)
|
||||
import System.IO (stderr)
|
||||
import System.Process.Extra (spawnCommand, waitForProcess)
|
||||
import TypeChecker.TypeChecker (typecheck)
|
||||
|
||||
main :: IO ()
|
||||
main =
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Renamer (module Renamer) where
|
||||
module Renamer.Renamer (module Renamer.Renamer) where
|
||||
|
||||
import Auxiliary (mapAccumM)
|
||||
import Control.Monad (foldM)
|
||||
|
|
@ -1,18 +1,18 @@
|
|||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedRecordDot #-}
|
||||
|
||||
module TypeChecker (typecheck, partitionType) where
|
||||
module TypeChecker.TypeChecker (typecheck, partitionType) where
|
||||
|
||||
import Auxiliary (maybeToRightM, snoc)
|
||||
import Control.Monad.Except (throwError, unless)
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import Auxiliary (maybeToRightM, snoc)
|
||||
import Control.Monad.Except (throwError, unless)
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import Grammar.Abs
|
||||
import Grammar.ErrM (Err)
|
||||
import Grammar.Print (Print (prt), concatD, doc, printTree,
|
||||
render)
|
||||
import Prelude hiding (exp, id)
|
||||
import qualified TypeCheckerIr as T
|
||||
import Grammar.ErrM (Err)
|
||||
import Grammar.Print (Print (prt), concatD, doc,
|
||||
printTree, render)
|
||||
import Prelude hiding (exp, id)
|
||||
import qualified TypeChecker.TypeCheckerIr as T
|
||||
|
||||
-- NOTE: this type checker is poorly tested
|
||||
|
||||
|
|
@ -1,8 +1,8 @@
|
|||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module TypeCheckerIr
|
||||
module TypeChecker.TypeCheckerIr
|
||||
( module Grammar.Abs
|
||||
, module TypeCheckerIr
|
||||
, module TypeChecker.TypeCheckerIr
|
||||
) where
|
||||
|
||||
import Grammar.Abs (Ident (..), Type (..))
|
||||
Loading…
Add table
Add a link
Reference in a new issue