git.iko.soy/Idris-dev
on master help sign in
Merge branch 'simd' of https://github.com/Ralith/Idris-dev into JavaRepairs
1e84e48Jan Bessai
idris.cabal+2−1
compare with master
unifiedsplit
@@ -272,7 +272,8 @@ Executable idris
272 haskeline>=0.7, split, directory,
272 haskeline>=0.7, split, directory,
273 containers, process, transformers, filepath,
273 containers, process, transformers, filepath,
274 directory, binary, bytestring, text, pretty,
274 directory, binary, bytestring, text, pretty,
275− language-java>=0.2.2, libffi, llvm-general==3.3.3.*
275+ language-java>=0.2.2, libffi, llvm-general==3.3.3.*,
276+ vector, vector-binary-instances
276
277
277 Extensions: MultiParamTypeClasses, FunctionalDependencies,
278 Extensions: MultiParamTypeClasses, FunctionalDependencies,
278 FlexibleInstances, TemplateHaskell
279 FlexibleInstances, TemplateHaskell
src/IRTS/CodegenLLVM.hs+124−82
@@ -5,6 +5,7 @@ import IRTS.CodegenCommon
5import IRTS.Lang
5import IRTS.Lang
6import IRTS.Simplified
6import IRTS.Simplified
7import qualified Core.TT as TT
7import qualified Core.TT as TT
8+import Core.TT (ArithTy(..), IntTy(..), NativeTy(..), nativeTyWidth)
8
9
9import Util.System
10import Util.System
10import Paths_idris
11import Paths_idris
@@ -35,6 +36,7 @@ import Data.Word
35import Data.Set (Set)
36import Data.Set (Set)
36import qualified Data.Set as S
37import qualified Data.Set as S
37import qualified Data.Map as M
38import qualified Data.Map as M
39+import qualified Data.Vector.Unboxed as V
38import Control.Applicative
40import Control.Applicative
39import Control.Monad.RWS
41import Control.Monad.RWS
40import Control.Monad.Writer
42import Control.Monad.Writer
@@ -80,12 +82,8 @@ codegenLLVM defs triple cpu optimize file outty = withContext $ \context -> do
80failInIO :: ErrorT String IO a -> IO a
82failInIO :: ErrorT String IO a -> IO a
81failInIO = either fail return <=< runErrorT
83failInIO = either fail return <=< runErrorT
82
84
83−itWidth :: IntTy -> Word32
84−itWidth ITNative = 32
85−itWidth x = fromIntegral $ intTyWidth x
86−
87outputModule :: TargetMachine -> FilePath -> OutputType -> M.Module -> IO ()
85outputModule :: TargetMachine -> FilePath -> OutputType -> M.Module -> IO ()
88−outputModule _ file Raw m = failInIO $ M.writeBitcodeToFile file m
86+outputModule _ file Raw m = failInIO $ M.writeBitcodeToFile file m
89outputModule tm file Object m = failInIO $ M.writeObjectToFile tm file m
87outputModule tm file Object m = failInIO $ M.writeObjectToFile tm file m
90outputModule tm file Executable m = withTmpFile $ \obj -> do
88outputModule tm file Executable m = withTmpFile $ \obj -> do
91 outputModule tm obj Object m
89 outputModule tm obj Object m
@@ -586,7 +584,7 @@ cgChainCase :: Operand -> Maybe SExp -> [SAlt] -> Codegen (Maybe Operand)
586cgChainCase caseValPtr defExp alts = do
584cgChainCase caseValPtr defExp alts = do
587 let (caseTy, comparator) =
585 let (caseTy, comparator) =
588 case head alts of
586 case head alts of
589− SConstCase (TT.BI _) _ -> (FInt ITBig, "__gmpz_cmp")
587+ SConstCase (TT.BI _) _ -> (FArith (ATInt ITBig), "__gmpz_cmp")
590 SConstCase (TT.Str _) _ -> (FString, "strcmp")
588 SConstCase (TT.Str _) _ -> (FString, "strcmp")
591 caseVal <- unbox caseTy caseValPtr
589 caseVal <- unbox caseTy caseValPtr
592 defBlockName <- getName "default"
590 defBlockName <- getName "default"
@@ -712,6 +710,11 @@ cgConst' (TT.B8 i) = C.Int 8 (fromIntegral i)
712cgConst' (TT.B16 i) = C.Int 16 (fromIntegral i)
710cgConst' (TT.B16 i) = C.Int 16 (fromIntegral i)
713cgConst' (TT.B32 i) = C.Int 32 (fromIntegral i)
711cgConst' (TT.B32 i) = C.Int 32 (fromIntegral i)
714cgConst' (TT.B64 i) = C.Int 64 (fromIntegral i)
712cgConst' (TT.B64 i) = C.Int 64 (fromIntegral i)
713+cgConst' (TT.B8V v) = C.Vector (map ((C.Int 8) . fromIntegral) . V.toList $ v)
714+cgConst' (TT.B16V v) = C.Vector (map ((C.Int 16) . fromIntegral) . V.toList $ v)
715+cgConst' (TT.B32V v) = C.Vector (map ((C.Int 32) . fromIntegral) . V.toList $ v)
716+cgConst' (TT.B64V v) = C.Vector (map ((C.Int 64) . fromIntegral) . V.toList $ v)
717+
715cgConst' (TT.BI i) = C.Array (IntegerType 8) (map (C.Int 8 . fromIntegral . fromEnum) (show i) ++ [C.Int 8 0])
718cgConst' (TT.BI i) = C.Array (IntegerType 8) (map (C.Int 8 . fromIntegral . fromEnum) (show i) ++ [C.Int 8 0])
716cgConst' (TT.Fl f) = C.Float (F.Double f)
719cgConst' (TT.Fl f) = C.Float (F.Double f)
717cgConst' (TT.Ch c) = C.Int 32 . fromIntegral . fromEnum $ c
720cgConst' (TT.Ch c) = C.Int 32 . fromIntegral . fromEnum $ c
@@ -719,12 +722,16 @@ cgConst' (TT.Str s) = C.Array (IntegerType 8) (map (C.Int 8 . fromIntegral . fro
719cgConst' x = ierror $ "Unsupported constant: " ++ show x
722cgConst' x = ierror $ "Unsupported constant: " ++ show x
720
723
721cgConst :: TT.Const -> Codegen Operand
724cgConst :: TT.Const -> Codegen Operand
722−cgConst c@(TT.I _) = box (FInt ITNative) (ConstantOperand $ cgConst' c)
725+cgConst c@(TT.I _) = box (FArith (ATInt ITNative)) (ConstantOperand $ cgConst' c)
723−cgConst c@(TT.B8 _) = box (FInt IT8) (ConstantOperand $ cgConst' c)
726+cgConst c@(TT.B8 _) = box (FArith (ATInt (ITFixed IT8))) (ConstantOperand $ cgConst' c)
724−cgConst c@(TT.B16 _) = box (FInt IT16) (ConstantOperand $ cgConst' c)
727+cgConst c@(TT.B16 _) = box (FArith (ATInt (ITFixed IT16))) (ConstantOperand $ cgConst' c)
725−cgConst c@(TT.B32 _) = box (FInt IT32) (ConstantOperand $ cgConst' c)
728+cgConst c@(TT.B32 _) = box (FArith (ATInt (ITFixed IT32))) (ConstantOperand $ cgConst' c)
729+cgConst c@(TT.B64 _) = box (FArith (ATInt (ITFixed IT64))) (ConstantOperand $ cgConst' c)
730+cgConst c@(TT.B8V v) = box (FArith (ATInt (ITVec IT8 (V.length v)))) (ConstantOperand $ cgConst' c)
731+cgConst c@(TT.B16V v) = box (FArith (ATInt (ITVec IT16 (V.length v)))) (ConstantOperand $ cgConst' c)
732+cgConst c@(TT.B32V v) = box (FArith (ATInt (ITVec IT32 (V.length v)))) (ConstantOperand $ cgConst' c)
726−cgConst c@(TT.B64 _) = box (FInt IT64) (ConstantOperand $ cgConst' c)
733+cgConst c@(TT.B64V v) = box (FArith (ATInt (ITVec IT64 (V.length v)))) (ConstantOperand $ cgConst' c)
727−cgConst c@(TT.Fl _) = box FDouble (ConstantOperand $ cgConst' c)
734+cgConst c@(TT.Fl _) = box (FArith ATFloat) (ConstantOperand $ cgConst' c)
728cgConst c@(TT.Ch _) = box FChar (ConstantOperand $ cgConst' c)
735cgConst c@(TT.Ch _) = box FChar (ConstantOperand $ cgConst' c)
729cgConst c@(TT.Str s) = do
736cgConst c@(TT.Str s) = do
730 str <- addGlobal' (ArrayType (1 + fromIntegral (length s)) (IntegerType 8)) (cgConst' c)
737 str <- addGlobal' (ArrayType (1 + fromIntegral (length s)) (IntegerType 8)) (cgConst' c)
@@ -736,7 +743,7 @@ cgConst c@(TT.BI i) = do
736 , ConstantOperand $ C.GetElementPtr True str [ C.Int 32 0, C.Int 32 0]
743 , ConstantOperand $ C.GetElementPtr True str [ C.Int 32 0, C.Int 32 0]
737 , ConstantOperand $ C.Int 32 10
744 , ConstantOperand $ C.Int 32 10
738 ]
745 ]
739− box (FInt ITBig) mpz
746+ box (FArith (ATInt ITBig)) mpz
740cgConst x = return $ ConstantOperand nullValue
747cgConst x = return $ ConstantOperand nullValue
741
748
742numDigits :: Integer -> Integer -> Integer
749numDigits :: Integer -> Integer -> Integer
@@ -782,72 +789,82 @@ ffunDecl name rty argtys =
782 }
789 }
783
790
784ftyToTy :: FType -> Type
791ftyToTy :: FType -> Type
785−ftyToTy (FInt ITNative) = IntegerType 32
792+ftyToTy (FArith (ATInt ITNative)) = IntegerType 32
786−ftyToTy (FInt ITBig) = PointerType mpzTy (AddrSpace 0)
793+ftyToTy (FArith (ATInt ITBig)) = PointerType mpzTy (AddrSpace 0)
787−ftyToTy (FInt ty) = IntegerType (itWidth ty)
794+ftyToTy (FArith (ATInt (ITFixed ty))) = IntegerType (fromIntegral $ nativeTyWidth ty)
795+ftyToTy (FArith (ATInt (ITVec e c)))
796+ = VectorType (fromIntegral c) (IntegerType (fromIntegral $ nativeTyWidth e))
788ftyToTy FChar = IntegerType 32
797ftyToTy FChar = IntegerType 32
789ftyToTy FString = PointerType (IntegerType 8) (AddrSpace 0)
798ftyToTy FString = PointerType (IntegerType 8) (AddrSpace 0)
790ftyToTy FUnit = VoidType
799ftyToTy FUnit = VoidType
791ftyToTy FPtr = PointerType (IntegerType 8) (AddrSpace 0)
800ftyToTy FPtr = PointerType (IntegerType 8) (AddrSpace 0)
792−ftyToTy FDouble = FloatingPointType 64 IEEE
801+ftyToTy (FArith ATFloat) = FloatingPointType 64 IEEE
793ftyToTy FAny = valueType
802ftyToTy FAny = valueType
794
803
804+-- Only use when known not to be ITBig
805+itWidth :: IntTy -> Word32
806+itWidth ITNative = 32
807+itWidth (ITFixed x) = fromIntegral $ nativeTyWidth x
808+
795cgOp :: PrimFn -> [Operand] -> Codegen Operand
809cgOp :: PrimFn -> [Operand] -> Codegen Operand
796cgOp (LTrunc ITBig ity) [x] = do
810cgOp (LTrunc ITBig ity) [x] = do
797− nx <- unbox (FInt ITBig) x
811+ nx <- unbox (FArith (ATInt ITBig)) x
798 val <- inst $ simpleCall "mpz_get_ull" [nx]
812 val <- inst $ simpleCall "mpz_get_ull" [nx]
799 v <- case ity of
813 v <- case ity of
800− IT64 -> return val
814+ (ITFixed IT64) -> return val
801− _ -> inst $ Trunc val (IntegerType $ itWidth ity) []
815+ _ -> inst $ Trunc val (ftyToTy (FArith (ATInt ity))) []
802− box (FInt ity) v
816+ box (FArith (ATInt ity)) v
803cgOp (LZExt from ITBig) [x] = do
817cgOp (LZExt from ITBig) [x] = do
804− nx <- unbox (FInt from) x
818+ nx <- unbox (FArith (ATInt from)) x
805 nx' <- case from of
819 nx' <- case from of
806− IT64 -> return nx
820+ (ITFixed IT64) -> return nx
807 _ -> inst $ ZExt nx (IntegerType 64) []
821 _ -> inst $ ZExt nx (IntegerType 64) []
808 mpz <- alloc mpzTy
822 mpz <- alloc mpzTy
809 inst' $ simpleCall "mpz_init_set_ull" [mpz, nx']
823 inst' $ simpleCall "mpz_init_set_ull" [mpz, nx']
810− box (FInt ITBig) mpz
824+ box (FArith (ATInt ITBig)) mpz
811cgOp (LSExt from ITBig) [x] = do
825cgOp (LSExt from ITBig) [x] = do
812− nx <- unbox (FInt from) x
826+ nx <- unbox (FArith (ATInt from)) x
813 nx' <- case from of
827 nx' <- case from of
814− IT64 -> return nx
828+ (ITFixed IT64) -> return nx
815 _ -> inst $ SExt nx (IntegerType 64) []
829 _ -> inst $ SExt nx (IntegerType 64) []
816 mpz <- alloc mpzTy
830 mpz <- alloc mpzTy
817 inst' $ simpleCall "mpz_init_set_sll" [mpz, nx']
831 inst' $ simpleCall "mpz_init_set_sll" [mpz, nx']
818− box (FInt ITBig) mpz
832+ box (FArith (ATInt ITBig)) mpz
819−
833+
820−cgOp (LLt ITBig) [x,y] = mpzCmp IPred.SLT x y
834+cgOp (LLt (ATInt ITBig)) [x,y] = mpzCmp IPred.SLT x y
821−cgOp (LLe ITBig) [x,y] = mpzCmp IPred.SLE x y
835+cgOp (LLe (ATInt ITBig)) [x,y] = mpzCmp IPred.SLE x y
822−cgOp (LEq ITBig) [x,y] = mpzCmp IPred.EQ x y
836+cgOp (LEq (ATInt ITBig)) [x,y] = mpzCmp IPred.EQ x y
823−cgOp (LGe ITBig) [x,y] = mpzCmp IPred.SGE x y
837+cgOp (LGe (ATInt ITBig)) [x,y] = mpzCmp IPred.SGE x y
824−cgOp (LGt ITBig) [x,y] = mpzCmp IPred.SGT x y
838+cgOp (LGt (ATInt ITBig)) [x,y] = mpzCmp IPred.SGT x y
825−cgOp (LPlus ITBig) [x,y] = mpzBin "add" x y
839+cgOp (LPlus (ATInt ITBig)) [x,y] = mpzBin "add" x y
826−cgOp (LMinus ITBig) [x,y] = mpzBin "sub" x y
840+cgOp (LMinus (ATInt ITBig)) [x,y] = mpzBin "sub" x y
827−cgOp (LTimes ITBig) [x,y] = mpzBin "mul" x y
841+cgOp (LTimes (ATInt ITBig)) [x,y] = mpzBin "mul" x y
828−cgOp (LSDiv ITBig) [x,y] = mpzBin "fdiv_q" x y
842+cgOp (LSDiv (ATInt ITBig)) [x,y] = mpzBin "fdiv_q" x y
829−cgOp (LSRem ITBig) [x,y] = mpzBin "fdiv_r" x y
843+cgOp (LSRem (ATInt ITBig)) [x,y] = mpzBin "fdiv_r" x y
830cgOp (LAnd ITBig) [x,y] = mpzBin "and" x y
844cgOp (LAnd ITBig) [x,y] = mpzBin "and" x y
831cgOp (LOr ITBig) [x,y] = mpzBin "ior" x y
845cgOp (LOr ITBig) [x,y] = mpzBin "ior" x y
832cgOp (LXOr ITBig) [x,y] = mpzBin "xor" x y
846cgOp (LXOr ITBig) [x,y] = mpzBin "xor" x y
833cgOp (LCompl ITBig) [x] = mpzUn "com" x
847cgOp (LCompl ITBig) [x] = mpzUn "com" x
834
848
849+cgOp (LTrunc (ITFixed from) (ITFixed to)) [x]
835−cgOp (LTrunc from to) [x] | itWidth from > itWidth to = iCoerce Trunc from to x
850+ | nativeTyWidth from > nativeTyWidth to = iCoerce Trunc from to x
851+cgOp (LZExt (ITFixed from) (ITFixed to)) [x]
836−cgOp (LZExt from to) [x] | itWidth from < itWidth to = iCoerce ZExt from to x
852+ | nativeTyWidth from < nativeTyWidth to = iCoerce ZExt from to x
853+cgOp (LSExt (ITFixed from) (ITFixed to)) [x]
837−cgOp (LSExt from to) [x] | itWidth from < itWidth to = iCoerce SExt from to x
854+ | nativeTyWidth from < nativeTyWidth to = iCoerce SExt from to x
838−
855+
839−cgOp (LLt ity) [x,y] = iCmp ity IPred.SLT x y
856+cgOp (LLt (ATInt ity)) [x,y] = iCmp ity IPred.SLT x y
840−cgOp (LLe ity) [x,y] = iCmp ity IPred.SLE x y
857+cgOp (LLe (ATInt ity)) [x,y] = iCmp ity IPred.SLE x y
841−cgOp (LEq ity) [x,y] = iCmp ity IPred.EQ x y
858+cgOp (LEq (ATInt ity)) [x,y] = iCmp ity IPred.EQ x y
842−cgOp (LGe ity) [x,y] = iCmp ity IPred.SGE x y
859+cgOp (LGe (ATInt ity)) [x,y] = iCmp ity IPred.SGE x y
843−cgOp (LGt ity) [x,y] = iCmp ity IPred.SGT x y
860+cgOp (LGt (ATInt ity)) [x,y] = iCmp ity IPred.SGT x y
844−cgOp (LPlus ity) [x,y] = ibin ity x y (Add False False)
861+cgOp (LPlus (ATInt ity)) [x,y] = ibin ity x y (Add False False)
845−cgOp (LMinus ity) [x,y] = ibin ity x y (Sub False False)
862+cgOp (LMinus (ATInt ity)) [x,y] = ibin ity x y (Sub False False)
846−cgOp (LTimes ity) [x,y] = ibin ity x y (Mul False False)
863+cgOp (LTimes (ATInt ity)) [x,y] = ibin ity x y (Mul False False)
864+cgOp (LSDiv (ATInt ity)) [x,y] = ibin ity x y (SDiv False)
865+cgOp (LSRem (ATInt ity)) [x,y] = ibin ity x y SRem
847cgOp (LUDiv ity) [x,y] = ibin ity x y (UDiv False)
866cgOp (LUDiv ity) [x,y] = ibin ity x y (UDiv False)
848cgOp (LURem ity) [x,y] = ibin ity x y URem
867cgOp (LURem ity) [x,y] = ibin ity x y URem
849−cgOp (LSDiv ity) [x,y] = ibin ity x y (SDiv False)
850−cgOp (LSRem ity) [x,y] = ibin ity x y SRem
851cgOp (LAnd ity) [x,y] = ibin ity x y And
868cgOp (LAnd ity) [x,y] = ibin ity x y And
852cgOp (LOr ity) [x,y] = ibin ity x y Or
869cgOp (LOr ity) [x,y] = ibin ity x y Or
853cgOp (LXOr ity) [x,y] = ibin ity x y Xor
870cgOp (LXOr ity) [x,y] = ibin ity x y Xor
@@ -858,13 +875,34 @@ cgOp (LASHR ity) [x,y] = ibin ity x y (AShr False)
858
875
859cgOp LNoOp xs = return $ last xs
876cgOp LNoOp xs = return $ last xs
860
877
878+cgOp (LMkVec ety c) xs | c == length xs = do
879+ nxs <- mapM (unbox (FArith (ATInt (ITFixed ety)))) xs
880+ vec <- foldM (\v (e, i) -> inst $ InsertElement v e (ConstantOperand (C.Int 32 i)) [])
881+ (ConstantOperand $ C.Vector (replicate c (C.Undef (IntegerType . fromIntegral $ nativeTyWidth ety))))
882+ (zip nxs [0..])
883+ box (FArith (ATInt (ITVec ety c))) vec
884+
885+cgOp (LIdxVec ety c) [v,i] = do
886+ nv <- unbox (FArith (ATInt (ITVec ety c))) v
887+ ni <- unbox (FArith (ATInt (ITFixed IT32))) i
888+ elt <- inst $ ExtractElement nv ni []
889+ box (FArith (ATInt (ITFixed ety))) elt
890+
891+cgOp (LUpdateVec ety c) [v,i,e] = do
892+ let fty = FArith (ATInt (ITVec ety c))
893+ nv <- unbox fty v
894+ ni <- unbox (FArith (ATInt (ITFixed IT32))) i
895+ ne <- unbox (FArith (ATInt (ITFixed ety))) e
896+ nv' <- inst $ InsertElement nv ne ni []
897+ box fty nv'
898+
861cgOp LStrEq [x,y] = do
899cgOp LStrEq [x,y] = do
862 x' <- unbox FString x
900 x' <- unbox FString x
863 y' <- unbox FString y
901 y' <- unbox FString y
864 cmp <- inst $ simpleCall "strcmp" [x', y']
902 cmp <- inst $ simpleCall "strcmp" [x', y']
865 flag <- inst $ ICmp IPred.EQ cmp (ConstantOperand (C.Int 32 0)) []
903 flag <- inst $ ICmp IPred.EQ cmp (ConstantOperand (C.Int 32 0)) []
866 val <- inst $ ZExt flag (IntegerType 32) []
904 val <- inst $ ZExt flag (IntegerType 32) []
867− box (FInt IT32) val
905+ box (FArith (ATInt (ITFixed IT32))) val
868
906
869cgOp LStrLt [x,y] = do
907cgOp LStrLt [x,y] = do
870 nx <- unbox FString x
908 nx <- unbox FString x
@@ -872,10 +910,10 @@ cgOp LStrLt [x,y] = do
872 cmp <- inst $ simpleCall "strcmp" [nx, ny]
910 cmp <- inst $ simpleCall "strcmp" [nx, ny]
873 flag <- inst $ ICmp IPred.ULT cmp (ConstantOperand (C.Int 32 0)) []
911 flag <- inst $ ICmp IPred.ULT cmp (ConstantOperand (C.Int 32 0)) []
874 val <- inst $ ZExt flag (IntegerType 32) []
912 val <- inst $ ZExt flag (IntegerType 32) []
875− box (FInt IT32) val
913+ box (FArith (ATInt (ITFixed IT32))) val
876
914
877cgOp (LIntStr ITBig) [x] = do
915cgOp (LIntStr ITBig) [x] = do
878− x' <- unbox (FInt ITBig) x
916+ x' <- unbox (FArith (ATInt ITBig)) x
879 ustr <- inst $ simpleCall "__gmpz_get_str"
917 ustr <- inst $ simpleCall "__gmpz_get_str"
880 [ ConstantOperand (C.Null (PointerType (IntegerType 8) (AddrSpace 0)))
918 [ ConstantOperand (C.Null (PointerType (IntegerType 8) (AddrSpace 0)))
881 , ConstantOperand (C.Int 32 10)
919 , ConstantOperand (C.Int 32 10)
@@ -883,7 +921,7 @@ cgOp (LIntStr ITBig) [x] = do
883 ]
921 ]
884 box FString ustr
922 box FString ustr
885cgOp (LIntStr ity) [x] = do
923cgOp (LIntStr ity) [x] = do
886− x' <- unbox (FInt ity) x
924+ x' <- unbox (FArith (ATInt ity)) x
887 x'' <- if itWidth ity < 64
925 x'' <- if itWidth ity < 64
888 then inst $ SExt x' (IntegerType 64) []
926 then inst $ SExt x' (IntegerType 64) []
889 else return x'
927 else return x'
@@ -892,7 +930,7 @@ cgOp (LStrInt ITBig) [s] = do
892 ns <- unbox FString s
930 ns <- unbox FString s
893 mpz <- alloc mpzTy
931 mpz <- alloc mpzTy
894 inst $ simpleCall "__gmpz_init_set_str" [mpz, ns, ConstantOperand $ C.Int 32 10]
932 inst $ simpleCall "__gmpz_init_set_str" [mpz, ns, ConstantOperand $ C.Int 32 10]
895− box (FInt ITBig) mpz
933+ box (FArith (ATInt ITBig)) mpz
896cgOp (LStrInt ity) [s] = do
934cgOp (LStrInt ity) [s] = do
897 ns <- unbox FString s
935 ns <- unbox FString s
898 nx <- inst $ simpleCall "strtoll"
936 nx <- inst $ simpleCall "strtoll"
@@ -901,9 +939,9 @@ cgOp (LStrInt ity) [s] = do
901 , ConstantOperand $ C.Int 32 10
939 , ConstantOperand $ C.Int 32 10
902 ]
940 ]
903 nx' <- case ity of
941 nx' <- case ity of
904− IT64 -> return nx
942+ (ITFixed IT64) -> return nx
905 _ -> inst $ Trunc nx (IntegerType (itWidth ity)) []
943 _ -> inst $ Trunc nx (IntegerType (itWidth ity)) []
906− box (FInt ity) nx'
944+ box (FArith (ATInt ity)) nx'
907
945
908cgOp LStrConcat [x,y] = cgStrCat x y
946cgOp LStrConcat [x,y] = cgStrCat x y
909
947
@@ -922,7 +960,7 @@ cgOp LStrHead [c] = do
922
960
923cgOp LStrIndex [s, i] = do
961cgOp LStrIndex [s, i] = do
924 ns <- unbox FString s
962 ns <- unbox FString s
925− ni <- unbox (FInt IT32) i
963+ ni <- unbox (FArith (ATInt (ITFixed IT32))) i
926 p <- inst $ GetElementPtr True ns [ni] []
964 p <- inst $ GetElementPtr True ns [ni] []
927 c <- inst $ Load False p Nothing 0 []
965 c <- inst $ Load False p Nothing 0 []
928 c' <- inst $ ZExt c (IntegerType 32) []
966 c' <- inst $ ZExt c (IntegerType 32) []
@@ -941,7 +979,7 @@ cgOp LStrLen [s] = do
941 32 -> return len
979 32 -> return len
942 x | x > 32 -> inst $ Trunc len (IntegerType 32) []
980 x | x > 32 -> inst $ Trunc len (IntegerType 32) []
943 | x < 32 -> inst $ ZExt len (IntegerType 32) []
981 | x < 32 -> inst $ ZExt len (IntegerType 32) []
944− box (FInt IT32) len'
982+ box (FArith (ATInt (ITFixed IT32))) len'
945
983
946cgOp LReadStr [p] = do
984cgOp LReadStr [p] = do
947 np <- unbox FPtr p
985 np <- unbox FPtr p
@@ -964,11 +1002,11 @@ cgOp LStdErr [] = do
964cgOp prim args = ierror $ "Unimplemented primitive: [" ++ show prim ++ "]("
1002cgOp prim args = ierror $ "Unimplemented primitive: [" ++ show prim ++ "]("
965 ++ intersperse ',' (take (length args) ['a'..]) ++ ")"
1003 ++ intersperse ',' (take (length args) ['a'..]) ++ ")"
966
1004
967−iCoerce :: (Operand -> Type -> InstructionMetadata -> Instruction) -> IntTy -> IntTy -> Operand -> Codegen Operand
1005+iCoerce :: (Operand -> Type -> InstructionMetadata -> Instruction) -> NativeTy -> NativeTy -> Operand -> Codegen Operand
968iCoerce operator from to x = do
1006iCoerce operator from to x = do
969− x' <- unbox (FInt from) x
1007+ x' <- unbox (FArith (ATInt (ITFixed from))) x
970− x'' <- inst $ operator x' (IntegerType $ itWidth to) []
1008+ x'' <- inst $ operator x' (ftyToTy (FArith (ATInt (ITFixed from)))) []
971− box (FInt to) x''
1009+ box (FArith (ATInt (ITFixed to))) x''
972
1010
973cgStrCat :: Operand -> Operand -> Codegen Operand
1011cgStrCat :: Operand -> Operand -> Codegen Operand
974cgStrCat x y = do
1012cgStrCat x y = do
@@ -994,50 +1032,54 @@ cgStrCat x y = do
994ibin :: IntTy -> Operand -> Operand
1032ibin :: IntTy -> Operand -> Operand
995 -> (Operand -> Operand -> InstructionMetadata -> Instruction) -> Codegen Operand
1033 -> (Operand -> Operand -> InstructionMetadata -> Instruction) -> Codegen Operand
996ibin ity x y instCon = do
1034ibin ity x y instCon = do
997− nx <- unbox (FInt ity) x
1035+ nx <- unbox (FArith (ATInt ity)) x
998− ny <- unbox (FInt ity) y
1036+ ny <- unbox (FArith (ATInt ity)) y
999 nr <- inst $ instCon nx ny []
1037 nr <- inst $ instCon nx ny []
1000− box (FInt ity) nr
1038+ box (FArith (ATInt ity)) nr
1001
1039
1002iun :: IntTy -> Operand -> (Operand -> InstructionMetadata -> Instruction) -> Codegen Operand
1040iun :: IntTy -> Operand -> (Operand -> InstructionMetadata -> Instruction) -> Codegen Operand
1003iun ity x instCon = do
1041iun ity x instCon = do
1004− nx <- unbox (FInt ity) x
1042+ nx <- unbox (FArith (ATInt ity)) x
1005 nr <- inst $ instCon nx []
1043 nr <- inst $ instCon nx []
1006− box (FInt ity) nr
1044+ box (FArith (ATInt ity)) nr
1007
1045
1008iCmp :: IntTy -> IPred.IntegerPredicate -> Operand -> Operand -> Codegen Operand
1046iCmp :: IntTy -> IPred.IntegerPredicate -> Operand -> Operand -> Codegen Operand
1009iCmp ity pred x y = do
1047iCmp ity pred x y = do
1010− nx <- unbox (FInt ity) x
1048+ nx <- unbox (FArith (ATInt ity)) x
1011− ny <- unbox (FInt ity) y
1049+ ny <- unbox (FArith (ATInt ity)) y
1012 nr <- inst $ ICmp pred nx ny []
1050 nr <- inst $ ICmp pred nx ny []
1013− nr' <- inst $ ZExt nr (IntegerType 32) []
1051+ nr' <- inst $ SExt nr (ftyToTy $ cmpResultTy ity) []
1014− box (FInt IT32) nr'
1052+ box (cmpResultTy ity) nr'
1053+
1054+cmpResultTy :: IntTy -> FType
1055+cmpResultTy v@(ITVec _ _) = FArith (ATInt v)
1056+cmpResultTy _ = FArith (ATInt (ITFixed IT32))
1015
1057
1016mpzBin :: String -> Operand -> Operand -> Codegen Operand
1058mpzBin :: String -> Operand -> Operand -> Codegen Operand
1017mpzBin name x y = do
1059mpzBin name x y = do
1018− nx <- unbox (FInt ITBig) x
1060+ nx <- unbox (FArith (ATInt ITBig)) x
1019− ny <- unbox (FInt ITBig) y
1061+ ny <- unbox (FArith (ATInt ITBig)) y
1020 nz <- alloc mpzTy
1062 nz <- alloc mpzTy
1021 inst' $ simpleCall "__gmpz_init" [nz]
1063 inst' $ simpleCall "__gmpz_init" [nz]
1022 inst' $ simpleCall ("__gmpz_" ++ name) [nz, nx, ny]
1064 inst' $ simpleCall ("__gmpz_" ++ name) [nz, nx, ny]
1023− box (FInt ITBig) nz
1065+ box (FArith (ATInt ITBig)) nz
1024
1066
1025mpzUn :: String -> Operand -> Codegen Operand
1067mpzUn :: String -> Operand -> Codegen Operand
1026mpzUn name x = do
1068mpzUn name x = do
1027− nx <- unbox (FInt ITBig) x
1069+ nx <- unbox (FArith (ATInt ITBig)) x
1028 nz <- alloc mpzTy
1070 nz <- alloc mpzTy
1029 inst' $ simpleCall "__gmpz_init" [nz]
1071 inst' $ simpleCall "__gmpz_init" [nz]
1030 inst' $ simpleCall ("__gmpz_" ++ name) [nz, nx]
1072 inst' $ simpleCall ("__gmpz_" ++ name) [nz, nx]
1031− box (FInt ITBig) nz
1073+ box (FArith (ATInt ITBig)) nz
1032
1074
1033mpzCmp :: IPred.IntegerPredicate -> Operand -> Operand -> Codegen Operand
1075mpzCmp :: IPred.IntegerPredicate -> Operand -> Operand -> Codegen Operand
1034mpzCmp pred x y = do
1076mpzCmp pred x y = do
1035− nx <- unbox (FInt ITBig) x
1077+ nx <- unbox (FArith (ATInt ITBig)) x
1036− ny <- unbox (FInt ITBig) y
1078+ ny <- unbox (FArith (ATInt ITBig)) y
1037 cmp <- inst $ simpleCall "__gmpz_cmp" [nx, ny]
1079 cmp <- inst $ simpleCall "__gmpz_cmp" [nx, ny]
1038 result <- inst $ ICmp pred cmp (ConstantOperand (C.Int 32 0)) []
1080 result <- inst $ ICmp pred cmp (ConstantOperand (C.Int 32 0)) []
1039 i <- inst $ ZExt result (IntegerType 32) []
1081 i <- inst $ ZExt result (IntegerType 32) []
1040− box (FInt IT32) i
1082+ box (FArith (ATInt (ITFixed IT32))) i
1041
1083
1042simpleCall :: String -> [Operand] -> Instruction
1084simpleCall :: String -> [Operand] -> Instruction
1043simpleCall name args =
1085simpleCall name args =