git.iko.soy/Idris-dev
on master help sign in
Implement remaining string and integer primitives
3c57588Benjamin Saunders
src/IRTS/CodegenLLVM.hs+47−2
compare with master
unifiedsplit
@@ -772,6 +772,7 @@ cgOp (LSRem ITBig) [x,y] = mpzBin "fdiv_r" x y
772cgOp (LAnd ITBig) [x,y] = mpzBin "and" x y
772cgOp (LAnd ITBig) [x,y] = mpzBin "and" x y
773cgOp (LOr ITBig) [x,y] = mpzBin "ior" x y
773cgOp (LOr ITBig) [x,y] = mpzBin "ior" x y
774cgOp (LXOr ITBig) [x,y] = mpzBin "xor" x y
774cgOp (LXOr ITBig) [x,y] = mpzBin "xor" x y
775+cgOp (LCompl ITBig) [x] = mpzUn "com" x
775
776
776cgOp (LTrunc from to) [x] | itWidth from > itWidth to = iCoerce Trunc from to x
777cgOp (LTrunc from to) [x] | itWidth from > itWidth to = iCoerce Trunc from to x
777cgOp (LZExt from to) [x] | itWidth from < itWidth to = iCoerce ZExt from to x
778cgOp (LZExt from to) [x] | itWidth from < itWidth to = iCoerce ZExt from to x
@@ -785,13 +786,17 @@ cgOp (LGt ity) [x,y] = iCmp ity IPred.SGT x y
785cgOp (LPlus ity) [x,y] = ibin ity x y (Add False False)
786cgOp (LPlus ity) [x,y] = ibin ity x y (Add False False)
786cgOp (LMinus ity) [x,y] = ibin ity x y (Sub False False)
787cgOp (LMinus ity) [x,y] = ibin ity x y (Sub False False)
787cgOp (LTimes ity) [x,y] = ibin ity x y (Mul False False)
788cgOp (LTimes ity) [x,y] = ibin ity x y (Mul False False)
788−cgOp (LUDiv ity) [x,y] = ibin ity x y (UDiv True)
789+cgOp (LUDiv ity) [x,y] = ibin ity x y (UDiv False)
789cgOp (LURem ity) [x,y] = ibin ity x y URem
790cgOp (LURem ity) [x,y] = ibin ity x y URem
790−cgOp (LSDiv ity) [x,y] = ibin ity x y (SDiv True)
791+cgOp (LSDiv ity) [x,y] = ibin ity x y (SDiv False)
791cgOp (LSRem ity) [x,y] = ibin ity x y SRem
792cgOp (LSRem ity) [x,y] = ibin ity x y SRem
792cgOp (LAnd ity) [x,y] = ibin ity x y And
793cgOp (LAnd ity) [x,y] = ibin ity x y And
793cgOp (LOr ity) [x,y] = ibin ity x y Or
794cgOp (LOr ity) [x,y] = ibin ity x y Or
794cgOp (LXOr ity) [x,y] = ibin ity x y Xor
795cgOp (LXOr ity) [x,y] = ibin ity x y Xor
796+cgOp (LCompl ity) [x] = iun ity x (Xor (ConstantOperand (C.Int (itWidth ity) (-1))))
797+cgOp (LSHL ity) [x,y] = ibin ity x y (Shl False False)
798+cgOp (LLSHR ity) [x,y] = ibin ity x y (LShr False)
799+cgOp (LASHR ity) [x,y] = ibin ity x y (AShr False)
795
800
796cgOp LStrEq [x,y] = do
801cgOp LStrEq [x,y] = do
797 x' <- unbox FString x
802 x' <- unbox FString x
@@ -801,6 +806,14 @@ cgOp LStrEq [x,y] = do
801 val <- inst $ ZExt flag (IntegerType 32) []
806 val <- inst $ ZExt flag (IntegerType 32) []
802 box (FInt IT32) val
807 box (FInt IT32) val
803
808
809+cgOp LStrLt [x,y] = do
810+ nx <- unbox FString x
811+ ny <- unbox FString y
812+ cmp <- inst $ simpleCall "strcmp" [nx, ny]
813+ flag <- inst $ ICmp IPred.ULT cmp (ConstantOperand (C.Int 32 0)) []
814+ val <- inst $ ZExt flag (IntegerType 32) []
815+ box (FInt IT32) val
816+
804cgOp (LIntStr ITBig) [x] = do
817cgOp (LIntStr ITBig) [x] = do
805 x' <- unbox (FInt ITBig) x
818 x' <- unbox (FInt ITBig) x
806 ustr <- inst $ simpleCall "__gmpz_get_str"
819 ustr <- inst $ simpleCall "__gmpz_get_str"
@@ -847,11 +860,29 @@ cgOp LStrHead [c] = do
847 c' <- inst $ ZExt c (IntegerType 32) []
860 c' <- inst $ ZExt c (IntegerType 32) []
848 box FChar c'
861 box FChar c'
849
862
863+cgOp LStrIndex [s, i] = do
864+ ns <- unbox FString s
865+ ni <- unbox (FInt IT32) i
866+ p <- inst $ GetElementPtr True ns [ni] []
867+ c <- inst $ Load False p Nothing 0 []
868+ c' <- inst $ ZExt c (IntegerType 32) []
869+ box FChar c'
870+
850cgOp LStrTail [c] = do
871cgOp LStrTail [c] = do
851 s <- unbox FString c
872 s <- unbox FString c
852 c <- inst $ GetElementPtr True s [ConstantOperand $ C.Int 32 1] []
873 c <- inst $ GetElementPtr True s [ConstantOperand $ C.Int 32 1] []
853 box FString c
874 box FString c
854
875
876+cgOp LStrLen [s] = do
877+ ns <- unbox FString s
878+ len <- inst $ simpleCall "strlen" [ns]
879+ ws <- getWordSize
880+ len' <- case ws of
881+ 32 -> return len
882+ x | x > 32 -> inst $ Trunc len (IntegerType $ fromInteger x) []
883+ | x < 32 -> inst $ ZExt len (IntegerType $ fromInteger x) []
884+ box (FInt IT32) len'
885+
855cgOp LReadStr [p] = do
886cgOp LReadStr [p] = do
856 np <- unbox FPtr p
887 np <- unbox FPtr p
857 s <- inst $ simpleCall "__idris_readStr" [np]
888 s <- inst $ simpleCall "__idris_readStr" [np]
@@ -906,6 +937,12 @@ ibin ity x y instCon = do
906 nr <- inst $ instCon nx ny []
937 nr <- inst $ instCon nx ny []
907 box (FInt ity) nr
938 box (FInt ity) nr
908
939
940+iun :: IntTy -> Operand -> (Operand -> InstructionMetadata -> Instruction) -> Codegen Operand
941+iun ity x instCon = do
942+ nx <- unbox (FInt ity) x
943+ nr <- inst $ instCon nx []
944+ box (FInt ity) nr
945+
909iCmp :: IntTy -> IPred.IntegerPredicate -> Operand -> Operand -> Codegen Operand
946iCmp :: IntTy -> IPred.IntegerPredicate -> Operand -> Operand -> Codegen Operand
910iCmp ity pred x y = do
947iCmp ity pred x y = do
911 nx <- unbox (FInt ity) x
948 nx <- unbox (FInt ity) x
@@ -923,6 +960,14 @@ mpzBin name x y = do
923 inst' $ simpleCall ("__gmpz_" ++ name) [nz, nx, ny]
960 inst' $ simpleCall ("__gmpz_" ++ name) [nz, nx, ny]
924 box (FInt ITBig) nz
961 box (FInt ITBig) nz
925
962
963+mpzUn :: String -> Operand -> Codegen Operand
964+mpzUn name x = do
965+ nx <- unbox (FInt ITBig) x
966+ nz <- alloc mpzTy
967+ inst' $ simpleCall "__gmpz_init" [nz]
968+ inst' $ simpleCall ("__gmpz_" ++ name) [nz, nx]
969+ box (FInt ITBig) nz
970+
926mpzCmp :: IPred.IntegerPredicate -> Operand -> Operand -> Codegen Operand
971mpzCmp :: IPred.IntegerPredicate -> Operand -> Operand -> Codegen Operand
927mpzCmp pred x y = do
972mpzCmp pred x y = do
928 nx <- unbox (FInt ITBig) x
973 nx <- unbox (FInt ITBig) x