Commit 9c652777 authored by John van Groningen's avatar John van Groningen

add generic constructor RECORD, change GenericInfo

parent a9c0ed5d
......@@ -9,41 +9,42 @@ bimapId :: Bimap .a .a
:: EITHER a b = LEFT a | RIGHT b
:: PAIR a b = PAIR a b
// recursion (not yet used)
:: REC a = REC a // recursion mark
// for constructor information
:: 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
:: GenericInfo = NoGenericInfo
| GenericConsInfo GenericConsDescriptor
| GenericFieldInfo GenericFieldDescriptor
| GenericTypeDefInfo GenericTypeDefDescriptor
:: GenericTypeDefDescriptor =
{ gtd_name :: String
, gtd_arity :: Int
, gtd_num_conses :: Int
, gtd_conses :: [GenericConsDescriptor]
}
:: GenericConsDescriptor =
{ gcd_name :: String
, gcd_arity :: Int
, gcd_prio :: GenConsPrio // priority and associativity
, gcd_type_def :: GenericTypeDefDescriptor // type def of the constructor
, gcd_type :: GenType // type of the constructor
, gcd_fields :: [GenericFieldDescriptor] // non-empty for records
, gcd_index :: Int // index of the contructor in the type def
, gcd_prio :: GenConsPrio // priority and associativity
, gcd_type_def :: GenericTypeDefDescriptor // type def of the constructor
, gcd_type :: GenType // type of the constructor
, gcd_index :: Int // index of the contructor in the type def
}
:: GenConsPrio = GenConsNoPrio | GenConsPrio GenConsAssoc Int
:: GenConsAssoc = GenConsAssocNone | GenConsAssocLeft | GenConsAssocRight
:: GenericRecordDescriptor =
{ grd_name :: String
, grd_arity :: Int
, grd_type_arity:: Int // arity of the type
, grd_type :: GenType // type of the constructor
, grd_fields :: [String]
}
:: GenericFieldDescriptor =
{ gfd_name :: String
, gfd_index :: Int // index of the field in the record
, gfd_cons :: GenericConsDescriptor // the record constructor
}
:: GenericTypeDefDescriptor =
{ gtd_name :: String
, gtd_arity :: Int
, gtd_num_conses :: Int
, gtd_conses :: [GenericConsDescriptor]
, gfd_cons :: GenericRecordDescriptor // the record constructor
}
:: GenType = GenTypeCons String
......@@ -54,7 +55,7 @@ bimapId :: Bimap .a .a
// determine the path in the generic binary-sum-tree of a constructor
:: ConsPos = ConsLeft | ConsRight
getConsPath :: !GenericConsDescriptor -> [ConsPos]
// generic bidirectional mapping
generic bimap a b :: Bimap .a .b
......@@ -63,6 +64,7 @@ derive bimap PAIR
derive bimap EITHER
derive bimap OBJECT
derive bimap CONS
derive bimap RECORD
derive bimap FIELD
derive bimap (->)
derive bimap Bimap
......@@ -70,4 +72,4 @@ derive bimap Bimap
// HACK: dictionary 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 }
\ No newline at end of file
:: GenericDict a = { generic_dict :: !a }
......@@ -12,7 +12,8 @@ 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)
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 }
where
map_to (LEFT x) = LEFT (bl.map_to x)
......@@ -30,6 +31,11 @@ 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 }
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 }
where
map_to (FIELD x) = FIELD (barg.map_to x)
......
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