add toRepresentation / fromRepresentation for Float Int

The new functions do bitwise coersion to and from Nat

fixes: #2313
This commit is contained in:
Stew O'Connor 2021-08-18 16:21:38 -07:00
parent ec623e082b
commit 553c5d9b13
5 changed files with 148 additions and 6 deletions

View File

@ -282,6 +282,8 @@ builtinsSrc =
, B "Int.toFloat" $ int --> float
, B "Int.trailingZeros" $ int --> nat
, B "Int.popCount" $ int --> nat
, B "Int.fromRepresentation" $ nat --> int
, B "Int.toRepresentation" $ int --> nat
, B "Nat.*" $ nat --> nat --> nat
, B "Nat.+" $ nat --> nat --> nat
@ -335,6 +337,8 @@ builtinsSrc =
, B "Float.<=" $ float --> float --> boolean
, B "Float.>=" $ float --> float --> boolean
, B "Float.==" $ float --> float --> boolean
, B "Float.fromRepresentation" $ nat --> float
, B "Float.toRepresentation" $ float --> nat
-- Trigonmetric Functions
, B "Float.acos" $ float --> float

View File

@ -459,6 +459,11 @@ appends = binop0 0 $ \[x,y] -> TPrm CATS [x,y]
conss = binop0 0 $ \[x,y] -> TPrm CONS [x,y]
snocs = binop0 0 $ \[x,y] -> TPrm SNOC [x,y]
coerceType :: Var v => Reference -> Reference -> SuperNormal v
coerceType fromType toType = unop0 1 $ \[x,r]
-> unbox x fromType r
$ TCon toType 0 [r]
takes, drops, sizes, ats, emptys :: Var v => SuperNormal v
takes = binop0 1 $ \[x0,y,x]
-> unbox x0 Ty.natRef x
@ -1242,6 +1247,8 @@ builtinLookup
, ("Int.<=", lei)
, ("Int.>", gti)
, ("Int.>=", gei)
, ("Int.fromRepresentation", coerceType Ty.natRef Ty.intRef)
, ("Int.toRepresentation", coerceType Ty.intRef Ty.natRef)
, ("Int.increment", inci)
, ("Int.signum", sgni)
, ("Int.negate", negi)
@ -1299,6 +1306,8 @@ builtinLookup
, ("Float.log", logf)
, ("Float.logBase", logbf)
, ("Float.sqrt", sqrtf)
, ("Float.fromRepresentation", coerceType Ty.natRef Ty.floatRef)
, ("Float.toRepresentation", coerceType Ty.floatRef Ty.natRef)
, ("Float.min", minf)
, ("Float.max", maxf)

View File

@ -0,0 +1,46 @@
>
```ucm:hide
.> builtins.merge
.> cd builtin
.> load unison-src/transcripts-using-base/base.u
.> add
```
```unison
testNat: Nat -> Optional Int -> Optional Float -> {Stream Result}()
testNat n expectInt expectFloat =
float = Float.fromRepresentation n
int = Int.fromRepresentation n
n2 = Float.toRepresentation float
n3 = Int.toRepresentation int
match expectFloat with
None -> emit (Ok "skipped")
Some expect -> expectU ("expected " ++ (Float.toText expect) ++ " got " ++ (Float.toText float)) expect float
expectU ("round trip though float, expected " ++ (Nat.toText n) ++ " got " ++ (Nat.toText n2)) n n2
match expectInt with
None -> emit (Ok "skipped")
Some expect -> expectU ("expected " ++ (Int.toText expect) ++ " got " ++ (Int.toText int)) expect int
expectU ("round trip though Int, expected " ++ (Nat.toText n) ++ " got " ++ (Nat.toText n3)) n n3
test: '{io2.IO}[Result]
test = 'let
testABunchOfNats: '{Stream Result}()
testABunchOfNats _ =
testNat 0 (Some +0) (Some 0.0)
testNat 1 (Some +1) None
testNat 18446744073709551615 (Some -1) None -- we don't have a way of expressing Nan
testNat 0x3FF0000000000001 (Some +4607182418800017409) (Some 1.0000000000000002 )
runTest testABunchOfNats
```
```ucm
.> add
.> io.test test
```

View File

@ -0,0 +1,84 @@
>
```unison
testNat: Nat -> Optional Int -> Optional Float -> {Stream Result}()
testNat n expectInt expectFloat =
float = Float.fromRepresentation n
int = Int.fromRepresentation n
n2 = Float.toRepresentation float
n3 = Int.toRepresentation int
match expectFloat with
None -> emit (Ok "skipped")
Some expect -> expectU ("expected " ++ (Float.toText expect) ++ " got " ++ (Float.toText float)) expect float
expectU ("round trip though float, expected " ++ (Nat.toText n) ++ " got " ++ (Nat.toText n2)) n n2
match expectInt with
None -> emit (Ok "skipped")
Some expect -> expectU ("expected " ++ (Int.toText expect) ++ " got " ++ (Int.toText int)) expect int
expectU ("round trip though Int, expected " ++ (Nat.toText n) ++ " got " ++ (Nat.toText n3)) n n3
test: '{io2.IO}[Result]
test = 'let
testABunchOfNats: '{Stream Result}()
testABunchOfNats _ =
testNat 0 (Some +0) (Some 0.0)
testNat 1 (Some +1) None
testNat 18446744073709551615 (Some -1) None -- we don't have a way of expressing Nan
testNat 0x3FF0000000000001 (Some +4607182418800017409) (Some 1.0000000000000002 )
runTest testABunchOfNats
```
```ucm
I found and typechecked these definitions in scratch.u. If you
do an `add` or `update`, here's how your codebase would
change:
⍟ These new definitions are ok to `add`:
test : '{IO} [Result]
testNat : Nat
-> Optional Int
-> Optional Float
->{Stream Result} ()
```
```ucm
.> add
⍟ I've added these definitions:
test : '{IO} [Result]
testNat : Nat
-> Optional Int
-> Optional Float
->{Stream Result} ()
.> io.test test
New test results:
◉ test expected 0.0 got 0.0
◉ test round trip though float, expected 0 got 0
◉ test expected 0 got 0
◉ test round trip though Int, expected 0 got 0
◉ test skipped
◉ test expected 1 got 1
◉ test round trip though Int, expected 1 got 1
◉ test skipped
◉ test expected -1 got -1
◉ test round trip though Int, expected 18446744073709551615 got 18446744073709551615
◉ test expected 1.0000000000000002 got 1.0000000000000002
◉ test round trip though float, expected 4607182418800017409 got 4607182418800017409
◉ test expected 4607182418800017409 got 4607182418800017409
◉ test round trip though Int, expected 4607182418800017409 got 4607182418800017409
✅ 14 test(s) passing
Tip: Use view test to view the source of a test.
```

View File

@ -1,4 +1,3 @@
Lets just make sure we can start a thread
```unison
@ -30,7 +29,7 @@ thread1 x mv = 'let
go = 'let
put mv (increment x)
match (toEither go) with
match (toEither go) with
Left (Failure _ t _) -> watch t ()
_ -> ()
@ -58,7 +57,7 @@ sendingThread: Nat -> MVar Nat -> '{io2.IO}()
sendingThread toSend mv = 'let
go = 'let
put mv (increment toSend)
match (toEither go) with
Left (Failure _ t _) -> watch t ()
_ -> ()
@ -69,11 +68,11 @@ receivingThread recv send = 'let
go = 'let
recvd = take recv
put send (toText recvd)
match (toEither go) with
Left (Failure _ t _) -> watch t ()
_ -> ()
testTwoThreads: '{io2.IO}[Result]
testTwoThreads = 'let
test = 'let
@ -89,7 +88,7 @@ testTwoThreads = 'let
runTest test
```
```
```ucm
.> add