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