Comorphism.hs revision a9183ce3b997bf3539e427b3cd22d70c3565446e
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
a9de0a2f34860a24f457c777e740b7e87e6e3827Christian Maeder{-# LANGUAGE UndecidableInstances #-}
306763c67bb99228487345b32ab8c5c6cd41f23cChristian MaederModule : $Header$
3a6c7a7ff823616f56cd3d205fc44664a683effdChristian MaederDescription : interface and class for logic translations
6ea54752d184beb92c92fbae17ae9f7dd065d988Christian MaederCopyright : (c) Till Mossakowski, Uni Bremen 2002-2006
97018cf5fa25b494adffd7e9b4e87320dae6bf47Christian MaederLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
2eeec5240b424984e3ee26296da1eeab6c6d739eChristian MaederMaintainer : till@informatik.uni-bremen.de
306763c67bb99228487345b32ab8c5c6cd41f23cChristian MaederStability : provisional
306763c67bb99228487345b32ab8c5c6cd41f23cChristian MaederPortability : non-portable (via Logic)
9f87aabedf02d74917d94fe1ac0300e07d3d4bc2Christian MaederCentral interface (type class) for logic translations (comorphisms) in Hets
44fb55f639914f4f531641f32dd4904f15c510a4Till Mossakowski These are just collections of
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski functions between (some of) the types of logics.
af0cbe339851fc558d2b18cde3666981325e667cTill Mossakowski References: see Logic.hs
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder ( CompComorphism (..)
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder , InclComorphism
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder , inclusion_logic
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder , inclusion_source_sublogic
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder , inclusion_target_sublogic
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder , mkInclComorphism
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder , mkIdComorphism
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder , Comorphism (..)
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder , targetSublogic
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder , ext_map_sign
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder , mapDefaultMorphism
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder , wrapMapTheory
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder , simpleTheoryMapping
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder , mkTheoryMapping
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder , AnyComorphism (..)
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder , idComorphism
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder , isIdComorphism
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder , isModelTransportable
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder , hasModelExpansion
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder , isWeaklyAmalgamable
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder , compComorphism
63324a97283728a30932828a612c7b0b0f687624Christian Maederimport qualified Data.Set as Set
59fa9b1349ae1e001d996da732c4ac805c2938e2Christian Maederclass (Language cid,
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski Logic lid1 sublogics1
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski basic_spec1 sentence1 symb_items1 symb_map_items1
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski sign1 morphism1 symbol1 raw_symbol1 proof_tree1,
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski Logic lid2 sublogics2
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder basic_spec2 sentence2 symb_items2 symb_map_items2
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski sign2 morphism2 symbol2 raw_symbol2 proof_tree2) =>
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski Comorphism cid
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski lid1 sublogics1 basic_spec1 sentence1 symb_items1 symb_map_items1
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski sign1 morphism1 symbol1 raw_symbol1 proof_tree1
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski lid2 sublogics2 basic_spec2 sentence2 symb_items2 symb_map_items2
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski sign2 morphism2 symbol2 raw_symbol2 proof_tree2
3a87487c048b275c56e502c4a933273788e8d0bbChristian Maeder | cid -> lid1 sublogics1 basic_spec1 sentence1 symb_items1 symb_map_items1
2b565fe5cfb9f99857fd25b52304758d8544e266Mihai Codescu sign1 morphism1 symbol1 raw_symbol1 proof_tree1
2b565fe5cfb9f99857fd25b52304758d8544e266Mihai Codescu lid2 sublogics2 basic_spec2 sentence2 symb_items2 symb_map_items2
2b565fe5cfb9f99857fd25b52304758d8544e266Mihai Codescu sign2 morphism2 symbol2 raw_symbol2 proof_tree2
2ecf6cfb90e84d40f224cda5d92c191182c976d2Till Mossakowski -- source and target logic and sublogic
2ecf6cfb90e84d40f224cda5d92c191182c976d2Till Mossakowski -- the source sublogic is the maximal one for which the comorphism works
4184cb191a9081cb2a9cf3ef5f060f56f0ca5922Till Mossakowski sourceLogic :: cid -> lid1
8731f7b93b26083dc34a2c0937cd6493b42f2c2cTill Mossakowski sourceSublogic :: cid -> sublogics1
4184cb191a9081cb2a9cf3ef5f060f56f0ca5922Till Mossakowski targetLogic :: cid -> lid2
2ecf6cfb90e84d40f224cda5d92c191182c976d2Till Mossakowski -- finer information of target sublogics corresponding to source sublogics
bba825b39570777866d560bfde3807731131097eKlaus Luettich -- this function must be partial because mapTheory is partial
bba825b39570777866d560bfde3807731131097eKlaus Luettich mapSublogic :: cid -> sublogics1 -> Maybe sublogics2
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder -- the translation functions are partial
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski -- because the target may be a sublanguage
a89e661aad28f1b39f4fc9f9f9a4d46074234123Christian Maeder -- map_basic_spec :: cid -> basic_spec1 -> Result basic_spec2
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski -- cover theoroidal comorphisms as well
5d6e7ea3bd14fc987436cff0f542393ea9ba34bbTill Mossakowski map_theory :: cid -> (sign1,[Named sentence1])
a89e661aad28f1b39f4fc9f9f9a4d46074234123Christian Maeder -> Result (sign2,[Named sentence2])
a89e661aad28f1b39f4fc9f9f9a4d46074234123Christian Maeder map_morphism :: cid -> morphism1 -> Result morphism2
a89e661aad28f1b39f4fc9f9f9a4d46074234123Christian Maeder map_sentence :: cid -> sign1 -> sentence1 -> Result sentence2
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski -- also covers semi-comorphisms
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski -- with no sentence translation
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski -- - but these are spans!
b60a22e76e983e8129c5dae4d713fe2794ed7054Christian Maeder map_sentence = failMapSentence
0647a6c86b231e391826c7715338ba29cb4934c0Christian Maeder map_symbol :: cid -> symbol1 -> Set.Set symbol2
b60a22e76e983e8129c5dae4d713fe2794ed7054Christian Maeder map_symbol = errMapSymbol
a975722baf6fee1ca3e67df170c732c4abd0a945Christian Maeder extractModel :: cid -> sign1 -> proof_tree2
a975722baf6fee1ca3e67df170c732c4abd0a945Christian Maeder -> Result (sign1, [Named sentence1])
a975722baf6fee1ca3e67df170c732c4abd0a945Christian Maeder extractModel cid _ _ = fail
a975722baf6fee1ca3e67df170c732c4abd0a945Christian Maeder $ "extractModel not implemented for comorphism "
63324a97283728a30932828a612c7b0b0f687624Christian Maeder ++ language_name cid
a98fd29a06e80e447af26d898044c23497adbc73Mihai Codescu --properties of comorphisms
a98fd29a06e80e447af26d898044c23497adbc73Mihai Codescu is_model_transportable :: cid -> Bool
a98fd29a06e80e447af26d898044c23497adbc73Mihai Codescu -- a comorphism (\phi, \alpha, \beta) is model-transportable
b4e202184f6977662c439c82866fe93f06cebe41Christian Maeder -- if for any signature \Sigma,
830e14495f9cac8e154dd4813dae010166f33d09Mihai Codescu -- any \Sigma-model M and any \phi(\Sigma)-model N
a98fd29a06e80e447af26d898044c23497adbc73Mihai Codescu -- for any isomorphism h : \beta_\Sigma(N) -> M
a98fd29a06e80e447af26d898044c23497adbc73Mihai Codescu -- there exists an isomorphism h': N -> M' such that \beta_\Sigma(h') = h
f2c050360525df494e6115073b0edc4c443a847cMihai Codescu is_model_transportable _ = False
b60a22e76e983e8129c5dae4d713fe2794ed7054Christian Maeder has_model_expansion :: cid -> Bool
f2c050360525df494e6115073b0edc4c443a847cMihai Codescu has_model_expansion _ = False
b60a22e76e983e8129c5dae4d713fe2794ed7054Christian Maeder is_weakly_amalgamable :: cid -> Bool
f2c050360525df494e6115073b0edc4c443a847cMihai Codescu is_weakly_amalgamable _ = False
0e51a998b1b213654c7a9eca451562041971f100Till Mossakowski constituents :: cid -> [String]
0e51a998b1b213654c7a9eca451562041971f100Till Mossakowski constituents cid = [language_name cid]
b60a22e76e983e8129c5dae4d713fe2794ed7054Christian Maeder isInclusionComorphism :: cid -> Bool
b60a22e76e983e8129c5dae4d713fe2794ed7054Christian Maeder isInclusionComorphism _ = False
5c358300e78157f4bfaf5415c70e1096a9205b61Christian MaedertargetSublogic :: Comorphism cid
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder lid1 sublogics1 basic_spec1 sentence1 symb_items1 symb_map_items1
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder sign1 morphism1 symbol1 raw_symbol1 proof_tree1
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder lid2 sublogics2 basic_spec2 sentence2 symb_items2 symb_map_items2
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder sign2 morphism2 symbol2 raw_symbol2 proof_tree2
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder => cid -> sublogics2
da955132262baab309a50fdffe228c9efe68251dCui JiantargetSublogic cid = maybe (error ("Logic.Comorphism: " ++
da955132262baab309a50fdffe228c9efe68251dCui Jian language_name cid ++
bba825b39570777866d560bfde3807731131097eKlaus Luettich " does not provide a mapping for it's " ++
da955132262baab309a50fdffe228c9efe68251dCui Jian "source sublogic"))
bba825b39570777866d560bfde3807731131097eKlaus Luettich id $ mapSublogic cid $ sourceSublogic cid
9f87aabedf02d74917d94fe1ac0300e07d3d4bc2Christian Maeder-- | this function is base on 'map_theory' using no sentences as input
19298cbfd6ee2abd904f3181af7760b965b822c3Christian Maedermap_sign :: Comorphism cid
19298cbfd6ee2abd904f3181af7760b965b822c3Christian Maeder lid1 sublogics1 basic_spec1 sentence1 symb_items1 symb_map_items1
19298cbfd6ee2abd904f3181af7760b965b822c3Christian Maeder sign1 morphism1 symbol1 raw_symbol1 proof_tree1
19298cbfd6ee2abd904f3181af7760b965b822c3Christian Maeder lid2 sublogics2 basic_spec2 sentence2 symb_items2 symb_map_items2
19298cbfd6ee2abd904f3181af7760b965b822c3Christian Maeder sign2 morphism2 symbol2 raw_symbol2 proof_tree2
19298cbfd6ee2abd904f3181af7760b965b822c3Christian Maeder => cid -> sign1 -> Result (sign2,[Named sentence2])
9f87aabedf02d74917d94fe1ac0300e07d3d4bc2Christian Maedermap_sign cid sign = wrapMapTheory cid (sign,[])
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maederext_map_sign :: Comorphism cid
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder lid1 sublogics1 basic_spec1 sentence1 symb_items1 symb_map_items1
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder sign1 morphism1 symbol1 raw_symbol1 proof_tree1
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder lid2 sublogics2 basic_spec2 sentence2 symb_items2 symb_map_items2
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder sign2 morphism2 symbol2 raw_symbol2 proof_tree2
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder => cid -> ExtSign sign1 symbol1
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder -> Result (ExtSign sign2 symbol2, [Named sentence2])
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maederext_map_sign cid (ExtSign sign _) = do
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder (sign2, sens2) <- map_sign cid sign
64e1905404e5135e98a26d2ab4150b6764956576Christian Maeder return (makeExtSign (targetLogic cid) sign2, sens2)
5c358300e78157f4bfaf5415c70e1096a9205b61Christian MaedermapDefaultMorphism :: Comorphism cid
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder lid1 sublogics1 basic_spec1 sentence1 symb_items1 symb_map_items1
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder sign1 morphism1 symbol1 raw_symbol1 proof_tree1
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder lid2 sublogics2 basic_spec2 sentence2 symb_items2 symb_map_items2
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder sign2 morphism2 symbol2 raw_symbol2 proof_tree2
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder => cid -> morphism1 -> Result morphism2
5c358300e78157f4bfaf5415c70e1096a9205b61Christian MaedermapDefaultMorphism cid mor = do
4c7f058cdd19ce67b2b5d4b7f69703d0f8a21e38Christian Maeder (sig1, _) <- map_sign cid $ dom mor
4c7f058cdd19ce67b2b5d4b7f69703d0f8a21e38Christian Maeder (sig2, _) <- map_sign cid $ cod mor
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder inclusion (targetLogic cid) sig1 sig2
5c358300e78157f4bfaf5415c70e1096a9205b61Christian MaederfailMapSentence :: Comorphism cid
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder lid1 sublogics1 basic_spec1 sentence1 symb_items1 symb_map_items1
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder sign1 morphism1 symbol1 raw_symbol1 proof_tree1
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder lid2 sublogics2 basic_spec2 sentence2 symb_items2 symb_map_items2
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder sign2 morphism2 symbol2 raw_symbol2 proof_tree2
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder => cid -> sign1 -> sentence1 -> Result sentence2
5c358300e78157f4bfaf5415c70e1096a9205b61Christian MaederfailMapSentence cid _ _ =
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder fail $ "Unsupported sentence translation " ++ show cid
5c358300e78157f4bfaf5415c70e1096a9205b61Christian MaedererrMapSymbol :: Comorphism cid
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder lid1 sublogics1 basic_spec1 sentence1 symb_items1 symb_map_items1
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder sign1 morphism1 symbol1 raw_symbol1 proof_tree1
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder lid2 sublogics2 basic_spec2 sentence2 symb_items2 symb_map_items2
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder sign2 morphism2 symbol2 raw_symbol2 proof_tree2
5c358300e78157f4bfaf5415c70e1096a9205b61Christian Maeder => cid -> symbol1 -> Set.Set symbol2
5c358300e78157f4bfaf5415c70e1096a9205b61Christian MaedererrMapSymbol cid _ = error $ "no symbol mapping for " ++ show cid
9f87aabedf02d74917d94fe1ac0300e07d3d4bc2Christian Maeder-- | use this function instead of 'map_theory'
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian MaederwrapMapTheory :: Comorphism cid
6ea54752d184beb92c92fbae17ae9f7dd065d988Christian Maeder lid1 sublogics1 basic_spec1 sentence1 symb_items1 symb_map_items1
6ea54752d184beb92c92fbae17ae9f7dd065d988Christian Maeder sign1 morphism1 symbol1 raw_symbol1 proof_tree1
6ea54752d184beb92c92fbae17ae9f7dd065d988Christian Maeder lid2 sublogics2 basic_spec2 sentence2 symb_items2 symb_map_items2
6ea54752d184beb92c92fbae17ae9f7dd065d988Christian Maeder sign2 morphism2 symbol2 raw_symbol2 proof_tree2
6ea54752d184beb92c92fbae17ae9f7dd065d988Christian Maeder => cid -> (sign1, [Named sentence1])
6ea54752d184beb92c92fbae17ae9f7dd065d988Christian Maeder -> Result (sign2, [Named sentence2])
6ea54752d184beb92c92fbae17ae9f7dd065d988Christian MaederwrapMapTheory cid (sign, sens) =
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder case sourceSublogic cid of
9f87aabedf02d74917d94fe1ac0300e07d3d4bc2Christian Maeder sub -> case minSublogic sign of
9f87aabedf02d74917d94fe1ac0300e07d3d4bc2Christian Maeder sigLog -> case foldl join sigLog
9f87aabedf02d74917d94fe1ac0300e07d3d4bc2Christian Maeder $ map (minSublogic . sentence) sens of
9f87aabedf02d74917d94fe1ac0300e07d3d4bc2Christian Maeder if isSubElem senLog sub
6ea54752d184beb92c92fbae17ae9f7dd065d988Christian Maeder then map_theory cid (sign, sens)
6ea54752d184beb92c92fbae17ae9f7dd065d988Christian Maeder else fail $ "for '" ++ language_name cid ++
6ea54752d184beb92c92fbae17ae9f7dd065d988Christian Maeder "' expected sublogic '" ++
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder sublogicName sub ++
6ea54752d184beb92c92fbae17ae9f7dd065d988Christian Maeder "'\n but found sublogic '" ++
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder sublogicName senLog ++
6ea54752d184beb92c92fbae17ae9f7dd065d988Christian Maeder "' with signature sublogic '" ++
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder sublogicName sigLog ++ "'\n" ++
9f87aabedf02d74917d94fe1ac0300e07d3d4bc2Christian Maeder show (vcat $ pretty sign : map
9f87aabedf02d74917d94fe1ac0300e07d3d4bc2Christian Maeder (print_named $ sourceLogic cid) sens)
53310804002cd9e3c9c5844db3b984abcf001788Christian MaedersimpleTheoryMapping :: (sign1 -> sign2) -> (sentence1 -> sentence2)
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder -> (sign1, [Named sentence1])
19298cbfd6ee2abd904f3181af7760b965b822c3Christian Maeder -> (sign2, [Named sentence2])
53310804002cd9e3c9c5844db3b984abcf001788Christian MaedersimpleTheoryMapping mapSig mapSen (sign,sens) =
19298cbfd6ee2abd904f3181af7760b965b822c3Christian Maeder (mapSig sign, map (mapNamed mapSen) sens)
19298cbfd6ee2abd904f3181af7760b965b822c3Christian MaedermkTheoryMapping :: (Monad m) => (sign1 -> m (sign2, [Named sentence2]))
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder -> (sign1 -> sentence1 -> m sentence2)
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder -> (sign1, [Named sentence1])
19298cbfd6ee2abd904f3181af7760b965b822c3Christian Maeder -> m (sign2, [Named sentence2])
19298cbfd6ee2abd904f3181af7760b965b822c3Christian MaedermkTheoryMapping mapSig mapSen (sign,sens) = do
19298cbfd6ee2abd904f3181af7760b965b822c3Christian Maeder (sign',sens') <- mapSig sign
19298cbfd6ee2abd904f3181af7760b965b822c3Christian Maeder sens'' <- mapM (mapNamedM $ mapSen sign) sens
a129422b14eea673dc481d2553cec108e35e72efChristian Maeder return (sign', nameAndDisambiguate $ sens' ++ sens'')
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederdata InclComorphism lid sublogics = InclComorphism
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder { inclusion_logic :: lid
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder , inclusion_source_sublogic :: sublogics
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder , inclusion_target_sublogic :: sublogics }
eb0e19a83d8e3eaeb936c197555b20d37129022cKlaus Luettich-- | construction of an identity comorphism
eb0e19a83d8e3eaeb936c197555b20d37129022cKlaus LuettichmkIdComorphism :: (Logic lid sublogics
eb0e19a83d8e3eaeb936c197555b20d37129022cKlaus Luettich basic_spec sentence symb_items symb_map_items
eb0e19a83d8e3eaeb936c197555b20d37129022cKlaus Luettich sign morphism symbol raw_symbol proof_tree) =>
6ca6ffc92f5c0058ae4b92d46e4e8cbc7beb11fcMihai Codescu lid -> sublogics -> InclComorphism lid sublogics
556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaedermkIdComorphism lid sub = InclComorphism
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder { inclusion_logic = lid
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder , inclusion_source_sublogic = sub
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder , inclusion_target_sublogic = sub }
eb0e19a83d8e3eaeb936c197555b20d37129022cKlaus Luettich-- | construction of an inclusion comorphism
eb0e19a83d8e3eaeb936c197555b20d37129022cKlaus LuettichmkInclComorphism :: (Logic lid sublogics
eb0e19a83d8e3eaeb936c197555b20d37129022cKlaus Luettich basic_spec sentence symb_items symb_map_items
eb0e19a83d8e3eaeb936c197555b20d37129022cKlaus Luettich sign morphism symbol raw_symbol proof_tree,
da955132262baab309a50fdffe228c9efe68251dCui Jian lid -> sublogics -> sublogics
eb0e19a83d8e3eaeb936c197555b20d37129022cKlaus Luettich -> m (InclComorphism lid sublogics)
eb0e19a83d8e3eaeb936c197555b20d37129022cKlaus LuettichmkInclComorphism lid srcSub trgSub =
da955132262baab309a50fdffe228c9efe68251dCui Jian if isSubElem srcSub trgSub
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder then return $ InclComorphism
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder { inclusion_logic = lid
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder , inclusion_source_sublogic = srcSub
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder , inclusion_target_sublogic = trgSub }
da955132262baab309a50fdffe228c9efe68251dCui Jian else fail ("mkInclComorphism: first sublogic must be a "++
eb0e19a83d8e3eaeb936c197555b20d37129022cKlaus Luettich "subElem of the second sublogic")
797595aad6dfd626bc1c9df52616f1ac4235c669Till Mossakowskiinstance Logic lid sublogics
797595aad6dfd626bc1c9df52616f1ac4235c669Till Mossakowski basic_spec sentence symb_items symb_map_items
797595aad6dfd626bc1c9df52616f1ac4235c669Till Mossakowski sign morphism symbol raw_symbol proof_tree =>
eb0e19a83d8e3eaeb936c197555b20d37129022cKlaus Luettich Show (InclComorphism lid sublogics)
797595aad6dfd626bc1c9df52616f1ac4235c669Till Mossakowski show = language_name
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowskiinstance Logic lid sublogics
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski basic_spec sentence symb_items symb_map_items
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski sign morphism symbol raw_symbol proof_tree =>
eb0e19a83d8e3eaeb936c197555b20d37129022cKlaus Luettich Language (InclComorphism lid sublogics) where
eb0e19a83d8e3eaeb936c197555b20d37129022cKlaus Luettich language_name (InclComorphism lid sub_src sub_trg) =
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder let sblName = sublogicName sub_src in
da955132262baab309a50fdffe228c9efe68251dCui Jian if sub_src == sub_trg
da955132262baab309a50fdffe228c9efe68251dCui Jian then "id_" ++ language_name lid ++
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder if null sblName
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder then "" else "." ++ sblName
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder else "incl_" ++ language_name lid ++ ":" ++
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder sblName ++ "->" ++ sublogicName sub_trg
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowskiinstance Logic lid sublogics
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski basic_spec sentence symb_items symb_map_items
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski sign morphism symbol raw_symbol proof_tree =>
6ca6ffc92f5c0058ae4b92d46e4e8cbc7beb11fcMihai Codescu Comorphism (InclComorphism lid sublogics)
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski lid sublogics
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski basic_spec sentence symb_items symb_map_items
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski sign morphism symbol raw_symbol proof_tree
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski lid sublogics
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski basic_spec sentence symb_items symb_map_items
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder sign morphism symbol raw_symbol proof_tree
eb0e19a83d8e3eaeb936c197555b20d37129022cKlaus Luettich sourceLogic = inclusion_logic
eb0e19a83d8e3eaeb936c197555b20d37129022cKlaus Luettich targetLogic = inclusion_logic
eb0e19a83d8e3eaeb936c197555b20d37129022cKlaus Luettich sourceSublogic = inclusion_source_sublogic
3fb8a83c3c06671ee94fd12a1782b14563d09df1Christian Maeder mapSublogic cid subl =
3fb8a83c3c06671ee94fd12a1782b14563d09df1Christian Maeder if isSubElem subl $ inclusion_source_sublogic cid
3fb8a83c3c06671ee94fd12a1782b14563d09df1Christian Maeder then Just subl
19298cbfd6ee2abd904f3181af7760b965b822c3Christian Maeder map_theory _ = return
a89e661aad28f1b39f4fc9f9f9a4d46074234123Christian Maeder map_morphism _ = return
a89e661aad28f1b39f4fc9f9f9a4d46074234123Christian Maeder map_sentence _ = \_ -> return
da955132262baab309a50fdffe228c9efe68251dCui Jian constituents cid =
da955132262baab309a50fdffe228c9efe68251dCui Jian if inclusion_source_sublogic cid
da955132262baab309a50fdffe228c9efe68251dCui Jian == inclusion_target_sublogic cid
da955132262baab309a50fdffe228c9efe68251dCui Jian else [language_name cid]
a98fd29a06e80e447af26d898044c23497adbc73Mihai Codescu is_model_transportable _ = True
f2c050360525df494e6115073b0edc4c443a847cMihai Codescu has_model_expansion _ = True
f2c050360525df494e6115073b0edc4c443a847cMihai Codescu is_weakly_amalgamable _ = True
b60a22e76e983e8129c5dae4d713fe2794ed7054Christian Maeder isInclusionComorphism _ = True
d85e3f253f6af237c4b70bbfacb1bfecb5cfa678Christian Maederdata CompComorphism cid1 cid2 = CompComorphism cid1 cid2 deriving Show
ca8550c6d47234042130bdc10a152806ecbc9832Christian Maederinstance (Language cid1, Language cid2)
d85e3f253f6af237c4b70bbfacb1bfecb5cfa678Christian Maeder => Language (CompComorphism cid1 cid2) where
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder language_name (CompComorphism cid1 cid2) =
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder language_name cid1 ++ ";" ++ language_name cid2
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowskiinstance (Comorphism cid1
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski lid1 sublogics1 basic_spec1 sentence1 symb_items1 symb_map_items1
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski sign1 morphism1 symbol1 raw_symbol1 proof_tree1
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski lid2 sublogics2 basic_spec2 sentence2 symb_items2 symb_map_items2
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder sign2 morphism2 symbol2 raw_symbol2 proof_tree2,
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski Comorphism cid2
d85e3f253f6af237c4b70bbfacb1bfecb5cfa678Christian Maeder lid4 sublogics4 basic_spec4 sentence4 symb_items4 symb_map_items4
d85e3f253f6af237c4b70bbfacb1bfecb5cfa678Christian Maeder sign4 morphism4 symbol4 raw_symbol4 proof_tree4
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski lid3 sublogics3 basic_spec3 sentence3 symb_items3 symb_map_items3
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski sign3 morphism3 symbol3 raw_symbol3 proof_tree3)
d85e3f253f6af237c4b70bbfacb1bfecb5cfa678Christian Maeder => Comorphism (CompComorphism cid1 cid2)
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski lid1 sublogics1 basic_spec1 sentence1 symb_items1 symb_map_items1
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski sign1 morphism1 symbol1 raw_symbol1 proof_tree1
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski lid3 sublogics3 basic_spec3 sentence3 symb_items3 symb_map_items3
d85e3f253f6af237c4b70bbfacb1bfecb5cfa678Christian Maeder sign3 morphism3 symbol3 raw_symbol3 proof_tree3 where
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder sourceLogic (CompComorphism cid1 _) =
f7819aa9d183836144a98c70d4fa7d65e31cb513Till Mossakowski sourceLogic cid1
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder targetLogic (CompComorphism _ cid2) =
f7819aa9d183836144a98c70d4fa7d65e31cb513Till Mossakowski targetLogic cid2
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder sourceSublogic (CompComorphism cid1 _) =
8731f7b93b26083dc34a2c0937cd6493b42f2c2cTill Mossakowski sourceSublogic cid1
bba825b39570777866d560bfde3807731131097eKlaus Luettich mapSublogic (CompComorphism cid1 cid2) sl =
da955132262baab309a50fdffe228c9efe68251dCui Jian mapSublogic cid1 sl >>=
da955132262baab309a50fdffe228c9efe68251dCui Jian (\ y -> mapSublogic cid2 $
bba825b39570777866d560bfde3807731131097eKlaus Luettich forceCoerceSublogic (targetLogic cid1) (sourceLogic cid2) y)
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder map_sentence (CompComorphism cid1 cid2) =
e9249d3ecd51a2b6a966a58669953e58d703adc6Till Mossakowski do (si2,_) <- map_sign cid1 si1
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder se2 <- map_sentence cid1 si1 se1
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder (si2', se2') <- coerceBasicTheory
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder (targetLogic cid1) (sourceLogic cid2)
c44c23429c72f3a709e22a18f2ed6f05fc8cc765Christian Maeder "Mapping sentence along comorphism" (si2, [makeNamed "" se2])
922819b1c2d383a0fa5d70e1c4aa76667e2f1ca3Christian Maeder [x] -> map_sentence cid2 si2' $ sentence x
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder map_theory (CompComorphism cid1 cid2) =
5bb3727ef464d9f08ab0decb2d4a59c1352a389eChristian Maeder do ti2 <- map_theory cid1 ti1
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder ti2' <- coerceBasicTheory (targetLogic cid1) (sourceLogic cid2)
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder "Mapping theory along comorphism" ti2
6ea54752d184beb92c92fbae17ae9f7dd065d988Christian Maeder wrapMapTheory cid2 ti2'
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder map_morphism (CompComorphism cid1 cid2) = \ m1 ->
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder do m2 <- map_morphism cid1 m1
922819b1c2d383a0fa5d70e1c4aa76667e2f1ca3Christian Maeder m3 <- coerceMorphism (targetLogic cid1) (sourceLogic cid2)
9d34a8049237647d0188ee2ec88db2dc45f1f848Till Mossakowski "Mapping signature morphism along comorphism"m2
d85e3f253f6af237c4b70bbfacb1bfecb5cfa678Christian Maeder map_morphism cid2 m3
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder map_symbol (CompComorphism cid1 cid2) = \ s1 ->
922819b1c2d383a0fa5d70e1c4aa76667e2f1ca3Christian Maeder let mycast = coerceSymbol (targetLogic cid1) (sourceLogic cid2)
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder (map (map_symbol cid2 . mycast)
0647a6c86b231e391826c7715338ba29cb4934c0Christian Maeder (Set.toList (map_symbol cid1 s1)))
a975722baf6fee1ca3e67df170c732c4abd0a945Christian Maeder extractModel (CompComorphism cid1 cid2) sign pt3 =
63324a97283728a30932828a612c7b0b0f687624Christian Maeder if isIdComorphism (Comorphism cid1) then do
63324a97283728a30932828a612c7b0b0f687624Christian Maeder let lid1 = sourceLogic cid1
63324a97283728a30932828a612c7b0b0f687624Christian Maeder lid4 = sourceLogic cid2
a975722baf6fee1ca3e67df170c732c4abd0a945Christian Maeder (sign', _) <- coerceBasicTheory lid1 lid4 "extractModel1" (sign, [])
a975722baf6fee1ca3e67df170c732c4abd0a945Christian Maeder (sign'', sens') <- extractModel cid2 sign' pt3
a975722baf6fee1ca3e67df170c732c4abd0a945Christian Maeder bTh <- coerceBasicTheory lid4 lid1 "extractModel2" (sign'', sens')
63324a97283728a30932828a612c7b0b0f687624Christian Maeder else fail $ "extractModel not implemented for comorphism composition with"
63324a97283728a30932828a612c7b0b0f687624Christian Maeder ++ language_name cid1
53310804002cd9e3c9c5844db3b984abcf001788Christian Maeder constituents (CompComorphism cid1 cid2) =
933baca0720dae81434de384b32a93b47e754d09Christian Maeder constituents cid1 ++ constituents cid2
da955132262baab309a50fdffe228c9efe68251dCui Jian is_model_transportable (CompComorphism cid1 cid2) =
a98fd29a06e80e447af26d898044c23497adbc73Mihai Codescu is_model_transportable cid1 && is_model_transportable cid2
da955132262baab309a50fdffe228c9efe68251dCui Jian has_model_expansion (CompComorphism cid1 cid2) =
f2c050360525df494e6115073b0edc4c443a847cMihai Codescu has_model_expansion cid1 && has_model_expansion cid2
da955132262baab309a50fdffe228c9efe68251dCui Jian is_weakly_amalgamable (CompComorphism cid1 cid2) =
da955132262baab309a50fdffe228c9efe68251dCui Jian is_weakly_amalgamable cid1 && is_weakly_amalgamable cid2
b60a22e76e983e8129c5dae4d713fe2794ed7054Christian Maeder isInclusionComorphism (CompComorphism cid1 cid2) =
b60a22e76e983e8129c5dae4d713fe2794ed7054Christian Maeder isInclusionComorphism cid1 && isInclusionComorphism cid2
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder-- * Comorphisms and existential types for the logic graph
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder-- | Existential type for comorphisms
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederdata AnyComorphism = forall cid lid1 sublogics1
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder basic_spec1 sentence1 symb_items1 symb_map_items1
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder sign1 morphism1 symbol1 raw_symbol1 proof_tree1
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder lid2 sublogics2
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder basic_spec2 sentence2 symb_items2 symb_map_items2
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder sign2 morphism2 symbol2 raw_symbol2 proof_tree2 .
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder Comorphism cid
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder lid1 sublogics1 basic_spec1 sentence1
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder symb_items1 symb_map_items1
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder sign1 morphism1 symbol1 raw_symbol1 proof_tree1
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder lid2 sublogics2 basic_spec2 sentence2
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder symb_items2 symb_map_items2
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder sign2 morphism2 symbol2 raw_symbol2 proof_tree2 =>
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder Comorphism cid deriving Typeable -- used for GTheory
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederinstance Eq AnyComorphism where
a9183ce3b997bf3539e427b3cd22d70c3565446eChristian Maeder a == b = compare a b == EQ
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederinstance Ord AnyComorphism where
a9183ce3b997bf3539e427b3cd22d70c3565446eChristian Maeder compare (Comorphism cid1) (Comorphism cid2) = compare
a9183ce3b997bf3539e427b3cd22d70c3565446eChristian Maeder (language_name cid1, constituents cid1)
a9183ce3b997bf3539e427b3cd22d70c3565446eChristian Maeder (language_name cid2, constituents cid2)
a9183ce3b997bf3539e427b3cd22d70c3565446eChristian Maeder -- maybe needs to be refined, using comorphism translations?
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederinstance Show AnyComorphism where
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder show (Comorphism cid) = language_name cid
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder ++ " : " ++ language_name (sourceLogic cid)
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder ++ " -> " ++ language_name (targetLogic cid)
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederinstance Pretty AnyComorphism where
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder pretty = text . show
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder-- | compute the identity comorphism for a logic
556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaederidComorphism :: AnyLogic -> AnyComorphism
556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaederidComorphism (Logic lid) = Comorphism (mkIdComorphism lid (top_sublogic lid))
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder-- | Test whether a comporphism is the identity
556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaederisIdComorphism :: AnyComorphism -> Bool
556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaederisIdComorphism (Comorphism cid) =
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder constituents cid == []
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder-- * Properties of comorphisms
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder-- | Test whether a comorphism is model-transportable
556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaederisModelTransportable :: AnyComorphism -> Bool
556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaederisModelTransportable (Comorphism cid) = is_model_transportable cid
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder-- | Test whether a comorphism has model expansion
556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaederhasModelExpansion :: AnyComorphism -> Bool
556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaederhasModelExpansion (Comorphism cid) = has_model_expansion cid
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder-- | Test whether a comorphism is weakly amalgamable
556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaederisWeaklyAmalgamable :: AnyComorphism -> Bool
556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaederisWeaklyAmalgamable (Comorphism cid) = is_weakly_amalgamable cid
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder-- | Compose comorphisms
556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaedercompComorphism :: Monad m => AnyComorphism -> AnyComorphism -> m AnyComorphism
556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaedercompComorphism (Comorphism cid1) (Comorphism cid2) =
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder let l1 = targetLogic cid1
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder l2 = sourceLogic cid2
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder msg = "ogic mismatch in composition of " ++ language_name cid1
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder ++ " and " ++ language_name cid2
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder if language_name l1 == language_name l2 then
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder if isSubElem (forceCoerceSublogic l1 l2 $ targetSublogic cid1)
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder $ sourceSublogic cid2
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder then {- case (isIdComorphism cm1,isIdComorphism cm2) of
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder (True,_) -> return cm2
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder (_,True) -> return cm1
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder _ -> -} return $ Comorphism (CompComorphism cid1 cid2)
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder else fail $ "Subl" ++ msg
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder else fail $ "L" ++ msg