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

Fixed argumentless constructors being treated as variables.

Browse source
This commit is contained in:
Samuel Hammersberg 2023-03-28 13:50:19 +02:00
parent d7549d421c
commit 2aff7a7743
3 changed files with 56 additions and 67 deletions
Download patch file Download diff file Expand all files Collapse all files

12
src/Codegen/Codegen.hs
View file

@ -14,8 +14,6 @@ import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromJust, fromMaybe)
import Data.Tuple.Extra (dupe, first, second)
import Debug.Trace (trace)
import qualified Grammar.Abs as GA
import Grammar.ErrM (Err)
import Monomorphizer.MonomorphizerIr as MIR
import qualified TypeChecker.TypeCheckerIr as TIR
@ -376,7 +374,7 @@ emitECased t e cases = do
emit $ SetVariable (fst x) (ExtractValue (CustomType (coerce consId)) (VIdent casted Ptr) i)
PLit (l, t) -> undefined
PInj id ps -> undefined
PCatch -> undefined
PCatch -> pure()
PEnum id -> undefined
--case c of
-- CIdent x -> do
@ -513,7 +511,13 @@ exprToValue = \case
(MIR.LChar i) -> VChar i
(MIR.EVar name, t) -> do
funcs <- gets functions
case Map.lookup (name, t) funcs of
cons <- gets constructors
let res = Map.lookup (name, t) funcs
<|>
(\c -> FunctionInfo { numArgs = numArgsCI c
, arguments = argumentsCI c} )
<$> Map.lookup name cons
case res of
Just fi -> do
if numArgs fi == 0
then do

75
src/Main.hs
View file

@ -2,44 +2,35 @@
module Main where
import Control.Monad (when)
import Data.Bool (bool)
import Data.List.Extra (isSuffixOf)
import Data.Maybe (fromJust, isNothing)
import GHC.IO.Handle.Text (hPutStrLn)
import System.Console.GetOpt (
ArgDescr (NoArg, ReqArg),
ArgOrder (RequireOrder),
OptDescr (Option),
getOpt,
usageInfo,
)
import System.Directory (
createDirectory,
doesPathExist,
getDirectoryContents,
removeDirectoryRecursive,
setCurrentDirectory,
)
import System.Environment (getArgs)
import System.Exit (
ExitCode (ExitFailure),
exitFailure,
exitSuccess,
exitWith,
)
import System.IO (stderr)
import Control.Monad (when)
import Data.Bool (bool)
import Data.List.Extra (isSuffixOf)
import Data.Maybe (fromJust, isNothing)
import GHC.IO.Handle.Text (hPutStrLn)
import System.Console.GetOpt (ArgDescr (NoArg, ReqArg),
ArgOrder (RequireOrder),
OptDescr (Option), getOpt,
usageInfo)
import System.Directory (createDirectory, doesPathExist,
getDirectoryContents,
removeDirectoryRecursive,
setCurrentDirectory)
import System.Environment (getArgs)
import System.Exit (ExitCode (ExitFailure),
exitFailure, exitSuccess,
exitWith)
import System.IO (stderr)
import Codegen.Codegen (generateCode)
import Compiler (compile)
import Grammar.ErrM (Err)
import Grammar.Par (myLexer, pProgram)
import Grammar.Print (printTree)
import LambdaLifter (lambdaLift)
import Monomorphizer.Monomorphizer (monomorphize)
import Renamer.Renamer (rename)
import System.Process (spawnCommand, waitForProcess)
import TypeChecker.TypeChecker (TypeChecker (Bi, Hm), typecheck)
import Codegen.Codegen (generateCode)
import Compiler (compile)
import Grammar.ErrM (Err)
import Grammar.Par (myLexer, pProgram)
import Grammar.Print (printTree)
import LambdaLifter (lambdaLift)
import Monomorphizer.Monomorphizer (monomorphize)
import Renamer.Renamer (rename)
import System.Process (spawnCommand, waitForProcess)
import TypeChecker.TypeChecker (TypeChecker (Bi, Hm), typecheck)
main :: IO ()
main = getArgs >>= parseArgs >>= uncurry main'
@ -86,11 +77,11 @@ chooseTypechecker s options = options{typechecker = tc}
tc = case s of
"hm" -> pure Hm
"bi" -> pure Bi
_ -> Nothing
_ -> Nothing
data Options = Options
{ help :: Bool
, debug :: Bool
{ help :: Bool
, debug :: Bool
, typechecker :: Maybe TypeChecker
}
@ -111,8 +102,8 @@ main' opts s = do
bool (printToErr $ printTree typechecked) (printToErr $ show typechecked) opts.debug
printToErr "\n-- Lambda Lifter --"
let lifted = lambdaLift typechecked
printToErr $ printTree lifted
--let lifted = lambdaLift typechecked
--printToErr $ printTree lifted
-- printToErr "\n-- Lambda Lifter --"
-- let lifted = lambdaLift typechecked

36
test_program.crf
View file

@ -1,26 +1,20 @@
data Maybe () where {
Nothing : Maybe ()
Just : Int -> Maybe ()
data List () where {
Nil : List ()
Cons : Int -> List () -> List ()
};
-- fmap : (Int -> Int) -> Maybe () -> Maybe () ;
-- fmap f ma = case ma of {
-- Nothing => Nothing ;
-- Just a => Just (f a) ;
-- };
main = case (Just 10) of {
Just a => a ;
Nothing => 1 ;
main = case Nil of {
Nil => 0 ;
Cons a _ => a ;
};
-- pure : Int -> Maybe () ;
-- pure x = Just x ;
--
-- return = pure;
--
-- bind : Maybe () -> (Int -> Maybe ()) -> Maybe () ;
-- bind ma f = case ma of {
-- Nothing => Nothing ;
-- Just a => f a ;
-- length : List () -> Int ;
-- length xs = case xs of {
-- Nil => 0;
-- Cons _ xs => 1 + length xs ;
-- };
--sum xs = case xs of {
-- Nil => 0 ;
-- Cons a xs => a + main xs ;
--};