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

Fixed simple pattern matching.

Browse source
This commit is contained in:
Samuel Hammersberg 2023-03-27 13:40:18 +02:00
parent 582747a997
commit bd3cf3c3f1
4 changed files with 17 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Justfile
View file

@ -15,4 +15,4 @@ test:
# compile a specific file # compile a specific file
run FILE: run FILE:
cabal run language {{FILE}} cabal run language -- -d {{FILE}}

9
src/Codegen/Codegen.hs
View file

@ -300,8 +300,10 @@ defaultStart :: [LLVMIr]
defaultStart = defaultStart =
[ UnsafeRaw "target triple = \"x86_64-pc-linux-gnu\"\n" [ UnsafeRaw "target triple = \"x86_64-pc-linux-gnu\"\n"
, UnsafeRaw "target datalayout = \"e-m:o-i64:64-f80:128-n8:16:32:64-S128\"\n" , UnsafeRaw "target datalayout = \"e-m:o-i64:64-f80:128-n8:16:32:64-S128\"\n"
, UnsafeRaw "@.str = private unnamed_addr constant [3 x i8] c\"%x\n\", align 1\n" , UnsafeRaw "@.str = private unnamed_addr constant [3 x i8] c\"%i\n\", align 1\n"
, UnsafeRaw "@.non_exhaustive_patterns = private unnamed_addr constant [41 x i8] c\"Non-exhaustive patterns in case at %i:%i\n\""
, UnsafeRaw "declare i32 @printf(ptr noalias nocapture, ...)\n" , UnsafeRaw "declare i32 @printf(ptr noalias nocapture, ...)\n"
, UnsafeRaw "declare i32 @exit(i32)\n"
] ]
compileExp :: ExpT -> CompilerState () compileExp :: ExpT -> CompilerState ()
@ -330,6 +332,11 @@ emitECased t e cases = do
stackPtr <- getNewVar stackPtr <- getNewVar
emit $ SetVariable stackPtr (Alloca ty) emit $ SetVariable stackPtr (Alloca ty)
mapM_ (emitCases rt ty label stackPtr vs) cs mapM_ (emitCases rt ty label stackPtr vs) cs
emit . UnsafeRaw $ "call i32 (ptr, ...) @printf(ptr noundef @.non_exhaustive_patterns, i64 noundef 6, i64 noundef 6)\n"
emit . UnsafeRaw $ "call i32 @exit(i32 1)\n"
emit . UnsafeRaw $ "unreachable\n"
increaseVarCount >> increaseVarCount >> increaseVarCount
emit $ Br label
emit $ Label label emit $ Label label
res <- getNewVar res <- getNewVar
emit $ SetVariable res (Load ty Ptr stackPtr) emit $ SetVariable res (Load ty Ptr stackPtr)

12
src/Monomorphizer/MonomorphizerIr.hs
View file

@ -1,8 +1,7 @@
module Monomorphizer.MonomorphizerIr (module Monomorphizer.MonomorphizerIr, module RE, module GA) where module Monomorphizer.MonomorphizerIr (module Monomorphizer.MonomorphizerIr, module GA) where
import Grammar.Abs (Ident (..), UIdent) import Grammar.Abs (Ident (..))
import Grammar.Abs qualified as GA (Ident (..)) import qualified Grammar.Abs as GA (Ident (..))
import TypeChecker.TypeCheckerIr qualified as RE
type Id = (Ident, Type) type Id = (Ident, Type)
@ -27,7 +26,8 @@ data Exp
| ECase ExpT [Branch] | ECase ExpT [Branch]
deriving (Show, Ord, Eq) deriving (Show, Ord, Eq)
data Pattern = PVar Id | PLit (Lit, Type) | PInj Ident [Pattern] | PCatch | PEnum Ident data Pattern = PVar Id | PLit (Lit, Type) | PInj Ident [Pattern]
| PCatch | PEnum Ident
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
data Branch = Branch (Pattern, Type) ExpT data Branch = Branch (Pattern, Type) ExpT
@ -48,4 +48,4 @@ data Type = TLit Ident | TFun Type Type
flattenType :: Type -> [Type] flattenType :: Type -> [Type]
flattenType (TFun t1 t2) = t1 : flattenType t2 flattenType (TFun t1 t2) = t1 : flattenType t2
flattenType x = [x] flattenType x = [x]

5
test_program.crf
View file

@ -1,7 +1,7 @@
data Maybe () where { data Maybe () where {
Nothing : Maybe () Nothing : Maybe ()
Just : Int -> Maybe () Just : Int -> Maybe ()
}; };
-- fmap : (Int -> Int) -> Maybe () -> Maybe () ; -- fmap : (Int -> Int) -> Maybe () -> Maybe () ;
-- fmap f ma = case ma of { -- fmap f ma = case ma of {
@ -9,10 +9,9 @@ data Maybe () where {
-- Just a => Just (f a) ; -- Just a => Just (f a) ;
-- }; -- };
main = case (Just 5) of { main = case (Just 10) of {
Just a => a ; Just a => a ;
Nothing => 1 ; Nothing => 1 ;
_ => 66 ;
}; };
-- pure : Int -> Maybe () ; -- pure : Int -> Maybe () ;