From d5dd7896d8ea1f948a54f2add15d438824508fbd Mon Sep 17 00:00:00 2001 From: Samuel Hammersberg Date: Wed, 8 Mar 2023 10:35:07 +0100 Subject: [PATCH] Moved modules into a proper folder structure. --- language.cabal | 8 +- src/Codegen/Codegen.hs | 33 +++---- src/Codegen/LlvmIr.hs | 4 +- src/Interpreter.hs | 116 ------------------------- src/{ => LambdaLifter}/LambdaLifter.hs | 23 ++--- src/Main.hs | 36 ++++---- src/{ => Renamer}/Renamer.hs | 2 +- src/{ => TypeChecker}/TypeChecker.hs | 20 ++--- src/{ => TypeChecker}/TypeCheckerIr.hs | 4 +- 9 files changed, 66 insertions(+), 180 deletions(-) delete mode 100644 src/Interpreter.hs rename src/{ => LambdaLifter}/LambdaLifter.hs (91%) rename src/{ => Renamer}/Renamer.hs (98%) rename src/{ => TypeChecker}/TypeChecker.hs (91%) rename src/{ => TypeChecker}/TypeCheckerIr.hs (98%) diff --git a/language.cabal b/language.cabal index 6a89860..e190a7e 100644 --- a/language.cabal +++ b/language.cabal @@ -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 diff --git a/src/Codegen/Codegen.hs b/src/Codegen/Codegen.hs index ffa1af5..174d0b1 100644 --- a/src/Codegen/Codegen.hs +++ b/src/Codegen/Codegen.hs @@ -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] diff --git a/src/Codegen/LlvmIr.hs b/src/Codegen/LlvmIr.hs index e412273..08cd69d 100644 --- a/src/Codegen/LlvmIr.hs +++ b/src/Codegen/LlvmIr.hs @@ -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 diff --git a/src/Interpreter.hs b/src/Interpreter.hs deleted file mode 100644 index 37d46a7..0000000 --- a/src/Interpreter.hs +++ /dev/null @@ -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 } diff --git a/src/LambdaLifter.hs b/src/LambdaLifter/LambdaLifter.hs similarity index 91% rename from src/LambdaLifter.hs rename to src/LambdaLifter/LambdaLifter.hs index 6522bba..661b95a 100644 --- a/src/LambdaLifter.hs +++ b/src/LambdaLifter/LambdaLifter.hs @@ -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. diff --git a/src/Main.hs b/src/Main.hs index e3a924a..7390341 100644 --- a/src/Main.hs +++ b/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 = diff --git a/src/Renamer.hs b/src/Renamer/Renamer.hs similarity index 98% rename from src/Renamer.hs rename to src/Renamer/Renamer.hs index a91615b..3c426b4 100644 --- a/src/Renamer.hs +++ b/src/Renamer/Renamer.hs @@ -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) diff --git a/src/TypeChecker.hs b/src/TypeChecker/TypeChecker.hs similarity index 91% rename from src/TypeChecker.hs rename to src/TypeChecker/TypeChecker.hs index bb31a2f..3d6bba8 100644 --- a/src/TypeChecker.hs +++ b/src/TypeChecker/TypeChecker.hs @@ -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 diff --git a/src/TypeCheckerIr.hs b/src/TypeChecker/TypeCheckerIr.hs similarity index 98% rename from src/TypeCheckerIr.hs rename to src/TypeChecker/TypeCheckerIr.hs index 8053bd1..7dfe3be 100644 --- a/src/TypeCheckerIr.hs +++ b/src/TypeChecker/TypeCheckerIr.hs @@ -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 (..))