Rakarake/churf
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Updated the monomorphizer to the new tree.

Browse source
This commit is contained in:
Samuel Hammersberg 2023-03-24 17:13:56 +01:00
parent 3c2cb1a713
commit b1209b3353
4 changed files with 34 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

13
sample-programs/basic-1
View file

@ -1,8 +1,5 @@
posMul: _Int - > _Int - > _Int; add : Int -> Int -> Int ;
posMul a b = a + b; { add x y = x + y;
-
case b of { main : Int ;
0 => 0; main = add 4 6 ;
_ => a + posMul a(b - 1)
}; -
}

55
src/Main.hs
View file

@ -2,30 +2,27 @@
module Main where module Main where
-- import Codegen.Codegen (generateCode) import Codegen.Codegen (generateCode)
import GHC.IO.Handle.Text (hPutStrLn) import GHC.IO.Handle.Text (hPutStrLn)
import Grammar.ErrM (Err) import Grammar.ErrM (Err)
import Grammar.Par (myLexer, pProgram) import Grammar.Par (myLexer, pProgram)
import Grammar.Print (printTree) import Grammar.Print (printTree)
-- import Monomorphizer.Monomorphizer (monomorphize) import Monomorphizer.Monomorphizer (monomorphize)
import Control.Monad (when) import Control.Monad (when)
import Data.List.Extra (isSuffixOf) import Data.List.Extra (isSuffixOf)
import Renamer.Renamer (rename) import Renamer.Renamer (rename)
import System.Directory ( import System.Directory (createDirectory, doesPathExist,
createDirectory, getDirectoryContents,
doesPathExist, removeDirectoryRecursive,
getDirectoryContents, setCurrentDirectory)
removeDirectoryRecursive, import System.Environment (getArgs)
setCurrentDirectory, import System.Exit (exitFailure, exitSuccess)
) import System.IO (stderr)
import System.Environment (getArgs) import System.Process.Extra (spawnCommand, waitForProcess)
import System.Exit (exitFailure, exitSuccess) import TypeChecker.TypeChecker (typecheck)
import System.IO (stderr)
import System.Process.Extra (spawnCommand, waitForProcess)
import TypeChecker.TypeChecker (typecheck)
main :: IO () main :: IO ()
main = main =
@ -50,18 +47,18 @@ main' debug s = do
typechecked <- fromTypeCheckerErr $ typecheck renamed typechecked <- fromTypeCheckerErr $ typecheck renamed
printToErr $ printTree typechecked printToErr $ printTree typechecked
-- printToErr "\n-- Lambda Lifter --" printToErr "\n-- Lambda Lifter --"
-- let lifted = lambdaLift typechecked -- let lifted = lambdaLift typechecked
-- printToErr $ printTree lifted -- printToErr $ printTree lifted
-- --
-- printToErr "\n -- Printing compiler output to stdout --" printToErr "\n -- Printing compiler output to stdout --"
-- compiled <- fromCompilerErr $ generateCode (monomorphize typechecked) compiled <- fromCompilerErr $ generateCode (monomorphize typechecked)
-- putStrLn compiled putStrLn compiled
-- check <- doesPathExist "output" check <- doesPathExist "output"
-- when check (removeDirectoryRecursive "output") when check (removeDirectoryRecursive "output")
-- createDirectory "output" createDirectory "output"
-- writeFile "output/llvm.ll" compiled writeFile "output/llvm.ll" compiled
-- if debug then debugDotViz else putStrLn compiled -- if debug then debugDotViz else putStrLn compiled
-- interpred <- fromInterpreterErr $ interpret lifted -- interpred <- fromInterpreterErr $ interpret lifted

2
src/Monomorphizer/Monomorphizer.hs
View file

@ -39,7 +39,7 @@ monoAbsType (GA.TVar _v) = error "NOT POLYMORHPIC TYPES"
monoAbsType (GA.TAll _v _t) = error "NOT ALL TYPES" monoAbsType (GA.TAll _v _t) = error "NOT ALL TYPES"
monoAbsType (GA.TEVar _v) = error "I DONT KNOW WHAT THIS IS" monoAbsType (GA.TEVar _v) = error "I DONT KNOW WHAT THIS IS"
monoAbsType (GA.TFun t1 t2) = M.TFun (monoAbsType t1) (monoAbsType t2) monoAbsType (GA.TFun t1 t2) = M.TFun (monoAbsType t1) (monoAbsType t2)
monoAbsType (GA.TIndexed _) = error "NOT INDEXED TYPES" monoAbsType (GA.TData _ _) = error "NOT INDEXED TYPES"
monoType :: T.Type -> M.Type monoType :: T.Type -> M.Type
monoType (T.TAll _ t) = monoType t monoType (T.TAll _ t) = monoType t

4
src/Monomorphizer/MonomorphizerIr.hs
View file

@ -1,7 +1,7 @@
module Monomorphizer.MonomorphizerIr (module Monomorphizer.MonomorphizerIr, module RE, module GA) where module Monomorphizer.MonomorphizerIr (module Monomorphizer.MonomorphizerIr, module RE, module GA) where
import Grammar.Abs (Ident (..), Init (..), UIdent) import Grammar.Abs (Ident (..), UIdent)
import qualified Grammar.Abs as GA (Ident (..), Init (..)) import qualified Grammar.Abs as GA (Ident (..))
import qualified TypeChecker.TypeCheckerIr as RE import qualified TypeChecker.TypeCheckerIr as RE
type Id = (Ident, Type) type Id = (Ident, Type)