reset a3, kut Charlie ;)

[tt2015.git] / a3 / code / Generics / GenMapSt.icl

diff --git a/a3/code/Generics/GenMapSt.icl b/a3/code/Generics/GenMapSt.icl
new file mode 100644 (file)
index 0000000..109843d
--- /dev/null
+++ b/a3/code/Generics/GenMapSt.icl
@@ -0,0 +1,53 @@
+implementation module GenMapSt\r
+\r
+import StdGeneric, _Array\r
+\r
+derive bimap (,)\r
+\r
+generic gMapLSt a b :: .a .st -> (.b, .st)\r
+gMapLSt{|c|} x st                              = (x, st)\r
+gMapLSt{|PAIR|} fx fy (PAIR x y) st\r
+       # (x, st) = fx x st     \r
+       # (y, st) = fy y st     \r
+       = (PAIR x y, st)        \r
+gMapLSt{|EITHER|} fl fr x st   = mapStEITHER fl fr x st\r
+gMapLSt{|CONS|} f x st                         = mapStCONS f x st\r
+gMapLSt{|FIELD|} f x st                = mapStFIELD f x st\r
+gMapLSt{|OBJECT|} f x st               = mapStOBJECT f x st\r
+gMapLSt{|{}|} f x st                   = mapArrayLSt f x st\r
+gMapLSt{|{!}|} f x st                  = mapArrayLSt f x st\r
+\r
+derive gMapLSt [], (,), (,,),  (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)\r
+\r
+generic gMapRSt a b :: .a .st -> (.b, .st)\r
+gMapRSt{|c|} x st = (x, st)\r
+gMapRSt{|PAIR|} fx fy (PAIR x y) st    \r
+       # (y, st) = fy y st     \r
+       # (x, st) = fx x st     \r
+       = (PAIR x y, st)        \r
+gMapRSt{|EITHER|} fx fy x st   = mapStEITHER fx fy x st        \r
+gMapRSt{|CONS|} f x st                         = mapStCONS f x st\r
+gMapRSt{|FIELD|} f x st                = mapStFIELD f x st\r
+gMapRSt{|OBJECT|} f x st               = mapStOBJECT f x st\r
+gMapRSt{|{}|} f x st                   = mapArrayRSt f x st\r
+gMapRSt{|{!}|} f x st                  = mapArrayRSt f x st\r
+\r
+derive gMapRSt [], (,), (,,),  (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)\r
+\r
+\r
+mapStEITHER fl fr (LEFT x) st\r
+       # (x, st) = fl x st \r
+       = (LEFT x, st)\r
+mapStEITHER fl fr (RIGHT x) st\r
+       # (x, st) = fr x st \r
+       = (RIGHT x, st)\r
+mapStCONS f (CONS x) st\r
+       # (x, st) = f x st      \r
+       = (CONS x, st)\r
+mapStFIELD f (FIELD x) st              \r
+       # (x, st) = f x st \r
+       = (FIELD x, st) \r
+mapStOBJECT f (OBJECT x) st            \r
+       # (x, st) = f x st \r
+       = (OBJECT x, st)        \r
+       
\ No newline at end of file