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

src/compiler/GF/Command/Commands.hs

@@ -436,7 +436,8 @@ allCommands env@(pgf, mos) = Map.fromList [
      synopsis = "import a grammar from source code or compiled .pgf file",
      explanation = unlines [
        "Reads a grammar from File and compiles it into a GF runtime grammar.",
-       "If a grammar with the same concrete name is already in the state",
+       "If its abstract is different from current state, old modules are discarded.",
+       "If its abstract is the same and a concrete with the same name is already in the state",
        "it is overwritten - but only if compilation succeeds.",
        "The grammar parser depends on the file name suffix:",
        "  .cf    context-free (labelled BNF) source",
@@ -588,6 +589,7 @@ allCommands env@(pgf, mos) = Map.fromList [
        ("cats",   "show just the names of abstract syntax categories"),
        ("fullform", "print the fullform lexicon"),
        ("funs",   "show just the names and types of abstract syntax functions"),
+       ("langs",  "show just the names of top concrete syntax modules"),
        ("lexc", "print the lexicon in Xerox LEXC format"),
        ("missing","show just the names of functions that have no linearization"),
        ("opt",    "optimize the generated pgf"),
@@ -1169,6 +1171,8 @@ allCommands env@(pgf, mos) = Map.fromList [
      | isOpt "cats"     opts = return $ fromString $ unwords $ map showCId $ categories pgf
      | isOpt "funs"     opts = return $ fromString $ unlines $ map showFun $ funsigs pgf
      | isOpt "fullform" opts = return $ fromString $ concatMap (morpho "" prFullFormLexicon) $ optLangs opts
+     | isOpt "langs"    opts = return $ fromString $ unwords $ map showCId $ languages pgf
+  
      | isOpt "lexc"     opts = return $ fromString $ concatMap (morpho "" prLexcLexicon) $ optLangs opts
      | isOpt "missing"  opts = return $ fromString $ unlines $ [unwords (showCId la:":": map showCId cs) | 
                                                                   la <- optLangs opts, let cs = missingLins pgf la]

src/compiler/GF/Command/Importing.hs

@@ -30,14 +30,19 @@ importGrammar pgf0 opts files =
     s | elem s [".gf",".gfo"] -> do
       res <- appIOE $ compileToPGF opts files
       case res of
-        Ok pgf2 -> do return $ unionPGF pgf0 pgf2
+        Ok pgf2 -> ioUnionPGF pgf0 pgf2
         Bad msg -> do putStrLn ('\n':'\n':msg)
                       return pgf0
     ".pgf" -> do
       pgf2 <- mapM readPGF files >>= return . foldl1 unionPGF
-      return $ unionPGF pgf0 pgf2
+      ioUnionPGF pgf0 pgf2
     ext -> die $ "Unknown filename extension: " ++ show ext
 
+ioUnionPGF :: PGF -> PGF -> IO PGF
+ioUnionPGF one two = case msgUnionPGF one two of
+  (pgf, Just msg) -> putStrLn msg >> return pgf
+  (pgf,_)         -> return pgf
+
 importSource :: SourceGrammar -> Options -> [FilePath] -> IO SourceGrammar
 importSource src0 opts files = do
   src <- appIOE $ batchCompile opts files

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
+unionPGF one two = fst $ msgUnionPGF one two
-  n | n == wildCId     -> two    -- extending empty grammar
+
-    | n == absname two -> one {  -- extending grammar with same abstract
+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)
-    }
+    }, Nothing)
-  _ -> one   -- abstracts don't match ---- print error msg
+  _ -> (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