Commit 23b7275a authored by John van Groningen's avatar John van Groningen

change generic bimap to: generic bimap a b | bimap b a :: .a ->.b

parent de55f06a
definition module StdGeneric definition module StdGeneric
// embedding-projection
:: Bimap a b = { map_to :: .(a -> b), map_from :: .(b -> a) }
bimapId :: Bimap .a .a
// generic representation // generic representation
:: UNIT = UNIT :: UNIT = UNIT
:: EITHER a b = LEFT a | RIGHT b :: EITHER a b = LEFT a | RIGHT b
...@@ -57,7 +53,7 @@ bimapId :: Bimap .a .a ...@@ -57,7 +53,7 @@ bimapId :: Bimap .a .a
getConsPath :: !GenericConsDescriptor -> [ConsPos] getConsPath :: !GenericConsDescriptor -> [ConsPos]
// generic bidirectional mapping // generic bidirectional mapping
generic bimap a b :: Bimap .a .b generic bimap a b | bimap b a :: .a ->.b
derive bimap c derive bimap c
derive bimap PAIR derive bimap PAIR
...@@ -67,10 +63,13 @@ derive bimap CONS ...@@ -67,10 +63,13 @@ derive bimap CONS
derive bimap RECORD derive bimap RECORD
derive bimap FIELD derive bimap FIELD
derive bimap (->) derive bimap (->)
derive bimap Bimap
// HACK: dictionaries for all generics. // HACK: dictionaries for all generics.
// It works since all generic classes have only one method and do not inherit // It works since all generic classes have only one method and do not inherit
// from other classes // from other classes
:: GenericDict a = { generic_dict :: !a } :: GenericDict a = { generic_dict :: !a }
:: GenericDict0 a = { generic_dict0 :: a } :: GenericDict0 a = { generic_dict0 :: a }
// embedding-projection
:: Bimap a b = { map_to :: .(a -> b), map_from :: .(b -> a) } // deprecated, no longer used
bimapId :: Bimap .a .a // deprecated, no longer used
...@@ -2,60 +2,24 @@ implementation module StdGeneric ...@@ -2,60 +2,24 @@ implementation module StdGeneric
import StdInt, StdMisc, StdClass, StdFunc import StdInt, StdMisc, StdClass, StdFunc
generic bimap a b :: Bimap .a .b generic bimap a b | bimap b a :: .a ->.b
bimapId :: Bimap .a .a bimap{|c|} x = x
bimapId = { map_to = id, map_from = id }
bimap{|c|} = { map_to = id, map_from = id }
bimap{|PAIR|} bx by = { map_to= map_to, map_from=map_from }
where
map_to (PAIR x y) = PAIR (bx.map_to x) (by.map_to y)
map_from (PAIR x y) = PAIR (bx.map_from x) (by.map_from y)
bimap{|EITHER|} bl br = { map_to= map_to, map_from=map_from } bimap{|PAIR|} fx _ fy _ (PAIR x y) = PAIR (fx x) (fy y)
where
map_to (LEFT x) = LEFT (bl.map_to x)
map_to (RIGHT x) = RIGHT (br.map_to x)
map_from (LEFT x) = LEFT (bl.map_from x)
map_from (RIGHT x) = RIGHT (br.map_from x)
bimap{|(->)|} barg bres = { map_to = map_to, map_from = map_from } bimap{|EITHER|} fl _ fr _ (LEFT x) = LEFT (fl x)
where bimap{|EITHER|} fl _ fr _ (RIGHT x) = RIGHT (fr x)
map_to f = comp3 bres.map_to f barg.map_from
map_from f = comp3 bres.map_from f barg.map_to
bimap{|CONS|} barg = { map_to= map_to, map_from=map_from } bimap{|CONS|} fx _ (CONS x) = CONS (fx x)
where
map_to (CONS x) = CONS (barg.map_to x)
map_from (CONS x) = CONS (barg.map_from x)
bimap{|RECORD|} barg = { map_to= map_to, map_from=map_from } bimap{|RECORD|} fx _ (RECORD x) = RECORD (fx x)
where
map_to (RECORD x) = RECORD (barg.map_to x)
map_from (RECORD x) = RECORD (barg.map_from x)
bimap{|FIELD|} barg = { map_to= map_to, map_from=map_from } bimap{|FIELD|} fx _ (FIELD x) = FIELD (fx x)
where
map_to (FIELD x) = FIELD (barg.map_to x)
map_from (FIELD x) = FIELD (barg.map_from x)
bimap{|OBJECT|} barg = { map_to= map_to, map_from=map_from } bimap{|OBJECT|} fx _ (OBJECT x) = OBJECT (fx x)
where
map_to (OBJECT x) = OBJECT (barg.map_to x)
map_from (OBJECT x) = OBJECT (barg.map_from x)
bimap{|Bimap|} x y = {map_to = map_to, map_from = map_from} bimap{|(->)|} _ ba fr _ f = comp3 fr f ba
where
map_to {map_to, map_from} =
{ map_to = comp3 y.map_to map_to x.map_from
, map_from = comp3 x.map_to map_from y.map_from
}
map_from {map_to, map_from} =
{ map_to = comp3 y.map_from map_to x.map_to
, map_from = comp3 x.map_from map_from y.map_to
}
comp3 :: !(.a -> .b) u:(.c -> .a) !(.d -> .c) -> u:(.d -> .b) comp3 :: !(.a -> .b) u:(.c -> .a) !(.d -> .c) -> u:(.d -> .b)
comp3 f g h comp3 f g h
...@@ -95,4 +59,6 @@ where ...@@ -95,4 +59,6 @@ where
= [ ConsLeft : doit i (n/2) ] = [ ConsLeft : doit i (n/2) ]
| otherwise | otherwise
= [ ConsRight : doit (i - (n/2)) (n - (n/2)) ] = [ ConsRight : doit (i - (n/2)) (n - (n/2)) ]
\ No newline at end of file bimapId :: Bimap .a .a // deprecated, no longer used
bimapId = { map_to = id, map_from = id }
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment