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

9
src/Codegen/Codegen.hs
View file

@ -300,8 +300,10 @@ defaultStart :: [LLVMIr]
defaultStart =
[ 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 "@.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 @exit(i32)\n"
]
compileExp :: ExpT -> CompilerState ()
@ -330,6 +332,11 @@ emitECased t e cases = do
stackPtr <- getNewVar
emit $ SetVariable stackPtr (Alloca ty)
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
res <- getNewVar
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 qualified as GA (Ident (..))
import TypeChecker.TypeCheckerIr qualified as RE
import Grammar.Abs (Ident (..))
import qualified Grammar.Abs as GA (Ident (..))
type Id = (Ident, Type)
@ -27,7 +26,8 @@ data Exp
| ECase ExpT [Branch]
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)
data Branch = Branch (Pattern, Type) ExpT
@ -48,4 +48,4 @@ data Type = TLit Ident | TFun Type Type
flattenType :: Type -> [Type]
flattenType (TFun t1 t2) = t1 : flattenType t2
flattenType x = [x]
flattenType x = [x]