import command now gives priority to new abstract syntax, and discards the old concretes if they are for the old abstract; the new priority is implemented in PGF.Data.unionPGF

1 files changed, 17 insertions, 5 deletions

diff --git a/src/runtime/haskell/PGF/Data.hs b/src/runtime/haskell/PGF/Data.hs
index 3e26cbd98..e97b8701e 100644
--- a/src/runtime/haskell/PGF/Data.hs
+++ b/src/runtime/haskell/PGF/Data.hs
@@ -79,12 +79,16 @@ data Alternative =
 -- merge two PGFs; fails is differens absnames; priority to second arg
 
 unionPGF :: PGF -> PGF -> PGF
-unionPGF one two = case absname one of
-  n | n == wildCId     -> two    -- extending empty grammar
-    | n == absname two -> one {  -- extending grammar with same abstract
+unionPGF one two = fst $ msgUnionPGF one two
+
+msgUnionPGF :: PGF -> PGF -> (PGF, Maybe String)
+msgUnionPGF one two = case absname one of
+  n | n == wildCId     -> (two, Nothing)    -- extending empty grammar
+    | n == absname two && haveSameFunsPGF one two -> (one { -- extending grammar with same abstract
       concretes = Map.union (concretes two) (concretes one)
-    }
-  _ -> one   -- abstracts don't match ---- print error msg
+    }, Nothing)
+  _ -> (two, -- abstracts don't match, discard the old one  -- error msg in Importing.ioUnionPGF
+        Just "Abstract changed, previous concretes discarded.")
 
 emptyPGF :: PGF
 emptyPGF = PGF {
@@ -94,6 +98,14 @@ emptyPGF = PGF {
   concretes = Map.empty
   }
 
+-- sameness of function type signatures, checked when importing a new concrete in env
+haveSameFunsPGF :: PGF -> PGF -> Bool
+haveSameFunsPGF one two = 
+  let 
+    fsone = [(f,t) | (f,(t,_,_,_)) <- Map.toList (funs (abstract one))]
+    fstwo = [(f,t) | (f,(t,_,_,_)) <- Map.toList (funs (abstract two))]
+  in fsone == fstwo
+
 -- | This is just a 'CId' with the language name.
 -- A language name is the identifier that you write in the 
 -- top concrete or abstract module in GF after the