1 implementation module GenFMap
3 import StdGeneric, StdEnv, StdMaybe, _Array, GenMonad
10 | FMEither .(FMap v) .(FMap v)
11 | FMChar .[.(Char, .FMap v)]
12 | FMInt .[.(Int, .FMap v)]
13 | FMReal .[.(Real, .FMap v)]
18 lookupAssocList :: k v [(k,v)] -> v | == k
19 lookupAssocList key default_val [] = default_val
20 lookupAssocList key default_val [(k,v):xs]
23 = lookupAssocList key default_val xs
25 updateAssocList :: k v v [(k,v)] -> (v, [(k,v)]) | == k
26 updateAssocList key value default_val [] = (default_val, [(key, value)])
27 updateAssocList key value default_val [(k,v):xs]
29 = (v, [(k, value):xs])
30 #! (old_val, xs) = updateAssocList key value default_val xs
31 = (old_val, [(k, v) : xs])
33 derive bimap FMap, Maybe
34 bimap{|{}|} bma = {map_to = mapArray bma.map_to, map_from = mapArray bma.map_from}
36 generic gLookupFMap key :: key (FMap value) -> FMap value
37 gLookupFMap{|Char|} key (FMChar xs) = lookupAssocList key FMEmpty xs
38 gLookupFMap{|Char|} key FMEmpty = FMEmpty
40 gLookupFMap{|Int|} key (FMInt xs) = lookupAssocList key FMEmpty xs
41 gLookupFMap{|Int|} key FMEmpty = FMEmpty
43 gLookupFMap{|Real|} key (FMReal xs) = lookupAssocList key FMEmpty xs
44 gLookupFMap{|Real|} key FMEmpty = FMEmpty
46 gLookupFMap{|Bool|} False (FMEither ls rs) = ls
47 gLookupFMap{|Bool|} True (FMEither ls rs) = rs
48 gLookupFMap{|Bool|} key FMEmpty = FMEmpty
50 //gLookupFMap{|UNIT|} key (FMValue v) = (FMValue v)
51 //gLookupFMap{|UNIT|} key FMEmpty = FMEmpty
52 gLookupFMap{|UNIT|} key fm = fm
54 gLookupFMap{|PAIR|} fx fy (PAIR kx ky) fm = fy ky (fx kx fm)
56 gLookupFMap{|EITHER|} fl fr (LEFT key) (FMEither ls rs) = fl key ls
57 gLookupFMap{|EITHER|} fl fr (RIGHT key) (FMEither ls rs) = fr key rs
58 gLookupFMap{|EITHER|} fl fr key FMEmpty = FMEmpty
60 gLookupFMap{|CONS|} f (CONS key) fm = f key fm
61 gLookupFMap{|FIELD|} f (FIELD key) fm = f key fm
62 gLookupFMap{|OBJECT|} f (OBJECT key) fm = f key fm
66 gLookupFMap{|String|} arr fm = gLookupFMap{|*|} [x\\x<-:arr] fm
67 gLookupFMap{|{}|} f arr fm = gLookupFMap{|*->*|} f [x\\x<-:arr] fm
68 gLookupFMap{|{!}|} f arr fm = gLookupFMap{|*->*|} f [x\\x<-:arr] fm
70 derive gLookupFMap (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
72 lookupFMap :: !k .(FMap v) -> .(Maybe v) | gLookupFMap{|*|} k & bimap{|*|} v
73 lookupFMap key fmap = case gLookupFMap{|*|} key fmap of
76 _ -> abort "erroneous FMap"
79 //------------------------------------------------------------------------------------
81 generic gInsertFMap key :: key (FMap value, FMap value) -> (FMap value, FMap value)
83 gInsertFMap{|Char|} key (new_val, FMChar xs)
84 # (old_val, xs) = updateAssocList key new_val FMEmpty xs
85 = (old_val, FMChar xs)
86 gInsertFMap{|Char|} key (new_val, FMEmpty)
87 = (FMEmpty, FMChar [(key, new_val)])
89 gInsertFMap{|Int|} key (new_val, FMInt xs)
90 # (old_val, xs) = updateAssocList key new_val FMEmpty xs
92 gInsertFMap{|Int|} key (new_val, FMEmpty)
93 = (FMEmpty, FMInt [(key, new_val)])
95 gInsertFMap{|Real|} key (new_val, FMReal xs)
96 # (old_val, xs) = updateAssocList key new_val FMEmpty xs
97 = (old_val, FMReal xs)
98 gInsertFMap{|Real|} key (new_val, FMEmpty)
99 = (FMEmpty, FMReal [(key, new_val)])
101 gInsertFMap{|Bool|} False (v, FMEither ls rs) = (ls, FMEither v rs)
102 gInsertFMap{|Bool|} False (v, FMEmpty) = (FMEmpty, FMEither v FMEmpty)
103 gInsertFMap{|Bool|} True (v, FMEither ls rs) = (rs, FMEither ls v)
104 gInsertFMap{|Bool|} True (v, FMEmpty) = (FMEmpty, FMEither FMEmpty v)
106 gInsertFMap{|UNIT|} key (x, y) = (y, x)
108 gInsertFMap{|PAIR|} fx fy (PAIR kx ky) (new_val, fmx)
109 #! (old_fmy, fmx1) = fx kx (FMEmpty, fmx)
110 #! (old_val, new_fmy) = fy ky (new_val, old_fmy)
111 #! (empty_fmy, new_fmx) = fx kx (new_fmy, fmx)
114 gInsertFMap{|EITHER|} fl fr (LEFT key) (v, FMEither ls rs)
115 # (old_val, new_ls) = fl key (v,ls)
116 = (old_val, FMEither new_ls rs)
117 gInsertFMap{|EITHER|} fl fr (LEFT key) (v, FMEmpty)
118 # (old_val, new_ls) = fl key (v,FMEmpty)
119 = (FMEmpty, FMEither new_ls FMEmpty)
120 gInsertFMap{|EITHER|} fl fr (RIGHT key) (v, FMEither ls rs)
121 # (old_val, new_rs) = fr key (v,rs)
122 = (old_val, FMEither ls new_rs)
123 gInsertFMap{|EITHER|} fl fr (RIGHT key) (v, FMEmpty)
124 # (old_val, new_rs) = fr key (v,FMEmpty)
125 = (FMEmpty, FMEither FMEmpty new_rs)
127 gInsertFMap{|CONS|} f (CONS key) x = f key x
128 gInsertFMap{|FIELD|} f (FIELD key) x = f key x
129 gInsertFMap{|OBJECT|} f (OBJECT key) x = f key x
131 derive gInsertFMap []
133 gInsertFMap{|String|} xs fm = gInsertFMap{|*|} [x\\x<-:xs] fm
134 gInsertFMap{|{}|} f xs fm = gInsertFMap{|*->*|} f [x\\x<-:xs] fm
135 gInsertFMap{|{!}|} f xs fm = gInsertFMap{|*->*|} f [x\\x<-:xs] fm
137 derive gInsertFMap (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
139 (<<=) infixl 1 :: .(FMap v) !.(k,v) -> FMap v | gInsertFMap{|*|} k & bimap{|*|} v
140 (<<=) fmap (key, value)
141 #! (old_val, fmap) = gInsertFMap{|*|} key (FMValue value, fmap)
144 //-----------------------------------------------------------------------------
152 Start = lookupFMap "two" fmap