From 24b5c3a973dbfea7bd3de102c909af5483ade0f7 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 11 Feb 2018 21:08:51 -0400 Subject: - Some improvements to protocol-based objects. --- stdlib/test/test/lux/type/object/protocol.lux | 103 +++++++++++++++----------- 1 file changed, 59 insertions(+), 44 deletions(-) (limited to 'stdlib/test') diff --git a/stdlib/test/test/lux/type/object/protocol.lux b/stdlib/test/test/lux/type/object/protocol.lux index a93f34aab..2017459bd 100644 --- a/stdlib/test/test/lux/type/object/protocol.lux +++ b/stdlib/test/test/lux/type/object/protocol.lux @@ -3,10 +3,10 @@ (lux (data text/format) (type (object protocol)))) -(type: Counter (Object (Simple Unit Nat))) +(type: Counter (Object (Method Unit Nat))) (def: (count [tick return] state) - (Method Nat (Simple Unit Nat)) + (Class Nat (Method Unit Nat)) (let [state' (n/inc state)] [(return state') state'])) @@ -48,7 +48,7 @@ (read [] a)) (def: (readM [tick return] state) - (All [s] (Method s (Simple Unit s))) + (All [s] (Class s (Method Unit s))) [(return state) state]) (protocol: (Add n) @@ -61,7 +61,7 @@ (do-template [ ] [(def: ( [diff return] state) - (Method Nat (Simple Nat Unit)) + (Class Nat (Method Nat Unit)) [(return []) ( diff state)])] [+M n/+] @@ -70,45 +70,60 @@ [/M n//] ) -## (def: addM -## (Method Nat (Add Nat)) -## (seq +M -M)) - -(def: (addM message state) - (Method Nat (Add Nat)) - (case message - (#+ message) - (+M message state) - - (#- message) - (-M message state))) - -(def: (mulM message state) - (Method Nat (Mul Nat)) - (case message - (#* message) - (*M message state) - - (#/ message) - (/M message state))) - -(type: (Number n r) - (#Read (Read n r)) - (#Add (Add n r)) - (#Mul (Mul n r))) - -(def: (numberM message state) - (Method Nat (Number Nat)) - (case message - (#Read message) - (readM message state) - - (#Add message) - (addM message state) - - (#Mul message) - (mulM message state))) +(def: addM + (Class Nat (Add Nat)) + (alt +M -M)) + +(def: mulM + (Class Nat (Mul Nat)) + (alt *M /M)) + +(type: (Number n) + ($_ Alt + (Read n) + (Add n) + (Mul n))) + +## TODO: Fix when new-luxc is the official compiler. +## (protocol: (Number n) +## (^read (Read n)) +## (^add (Add n)) +## (^mul (Mul n))) + +(def: numberM + (Class Nat (Number Nat)) + ($_ alt + readM + addM + mulM)) + +(type: NatO (Object (Number Nat))) (def: numberO - (Object (Number Nat)) - (object numberM +0)) + NatO + (object numberM +1)) + +(def: _test2 + [Nat NatO] + (numberO (+0 (read [])))) + +(def: _test3 + [Unit NatO] + (numberO (+1 (+0 (+ +123))))) + +(def: _test4 + [Unit NatO] + (numberO (+1 (+1 (* +123))))) + +## TODO: Fix when new-luxc is the official compiler. +## (def: _test2 +## [Nat NatO] +## (numberO (^read (read [])))) + +## (def: _test3 +## [Unit NatO] +## (numberO (^add (+ +123)))) + +## (def: _test4 +## [Unit NatO] +## (numberO (^mul (* +123)))) -- cgit v1.2.3