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;
posMul a b = a + b; {
-
case b of {
0 => 0;
_ => a + posMul a(b - 1)
}; -
}
add : Int -> Int -> Int ;
add x y = x + y;
main : Int ;
main = add 4 6 ;

55
src/Main.hs
View file

@ -2,30 +2,27 @@
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 Monomorphizer.Monomorphizer (monomorphize)
import Monomorphizer.Monomorphizer (monomorphize)
import Control.Monad (when)
import Data.List.Extra (isSuffixOf)
import Control.Monad (when)
import Data.List.Extra (isSuffixOf)
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)
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 =
@ -50,18 +47,18 @@ main' debug s = do
typechecked <- fromTypeCheckerErr $ typecheck renamed
printToErr $ printTree typechecked
-- printToErr "\n-- Lambda Lifter --"
printToErr "\n-- Lambda Lifter --"
-- let lifted = lambdaLift typechecked
-- printToErr $ printTree lifted
--
-- printToErr "\n -- Printing compiler output to stdout --"
-- compiled <- fromCompilerErr $ generateCode (monomorphize typechecked)
-- putStrLn compiled
printToErr "\n -- Printing compiler output to stdout --"
compiled <- fromCompilerErr $ generateCode (monomorphize typechecked)
putStrLn compiled
-- check <- doesPathExist "output"
-- when check (removeDirectoryRecursive "output")
-- createDirectory "output"
-- writeFile "output/llvm.ll" compiled
check <- doesPathExist "output"
when check (removeDirectoryRecursive "output")
createDirectory "output"
writeFile "output/llvm.ll" compiled
-- if debug then debugDotViz else putStrLn compiled
-- 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.TEVar _v) = error "I DONT KNOW WHAT THIS IS"
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.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
import Grammar.Abs (Ident (..), Init (..), UIdent)
import qualified Grammar.Abs as GA (Ident (..), Init (..))
import Grammar.Abs (Ident (..), UIdent)
import qualified Grammar.Abs as GA (Ident (..))
import qualified TypeChecker.TypeCheckerIr as RE
type Id = (Ident, Type)