1--
2-- Copyright 2016, NICTA
3--
4-- This software may be distributed and modified according to the terms of
5-- the GNU General Public License version 2. Note that NO WARRANTY is provided.
6-- See "LICENSE_GPLv2.txt" for details.
7--
8-- @TAG(NICTA_GPL)
9--
10
11-- This is a test file
12-- TODO: poly functions
13
14include "lib.cogent"
15
16type Index = U8
17type ErrCode = U32  -- comment
18type Buf
19type Foo
20type A = () -> ()
21type SimpleObj = { a : U8 , b : U8, c : Foo }
22
23buf_create : U8 -> < Ok Buf | Err ErrCode >
24
25buf_free : Buf -> ()
26
27string_test : String
28string_test = "Hello"
29
30simpleobj_serialise : (Buf, SimpleObj!, Index) -> <Ok  (Buf, Index) |  -- comment here
31                                                   Err (ErrCode, Buf)   >
32simpleobj_new : (U8, U8) -> <Ok SimpleObj | Err ErrCode>
33simpleobj_unserialise : (Buf!, SimpleObj, Index) -> <Ok SimpleObj | Err (ErrCode, SimpleObj)>
34simpleobj_free : SimpleObj -> ()
35print : SimpleObj! -> ()
36
37type USynonym = U8 
38
39-- Don't name them `a' and `b'. Avoiding --hs-shallow conflicts.
40x : U8
41x = 10
42
43y : U8
44y = x
45
46
47buf_size : U8
48buf_size = 42
49
50simpleobj_example : SimpleObj -> <Ok SimpleObj | Err (ErrCode, SimpleObj)>
51simpleobj_example so = buf_create buf_size
52  | Err e -> Err (e, so)
53  | Ok  buf => simpleobj_serialise (buf,so,0) !so
54    | Err (e,buf) -> buf_free buf; Err (e,so)
55    | Ok  (buf,i) => simpleobj_new ('_',0)
56      | Err e   ~> buf_free buf; Err (e,so)
57      | Ok  so2 => simpleobj_unserialise (buf,so2,0) !buf
58        | Err (e,so2) -> buf_free buf; simpleobj_free so2; Err (e,so)
59        | Ok  so2     => 
60          let so' {a, b} = so 
61          and so2' {a = a2, b = b2} = so2
62          in if not (a == a2 && b == b2) then 
63               simpleobj_free (so2' {a = a2 + 1, b = b2});
64               buf_free buf;
65               Err (32, so' {a,b})
66             else 
67               simpleobj_free (so' {a,b}); 
68               buf_free buf;
69               Ok (so2' {a = a2, b = b2})
70
71
72simpleobj_example' : SimpleObj -> <Ok SimpleObj | Err (ErrCode, SimpleObj)>
73simpleobj_example' so = buf_create 42
74  | Err e -> Err (e, so)
75  | Ok  buf => simpleobj_serialise (buf,so,0) !so
76     | Err (e, buf) -> buf_free buf; Err (e, so)
77     | Ok  (buf, i) => simpleobj_new ('_',0)
78       | Err e  -> buf_free buf; Err (e, so) 
79       | Ok so2 => simpleobj_unserialise (buf,so2,0) !buf
80         | Err (e, so2) -> buf_free buf; simpleobj_free so2; Err (e,so)
81         | Ok  so2      => 
82           let ok = so.a == so2.a && so.b == so2.b !so !so2
83           in buf_free buf; 
84              if not ok 
85                then simpleobj_free so2; Err (32, so)
86                else simpleobj_free so ; Ok  so2
87
88