building extensions in new source format

src/GF/Devel/Grammar/Lookup.hs

@@ -59,15 +59,19 @@ lookupParamValues gf m c = do
 
 -- infrastructure for lookup
     
-lookupIdent :: GF -> Ident -> Ident -> Err (Either Judgement Ident)
+lookupModule :: GF -> Ident -> Err Module
+lookupModule gf m = do
+  maybe (raise "module not found") return $ mlookup m (gfmodules gf)
+
+lookupIdent :: GF -> Ident -> Ident -> Err JEntry
 lookupIdent gf m c = do
-  mo <- maybe (raise "module not found") return $ mlookup m (gfmodules gf)
+  mo <- lookupModule gf m
   maybe (Bad "constant not found") return $ mlookup c (mjments mo)
 
 lookupJudgement :: GF -> Ident -> Ident -> Err Judgement
 lookupJudgement gf m c = do
   eji <- lookupIdent gf m c
-  either return (\n -> lookupJudgement gf n c) eji 
+  either return (\n -> lookupJudgement gf (fst n) c) eji 
 
 mlookup = Data.Map.lookup
 

src/GF/Devel/Grammar/Modules.hs

@@ -35,22 +35,27 @@ data Module = Module {
   mextends    :: [(Ident,MInclude)],
   mopens      :: [(Ident,Ident)],           -- used name, original name
   mflags      :: Map Ident String,
-  mjments     :: Map Ident (Either Judgement Indirection) -- def or indirection
+  mjments     :: MapJudgement 
   }
 
 emptyModule :: Ident -> Module
 emptyModule m = Module MTGrammar [] [] [] [] empty empty
 
+type MapJudgement = Map Ident JEntry -- def or indirection
+
 isCompleteModule :: Module -> Bool
 isCompleteModule = Prelude.null . minterfaces 
 
-listJudgements :: Module -> [(Ident,Either Judgement Indirection)]
+listJudgements :: Module -> [(Ident,JEntry)]
 listJudgements = assocs . mjments
 
+type JEntry = Either Judgement Indirection
+
 data ModuleType =
     MTAbstract
   | MTConcrete Ident
   | MTGrammar 
+  deriving Eq
 
 data MInclude =
     MIAll
@@ -59,3 +64,18 @@ data MInclude =
 
 type Indirection = (Ident,Bool) -- module of origin, whether canonical
 
+isConstructorEntry :: Either Judgement Indirection -> Bool
+isConstructorEntry ji = case ji of
+  Left j -> isConstructor j
+  Right i -> snd i
+
+isConstructor :: Judgement -> Bool
+isConstructor j = jdef j == EData
+
+isInherited :: MInclude -> Ident -> Bool
+isInherited mi i = case mi of
+  MIExcept is -> notElem i is
+  MIOnly is -> elem i is
+  _ -> True
+
+