Verified Commit 40d65ed5 authored by Camil Staps's avatar Camil Staps 🐧

Merge remote-tracking branch 'git-svn'

parents 1539a360 d57c1b24
definition module StdGeneric
// embedding-projection
:: Bimap a b = { map_to :: .(a -> b), map_from :: .(b -> a) }
bimapId :: Bimap .a .a
// generic representation
:: UNIT = UNIT
:: EITHER a b = LEFT a | RIGHT b
:: PAIR a b = PAIR a b
// for constructor information
:: OBJECT a = OBJECT a // object marking
:: OBJECT a =: OBJECT a // object marking
:: CONS a = CONS a // constructor marking
:: RECORD a = RECORD a // record marking
:: FIELD a = FIELD a // record field marking
:: FIELD a =: FIELD a // record field marking
:: GenericTypeDefDescriptor =
{ gtd_name :: String
......@@ -57,7 +53,7 @@ bimapId :: Bimap .a .a
getConsPath :: !GenericConsDescriptor -> [ConsPos]
// generic bidirectional mapping
generic bimap a b :: Bimap .a .b
generic bimap a b | bimap b a :: .a ->.b
derive bimap c
derive bimap PAIR
......@@ -67,10 +63,13 @@ derive bimap CONS
derive bimap RECORD
derive bimap FIELD
derive bimap (->)
derive bimap Bimap
// HACK: dictionaries for all generics.
// It works since all generic classes have only one method and do not inherit
// from other classes
:: GenericDict a = { generic_dict :: !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
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
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{|c|} x = x
bimap{|EITHER|} bl br = { map_to= map_to, map_from=map_from }
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{|PAIR|} fx _ fy _ (PAIR x y) = PAIR (fx x) (fy y)
bimap{|(->)|} barg bres = { map_to = map_to, map_from = map_from }
where
map_to f = comp3 bres.map_to f barg.map_from
map_from f = comp3 bres.map_from f barg.map_to
bimap{|EITHER|} fl _ fr _ (LEFT x) = LEFT (fl x)
bimap{|EITHER|} fl _ fr _ (RIGHT x) = RIGHT (fr x)
bimap{|CONS|} barg = { map_to= map_to, map_from=map_from }
where
map_to (CONS x) = CONS (barg.map_to x)
map_from (CONS x) = CONS (barg.map_from x)
bimap{|CONS|} fx _ (CONS x) = CONS (fx x)
bimap{|RECORD|} barg = { map_to= map_to, map_from=map_from }
where
map_to (RECORD x) = RECORD (barg.map_to x)
map_from (RECORD x) = RECORD (barg.map_from x)
bimap{|RECORD|} fx _ (RECORD x) = RECORD (fx x)
bimap{|FIELD|} barg = { map_to= map_to, map_from=map_from }
where
map_to (FIELD x) = FIELD (barg.map_to x)
map_from (FIELD x) = FIELD (barg.map_from x)
bimap{|FIELD|} fx _ (FIELD x) = FIELD (fx x)
bimap{|OBJECT|} barg = { map_to= map_to, map_from=map_from }
where
map_to (OBJECT x) = OBJECT (barg.map_to x)
map_from (OBJECT x) = OBJECT (barg.map_from x)
bimap{|OBJECT|} fx _ (OBJECT x) = OBJECT (fx x)
bimap{|Bimap|} x y = {map_to = map_to, map_from = map_from}
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
}
bimap{|(->)|} _ ba fr _ f = comp3 fr f ba
comp3 :: !(.a -> .b) u:(.c -> .a) !(.d -> .c) -> u:(.d -> .b)
comp3 f g h
......@@ -95,4 +59,6 @@ where
= [ ConsLeft : doit i (n/2) ]
| otherwise
= [ 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