- Added initial implementation of protocol-based object-oriented programming.

2 files changed, 117 insertions, 1 deletions

diff --git a/stdlib/test/test/lux/type/object/protocol.lux b/stdlib/test/test/lux/type/object/protocol.lux
new file mode 100644
index 000000000..a93f34aab
--- /dev/null
+++ b/stdlib/test/test/lux/type/object/protocol.lux
@@ -0,0 +1,114 @@
+(.module:
+  lux
+  (lux (data text/format)
+       (type (object protocol))))
+
+(type: Counter (Object (Simple Unit Nat)))
+
+(def: (count [tick return] state)
+  (Method Nat (Simple Unit Nat))
+  (let [state' (n/inc state)]
+    [(return state') state']))
+
+(def: counter
+  (-> Nat Counter)
+  (object count))
+
+(def: _test0
+  [Nat Counter]
+  ((counter +0) (message [])))
+
+(protocol: Protocol0
+  (method0 [Bool Nat Text] Bool)
+  (method1 [Nat Text Bool] Nat)
+  (method2 [Text Bool Nat] Text))
+
+(type: Object0 (Object Protocol0))
+
+(def: object0
+  Object0
+  (loop [num-calls +0]
+    (function [message]
+      [(case message
+         (#method0 [arg0 arg1 arg2] output)
+         (output (n/= +0 (n/% +2 num-calls)))
+         
+         (#method1 [arg0 arg1 arg2] output)
+         (output num-calls)
+         
+         (#method2 [arg0 arg1 arg2] output)
+         (output (%n num-calls)))
+       (recur (n/inc num-calls))])))
+
+(def: _test1
+  [Nat Object0]
+  (object0 (method1 [+0 "0" false])))
+
+(protocol: (Read a)
+  (read [] a))
+
+(def: (readM [tick return] state)
+  (All [s] (Method s (Simple Unit s)))
+  [(return state) state])
+
+(protocol: (Add n)
+  (+ n Unit)
+  (- n Unit))
+
+(protocol: (Mul n)
+  (* n Unit)
+  (/ n Unit))
+
+(do-template [<name> <op>]
+  [(def: (<name> [diff return] state)
+     (Method Nat (Simple Nat Unit))
+     [(return []) (<op> diff state)])]
+
+  [+M n/+]
+  [-M n/-]
+  [*M n/*]
+  [/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: numberO
+  (Object (Number Nat))
+  (object numberM +0))
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index b59e8008a..850abc865 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -69,7 +69,9 @@
                     (poly ["poly_." eq]
                           ["poly_." functor]))
              (type ["_." implicit]
-                   (object ["_." interface])
+                   (object
+                     ["_." interface]
+                     ["_." protocol])
                    ["_." resource])
              (lang ["lang/_." syntax]
                    ["_." type]