2020-11-12 19:43:39 +03:00
|
|
|
|
|
|
|
Test for code serialization operations.
|
|
|
|
|
|
|
|
```ucm:hide
|
|
|
|
.> builtins.merge
|
|
|
|
.> cd builtin
|
|
|
|
```
|
|
|
|
|
|
|
|
Define a function, serialize it, then deserialize it back to an actual
|
|
|
|
function. Also ask for its dependencies for display later.
|
|
|
|
|
|
|
|
```unison
|
2021-01-06 19:11:24 +03:00
|
|
|
save : a -> Bytes
|
|
|
|
save x = Value.serialize (Value.value x)
|
|
|
|
|
2021-02-24 10:56:04 +03:00
|
|
|
load : Bytes ->{io2.IO, Throw Text} a
|
2021-01-06 19:11:24 +03:00
|
|
|
load b = match Value.deserialize b with
|
|
|
|
Left _ -> throw "could not deserialize value"
|
|
|
|
Right v -> match Value.load v with
|
|
|
|
Left _ -> throw "could not load value"
|
|
|
|
Right x -> x
|
|
|
|
|
2021-02-24 10:56:04 +03:00
|
|
|
roundtrip : a ->{io2.IO, Throw Text} a
|
2021-01-06 19:11:24 +03:00
|
|
|
roundtrip x = load (save x)
|
|
|
|
|
2021-02-24 10:56:04 +03:00
|
|
|
handleTest : Text -> Request {Throw Text} a -> Result
|
2021-01-06 19:11:24 +03:00
|
|
|
handleTest t = let
|
|
|
|
pfx = "(" ++ t ++ ") "
|
|
|
|
cases
|
|
|
|
{ _ } -> Ok (pfx ++ "passed")
|
2021-02-24 10:56:04 +03:00
|
|
|
{ Throw.throw s -> _ } -> Fail (pfx ++ s)
|
2021-01-06 19:11:24 +03:00
|
|
|
|
2021-02-24 10:56:04 +03:00
|
|
|
identical : Text -> a -> a ->{Throw Text} ()
|
2021-01-06 19:11:24 +03:00
|
|
|
identical err x y =
|
|
|
|
if x == y
|
|
|
|
then ()
|
|
|
|
else throw ("mismatch" ++ err)
|
|
|
|
|
2020-11-24 23:57:41 +03:00
|
|
|
type Three a b c = zero a | one b | two c
|
|
|
|
|
2021-01-06 19:11:24 +03:00
|
|
|
showThree : Three Nat Nat Nat -> Text
|
|
|
|
showThree = cases
|
|
|
|
zero n -> "zero " ++ toText n
|
|
|
|
one n -> "one " ++ toText n
|
|
|
|
two n -> "two " ++ toText n
|
|
|
|
|
2020-11-24 23:57:41 +03:00
|
|
|
concatMap : (a -> [b]) -> [a] -> [b]
|
|
|
|
concatMap f = cases
|
|
|
|
[] -> []
|
|
|
|
x +: xs -> f x ++ concatMap f xs
|
|
|
|
|
2021-01-06 19:11:24 +03:00
|
|
|
prod : [a] -> [b] -> [(a,b)]
|
|
|
|
prod l = cases
|
|
|
|
[] -> []
|
|
|
|
y +: ys -> map (x -> (x,y)) l ++ prod l ys
|
|
|
|
|
|
|
|
threes : [Three Nat Nat Nat]
|
|
|
|
threes = map zero fib10 ++ map one fib10 ++ map two fib10
|
|
|
|
|
|
|
|
extensionals
|
|
|
|
: (a -> b -> Text)
|
|
|
|
-> (a -> b -> c)
|
|
|
|
-> (a -> b -> c)
|
2021-02-24 10:56:04 +03:00
|
|
|
-> [(a,b)] ->{Throw Text} ()
|
2021-01-06 19:11:24 +03:00
|
|
|
extensionals sh f g = cases
|
|
|
|
[] -> ()
|
|
|
|
(x,y) +: xs ->
|
|
|
|
identical (" on: " ++ sh x y) (f x y) (g x y)
|
|
|
|
extensionals sh f g xs
|
|
|
|
|
|
|
|
fib10 : [Nat]
|
|
|
|
fib10 = [1,2,3,5,8,13,21,34,55,89]
|
|
|
|
|
2021-02-24 10:56:04 +03:00
|
|
|
extensionality : Text -> (Three Nat Nat Nat -> Nat -> b) ->{io2.IO} Result
|
2021-01-06 19:11:24 +03:00
|
|
|
extensionality t f = let
|
|
|
|
sh t n = "(" ++ showThree t ++ ", " ++ toText n ++ ")"
|
|
|
|
handle
|
|
|
|
g = roundtrip f
|
|
|
|
extensionals sh f g (prod threes fib10)
|
|
|
|
with handleTest t
|
|
|
|
|
2021-02-24 10:56:04 +03:00
|
|
|
identicality : Text -> a ->{io2.IO} Result
|
2021-01-06 19:11:24 +03:00
|
|
|
identicality t x
|
|
|
|
= handle identical "" x (roundtrip x) with handleTest t
|
|
|
|
```
|
|
|
|
|
|
|
|
```ucm
|
|
|
|
.> add
|
|
|
|
```
|
|
|
|
|
|
|
|
```unison
|
|
|
|
ability Zap where
|
|
|
|
zap : Three Nat Nat Nat
|
|
|
|
|
2020-11-24 23:57:41 +03:00
|
|
|
h : Three Nat Nat Nat -> Nat -> Nat
|
|
|
|
h y x = match y with
|
|
|
|
zero y -> x + y
|
|
|
|
one y -> x + y + y
|
|
|
|
two y -> x + 3*y
|
|
|
|
|
|
|
|
f : Nat ->{Zap} Nat
|
|
|
|
f x = h zap x
|
2020-11-12 19:43:39 +03:00
|
|
|
|
|
|
|
fVal : Value
|
|
|
|
fVal = Value.value f
|
|
|
|
|
|
|
|
fDeps : [Term]
|
|
|
|
fDeps = Value.dependencies fVal
|
|
|
|
|
|
|
|
fSer : Bytes
|
|
|
|
fSer = Value.serialize fVal
|
|
|
|
|
2021-01-06 19:11:24 +03:00
|
|
|
rotate : Three Nat Nat Nat -> Three Nat Nat Nat
|
|
|
|
rotate = cases
|
|
|
|
zero n -> one (n+1)
|
|
|
|
one n -> two (n+2)
|
|
|
|
two n -> zero (drop n 6)
|
2020-11-12 19:43:39 +03:00
|
|
|
|
2021-01-06 19:11:24 +03:00
|
|
|
zapper : Three Nat Nat Nat -> Request {Zap} r -> r
|
|
|
|
zapper t = cases
|
2020-11-24 23:57:41 +03:00
|
|
|
{ r } -> r
|
2021-01-06 19:11:24 +03:00
|
|
|
{ zap -> k } -> handle k t with zapper (rotate t)
|
|
|
|
|
|
|
|
tests : '{io2.IO} [Result]
|
|
|
|
tests =
|
|
|
|
'[ extensionality "ext f" (t x -> handle f x with zapper t)
|
|
|
|
, extensionality "ext h" h
|
|
|
|
, identicality "ident compound" (x -> handle f x with zapper (zero 5))
|
|
|
|
, identicality "ident fib10" fib10
|
|
|
|
, identicality "ident effect" (_ -> zap)
|
|
|
|
, identicality "ident zero" zero
|
|
|
|
, identicality "ident h" h
|
|
|
|
, identicality "ident text" "hello"
|
|
|
|
, identicality "ident int" +5
|
|
|
|
, identicality "ident float" 0.5
|
|
|
|
, identicality "ident termlink" fDeps
|
|
|
|
, identicality "ident bool" false
|
2021-01-08 00:18:08 +03:00
|
|
|
, identicality "ident bytes" [fSer, Bytes.empty]
|
2021-01-06 19:11:24 +03:00
|
|
|
]
|
2020-11-12 19:43:39 +03:00
|
|
|
```
|
|
|
|
|
2020-11-18 22:04:02 +03:00
|
|
|
This simply runs some functions to make sure there isn't a crash. Once
|
|
|
|
we gain the ability to capture output in a transcript, it can be modified
|
|
|
|
to actual show that the serialization works.
|
|
|
|
|
2020-11-12 19:43:39 +03:00
|
|
|
```ucm
|
|
|
|
.> add
|
|
|
|
.> display fDeps
|
2021-01-06 19:11:24 +03:00
|
|
|
.> io.test tests
|
2020-11-12 19:43:39 +03:00
|
|
|
```
|