reset a3, kut Charlie ;)
[tt2015.git] / a3 / code / Generics / GenReduce.icl
diff --git a/a3/code/Generics/GenReduce.icl b/a3/code/Generics/GenReduce.icl
new file mode 100644 (file)
index 0000000..c4979c3
--- /dev/null
@@ -0,0 +1,43 @@
+implementation module GenReduce\r
+\r
+import StdGeneric, _Array\r
+\r
+// or crush\r
+generic gReduce t :: (a a -> a) a  t -> a\r
+gReduce{|c|} op e x                                    = e\r
+gReduce{|PAIR|} fx fy op e (PAIR x y)  = op (fx op e x) (fy op e y)\r
+gReduce{|EITHER|} fl fr op e (LEFT x)  = fl op e x\r
+gReduce{|EITHER|} fl fr op e (RIGHT x)         = fr op e x\r
+gReduce{|CONS|} f op e (CONS x)                = f op e x \r
+gReduce{|FIELD|} f op e (FIELD x)              = f op e x\r
+gReduce{|OBJECT|} f op e (OBJECT x)    = f op e x\r
+gReduce{|{}|} f op e x                                 = reduceArray f op e x\r
+gReduce{|{!}|} f op e x                                        = reduceArray f op e x\r
+derive gReduce [], (,), (,,),  (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)\r
+\r
+generic gReduceRSt t :: .t .st -> .st\r
+gReduceRSt{|c|} x st                                   = st\r
+gReduceRSt{|PAIR|} fx fy (PAIR x y) st         = fx x (fy y st)\r
+gReduceRSt{|EITHER|} fl fr x st                = reduceEITHER fl fr x st\r
+gReduceRSt{|CONS|} f (CONS x) st               = f x st\r
+gReduceRSt{|FIELD|} f (FIELD x) st             = f x st\r
+gReduceRSt{|OBJECT|} f (OBJECT x) st   = f x st\r
+gReduceRSt{|{}|} f xs st                               = reduceArrayRSt f xs st        \r
+gReduceRSt{|{!}|} f xs st                              = reduceArrayRSt f xs st        \r
+derive gReduceRSt [], (,), (,,),  (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)\r
+\r
+generic gReduceLSt t :: .t .st -> .st\r
+gReduceLSt{|c|} x st                                           = st\r
+gReduceLSt{|PAIR|} fx fy (PAIR x y) st         = fy y (fx x st)\r
+gReduceLSt{|EITHER|} fl fr x st                = reduceEITHER fl fr x st\r
+gReduceLSt{|CONS|} f (CONS x) st               = f x st\r
+gReduceLSt{|FIELD|} f (FIELD x) st             = f x st\r
+gReduceLSt{|OBJECT|} f (OBJECT x) st   = f x st\r
+gReduceLSt{|{}|} f xs st                               = reduceArrayLSt f xs st        \r
+gReduceLSt{|{!}|} f xs st                              = reduceArrayLSt f xs st        \r
+derive gReduceLSt [], (,), (,,),  (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)\r
+\r
+reduceEITHER fl fr (LEFT x) st                         = fl x st\r
+reduceEITHER fl fr (RIGHT x) st                = fr x st\r
+\r
+                 
\ No newline at end of file