mirror of
https://github.com/edwinb/Idris2-boot.git
synced 2024-09-11 16:05:51 +03:00
Merge pull request #281 from ziman/fix-cast-double-int
Fix cast to integral types
This commit is contained in:
commit
71cae356e2
@ -137,12 +137,12 @@ schOp (Cast DoubleType StringType) [x] = op "number->string" [x]
|
||||
schOp (Cast CharType StringType) [x] = op "string" [x]
|
||||
|
||||
schOp (Cast IntType IntegerType) [x] = x
|
||||
schOp (Cast DoubleType IntegerType) [x] = op "floor" [x]
|
||||
schOp (Cast DoubleType IntegerType) [x] = op "exact-floor" [x]
|
||||
schOp (Cast CharType IntegerType) [x] = op "char->integer" [x]
|
||||
schOp (Cast StringType IntegerType) [x] = op "cast-string-int" [x]
|
||||
|
||||
schOp (Cast IntegerType IntType) [x] = x
|
||||
schOp (Cast DoubleType IntType) [x] = op "floor" [x]
|
||||
schOp (Cast DoubleType IntType) [x] = op "exact-floor" [x]
|
||||
schOp (Cast StringType IntType) [x] = op "cast-string-int" [x]
|
||||
schOp (Cast CharType IntType) [x] = op "char->integer" [x]
|
||||
|
||||
|
@ -6,7 +6,7 @@
|
||||
(define b+ (lambda (x y bits) (remainder (+ x y) (expt 2 bits))))
|
||||
(define b- (lambda (x y bits) (remainder (- x y) (expt 2 bits))))
|
||||
(define b* (lambda (x y bits) (remainder (* x y) (expt 2 bits))))
|
||||
(define b/ (lambda (x y bits) (remainder (floor (/ x y)) (expt 2 bits))))
|
||||
(define b/ (lambda (x y bits) (remainder (exact-floor (/ x y)) (expt 2 bits))))
|
||||
|
||||
(define blodwen-shl (lambda (x y) (ash x y)))
|
||||
(define blodwen-shr (lambda (x y) (ash x (- y))))
|
||||
@ -26,6 +26,9 @@
|
||||
(define cast-string-int
|
||||
(lambda (x)
|
||||
(floor (cast-num (string->number (destroy-prefix x))))))
|
||||
(define exact-floor
|
||||
(lambda (x)
|
||||
(inexact->exact (floor x))))
|
||||
(define cast-string-double
|
||||
(lambda (x)
|
||||
(cast-num (string->number (destroy-prefix x)))))
|
||||
|
@ -6,7 +6,7 @@
|
||||
(define b+ (lambda (x y bits) (remainder (+ x y) (expt 2 bits))))
|
||||
(define b- (lambda (x y bits) (remainder (- x y) (expt 2 bits))))
|
||||
(define b* (lambda (x y bits) (remainder (* x y) (expt 2 bits))))
|
||||
(define b/ (lambda (x y bits) (remainder (/ x y) (expt 2 bits))))
|
||||
(define b/ (lambda (x y bits) (remainder (exact-floor (/ x y)) (expt 2 bits))))
|
||||
|
||||
(define blodwen-shl (lambda (x y) (arithmetic-shift x y)))
|
||||
(define blodwen-shr (lambda (x y) (arithmetic-shift x (- y))))
|
||||
@ -26,6 +26,9 @@
|
||||
(define cast-string-int
|
||||
(lambda (x)
|
||||
(floor (cast-num (string->number (destroy-prefix x))))))
|
||||
(define exact-floor
|
||||
(lambda (x)
|
||||
(inexact->exact (floor x))))
|
||||
(define cast-string-double
|
||||
(lambda (x)
|
||||
(cast-num (string->number (destroy-prefix x)))))
|
||||
|
@ -6,7 +6,7 @@
|
||||
(define b+ (lambda (x y bits) (remainder (+ x y) (expt 2 bits))))
|
||||
(define b- (lambda (x y bits) (remainder (- x y) (expt 2 bits))))
|
||||
(define b* (lambda (x y bits) (remainder (* x y) (expt 2 bits))))
|
||||
(define b/ (lambda (x y bits) (remainder (/ x y) (expt 2 bits))))
|
||||
(define b/ (lambda (x y bits) (remainder (exact-floor (/ x y)) (expt 2 bits))))
|
||||
|
||||
(define blodwen-shl (lambda (x y) (arithmetic-shift x y)))
|
||||
(define blodwen-shr (lambda (x y) (arithmetic-shift x (- y))))
|
||||
|
@ -81,7 +81,7 @@ idrisTests
|
||||
-- Miscellaneous regressions
|
||||
"reg001", "reg002", "reg003", "reg004", "reg005", "reg006", "reg007",
|
||||
"reg008", "reg009", "reg010", "reg011", "reg012", "reg013", "reg014",
|
||||
"reg015",
|
||||
"reg015", "reg016",
|
||||
-- Totality checking
|
||||
"total001", "total002", "total003", "total004", "total005",
|
||||
"total006",
|
||||
|
10
tests/idris2/reg016/expected
Normal file
10
tests/idris2/reg016/expected
Normal file
@ -0,0 +1,10 @@
|
||||
3
|
||||
4.2
|
||||
"1.2"
|
||||
4
|
||||
1
|
||||
"2.7"
|
||||
5.9
|
||||
2
|
||||
2
|
||||
2
|
21
tests/idris2/reg016/numbers.idr
Normal file
21
tests/idris2/reg016/numbers.idr
Normal file
@ -0,0 +1,21 @@
|
||||
-- the commented-out cases are still wrong,
|
||||
-- but fixing them as well would make other tests fail for mysterious reasons
|
||||
-- see https://github.com/edwinb/Idris2/pull/281
|
||||
main : IO ()
|
||||
main = do
|
||||
printLn $ 3
|
||||
printLn $ 4.2
|
||||
printLn $ "1.2"
|
||||
|
||||
printLn $ cast {to = Int} 4.8
|
||||
printLn $ cast {to = Integer} 1.2
|
||||
printLn $ cast {to = String} 2.7
|
||||
|
||||
-- printLn $ cast {to = Int} "1.2"
|
||||
-- printLn $ cast {to = Integer} "2.7"
|
||||
printLn $ cast {to = Double} "5.9"
|
||||
|
||||
printLn $ (the Int 6 `div` the Int 3)
|
||||
printLn $ (the Integer 6 `div` the Integer 3)
|
||||
printLn $ (cast {to = Int} "6.6" `div` cast "3.9")
|
||||
-- printLn $ (cast {to = Integer} "6.6" `div` cast "3.9")
|
3
tests/idris2/reg016/run
Executable file
3
tests/idris2/reg016/run
Executable file
@ -0,0 +1,3 @@
|
||||
$1 numbers.idr -x main
|
||||
|
||||
rm -rf build
|
Loading…
Reference in New Issue
Block a user