Working with interfaces and incomplete modules.

src/GF/Canon/CanonToGrammar.hs

@@ -31,7 +31,7 @@ canon2sourceModule (i,mi) = do
           M.MTResource -> return (i',M.MTResource) --- c' not needed
           M.MTTransfer x y -> return (i',M.MTTransfer x y) --- c' not needed
       defs   <- mapMTree redInfo $ M.jments m
-      return $ M.ModMod $ M.Module mt flags e os defs
+      return $ M.ModMod $ M.Module mt (M.mstatus m) flags e os defs
     _ -> Bad $ "cannot decompile module type"
   return (i',info')
  where
@@ -39,7 +39,7 @@ canon2sourceModule (i,mi) = do
      e' <- case M.extends m of
        Just e -> liftM Just $ redIdent e
        _ -> return Nothing
-     os' <- mapM (\ (M.OSimple i) -> liftM (\i -> M.OQualif i i) (redIdent i)) $ 
+     os' <- mapM (\ (M.OSimple q i) -> liftM (\i -> M.OQualif q i i) (redIdent i)) $ 
                  M.opens m
      return (e',os')
 

src/GF/Canon/GFC.cf

@@ -0,0 +1,151 @@
+-- top-level grammar
+
+-- Canonical GF. AR 27/4/2003
+
+entrypoints Canon ;
+
+Gr. Canon ::= [Module] ;
+
+Mod. Module ::= ModType "=" Extend Open "{" [Flag] [Def] "}" ;
+
+MTAbs. ModType ::= "abstract" Ident ; 
+MTCnc. ModType ::= "concrete" Ident "of" Ident ;
+MTRes. ModType ::= "resource" Ident ;
+MTTrans. ModType ::= "transfer" Ident ":" Ident "->" Ident ;
+
+separator Module "" ;
+
+Ext.   Extend ::= Ident "**" ;
+NoExt. Extend ::= ;
+
+NoOpens. Open ::= ;
+Opens.   Open ::= "open" [Ident] "in" ;
+
+
+-- judgements
+
+Flg.  Flag ::= "flags" Ident "=" Ident ;  --- to have the same res word as in GF
+
+AbsDCat.   Def ::= "cat" Ident "[" [Decl] "]" "=" [CIdent] ;
+AbsDFun.   Def ::= "fun" Ident ":" Exp "=" Exp ;
+AbsDTrans. Def ::= "transfer" Ident "=" Exp ;
+
+ResDPar.  Def ::= "param"  Ident "=" [ParDef] ;
+ResDOper. Def ::= "oper"   Ident ":" CType "=" Term ;
+
+CncDCat.  Def ::= "lincat" Ident "=" CType "=" Term ";" Term  ; 
+CncDFun.  Def ::= "lin"    Ident ":" CIdent "=" "\\" [ArgVar] "->" Term ";" Term ;
+
+AnyDInd.  Def ::= Ident Status "in" Ident ;
+
+ParD.     ParDef ::= Ident [CType] ;
+
+-- the canonicity of an indirected constant
+
+Canon.  Status ::= "data" ;
+NonCan. Status ::= ;
+
+-- names originating from resource modules: prefixed by the module name
+
+CIQ. CIdent ::= Ident "." Ident ;
+
+-- types and terms in abstract syntax; no longer type-annotated
+
+EApp.   Exp1 ::= Exp1 Exp2 ;
+EProd.  Exp  ::= "(" Ident ":" Exp ")" "->" Exp ;
+EAbs.   Exp  ::= "\\" Ident "->" Exp ;
+EAtom.  Exp2 ::= Atom ;
+EData.  Exp2 ::= "data" ;
+
+EEq.    Exp  ::= "{" [Equation] "}" ;  -- list of pattern eqs; primitive notion: []
+
+coercions Exp 2 ;
+
+SType.  Sort ::= "Type" ;
+
+Equ. Equation ::= [APatt] "->" Exp ;
+
+APC. APatt ::= "(" CIdent [APatt] ")" ;
+APV. APatt ::= Ident ;
+APS. APatt ::= String ;
+API. APatt ::= Integer ;
+APW. APatt ::= "_" ;
+
+separator Decl ";" ;
+terminator APatt "" ;
+terminator Equation ";" ;
+
+AC. Atom ::= CIdent ;
+AD. Atom ::= "<" CIdent ">" ;
+AV. Atom ::= "$" Ident ;
+AM. Atom ::= "?" Integer ;
+AS. Atom ::= String ;
+AI. Atom ::= Integer ;
+AT. Atom ::= Sort ;
+
+Decl. Decl ::= Ident ":" Exp ;
+
+
+-- types, terms, and patterns in concrete syntax
+
+RecType. CType ::= "{" [Labelling] "}" ;
+Table.   CType ::= "(" CType "=>" CType ")" ;
+Cn.      CType ::= CIdent ;
+TStr.    CType ::= "Str" ;
+
+Lbg.  Labelling ::= Label ":" CType ;
+
+Arg.  Term2 ::= ArgVar ;
+I.    Term2 ::= CIdent ; -- from resources
+Con.  Term2 ::= "<" CIdent [Term2] ">" ;
+LI.   Term2 ::= "$" Ident ;  -- from pattern variables
+
+R.    Term2 ::= "{" [Assign] "}" ;
+P.    Term1 ::= Term2 "." Label ;
+T.    Term1 ::= "table" CType "{" [Case] "}" ;
+S.    Term1 ::= Term1 "!" Term2 ;
+C.    Term  ::= Term "++" Term1 ;
+FV.   Term1 ::= "variants" "{" [Term2] "}" ;  --- no separator!
+
+K.    Term2 ::= Tokn ;
+E.    Term2 ::= "[" "]" ;
+
+KS.   Tokn  ::= String ;
+KP.   Tokn  ::= "[" "pre" [String] "{" [Variant] "}" "]" ;
+
+Ass.  Assign  ::= Label "=" Term ;
+Cas.  Case    ::= [Patt] "=>" Term ;
+Var.  Variant ::= [String] "/" [String] ;
+
+coercions Term 2 ;
+
+L.    Label  ::= Ident ;
+LV.   Label  ::= "$" Integer ;
+A.    ArgVar ::= Ident "@" Integer ;             -- no bindings
+AB.   ArgVar ::= Ident "+" Integer "@" Integer ; -- with a number of bindings
+
+PC.   Patt ::= "(" CIdent [Patt] ")" ;
+PV.   Patt ::= Ident ;
+PW.   Patt ::= "_" ;
+PR.   Patt ::= "{" [PattAssign] "}" ;
+
+PAss. PattAssign ::= Label "=" Patt ;
+
+--- here we use the new pragmas to generate list rules
+
+terminator Flag ";" ;
+terminator Def ";" ;
+separator ParDef "|" ;
+separator CType "" ;
+separator CIdent "" ;
+separator Assign ";" ;
+separator ArgVar "," ;
+separator Labelling ";" ;
+separator Case ";" ;
+separator Term2 "" ;
+separator String "" ;
+separator Variant ";" ;
+separator PattAssign ";" ;
+separator Patt "" ;
+separator Ident "," ;
+

src/GF/Canon/MkGFC.hs

@@ -21,29 +21,29 @@ canon2grammar (Gr modules) = M.MGrammar $ map mod2info modules where
             MTAbs a -> (a,M.MTAbstract)
             MTRes a -> (a,M.MTResource)
             MTCnc a x -> (a,M.MTConcrete x)
-            MTTrans a x y -> (a,M.MTTransfer (M.OSimple x) (M.OSimple y))
+            MTTrans a x y -> (a,M.MTTransfer (M.oSimple x) (M.oSimple y))
-      in (a,M.ModMod (M.Module mt' flags (ee e) (oo os) defs'))
+      in (a,M.ModMod (M.Module mt' M.MSComplete flags (ee e) (oo os) defs'))
   ee (Ext m) = Just m
   ee _ = Nothing
-  oo (Opens ms) = map M.OSimple ms
+  oo (Opens ms) = map M.oSimple ms
   oo _ = []
 
 grammar2canon :: CanonGrammar -> Canon
 grammar2canon (M.MGrammar modules) = Gr $ map info2mod modules 
 
 info2mod m = case m of
-    (a, M.ModMod (M.Module mt flags me os defs)) -> 
+    (a, M.ModMod (M.Module mt _ flags me os defs)) -> 
       let defs' = map info2def $ tree2list defs 
           mt'   = case mt of
              M.MTAbstract -> MTAbs a
              M.MTResource -> MTRes a
              M.MTConcrete x -> MTCnc a x
-             M.MTTransfer (M.OSimple x) (M.OSimple y) -> MTTrans a x y
+             M.MTTransfer (M.OSimple _ x) (M.OSimple _ y) -> MTTrans a x y
       in
         Mod mt' (gfcE me) (gfcO os) flags defs'
  where
   gfcE = maybe NoExt Ext
-  gfcO os = if null os then NoOpens else Opens [m | M.OSimple m <- os]
+  gfcO os = if null os then NoOpens else Opens [m | M.OSimple _ m <- os]
 
 
 -- these translations are meant to be trivial

src/GF/Canon/Share.hs

@@ -18,8 +18,8 @@ fullOpt = [2]
 
 shareModule :: OptSpec -> (Ident, CanonModInfo) -> (Ident, CanonModInfo)
 shareModule opt (i,m) = case m of
-  M.ModMod (M.Module mt fs me ops js) -> 
+  M.ModMod (M.Module mt st fs me ops js) -> 
-    (i,M.ModMod (M.Module mt fs me ops (mapTree (shareInfo opt) js)))
+    (i,M.ModMod (M.Module mt st fs me ops (mapTree (shareInfo opt) js)))
   _ -> (i,m)
 
 shareInfo opt (c, CncCat ty t m) = (c, CncCat ty (shareOpt opt t) m)

src/GF/Compile/CheckGrammar.hs

@@ -37,24 +37,28 @@ showCheckModule mos m = do
 checkModule :: [SourceModule] -> SourceModule -> Check [SourceModule]
 checkModule ms (name,mod) = checkIn ("checking module" +++ prt name) $ case mod of
 
-  ModMod mo@(Module mt fs me ops js) -> case mt of
+  ModMod mo@(Module mt st fs me ops js) -> do
-    MTAbstract -> do
+    js' <- case mt of
-      js' <- mapMTree (checkAbsInfo gr name) js
+      MTAbstract -> mapMTree (checkAbsInfo gr name) js
-      return $ (name, ModMod (Module mt fs me ops js')) : ms
 
-    MTTransfer a b -> do
+      MTTransfer a b -> mapMTree (checkAbsInfo gr name) js
-      js' <- mapMTree (checkAbsInfo gr name) js
-      return $ (name, ModMod (Module mt fs me ops js')) : ms
 
-    MTResource -> do
+      MTResource -> mapMTree (checkResInfo gr) js
-      js' <- mapMTree (checkResInfo gr) js
+
-      return $ (name, ModMod (Module mt fs me ops js')) : ms
+      MTConcrete a -> do
+        ModMod abs <- checkErr $ lookupModule gr a
+        checkCompleteGrammar abs mo
+        mapMTree (checkCncInfo gr name (a,abs)) js
+
+      MTInterface -> mapMTree (checkResInfo gr) js
+
+      MTInstance a -> do
+        ModMod abs <- checkErr $ lookupModule gr a
+        checkCompleteInstance abs mo
+        mapMTree (checkResInfo gr) js
+
+    return $ (name, ModMod (Module mt st fs me ops js')) : ms
 
-    MTConcrete a -> do
-      ModMod abs <- checkErr $ lookupModule gr a
-      checkCompleteGrammar abs mo
-      js' <- mapMTree (checkCncInfo gr name (a,abs)) js
-      return $ (name, ModMod (Module mt fs me ops js')) : ms
   _ -> return $ (name,mod) : ms
  where
    gr  = MGrammar $ (name,mod):ms
@@ -87,6 +91,18 @@ checkCompleteGrammar abs cnc = mapM_ checkWarn $
                       then id
                       else (("Warning: no linearization of" +++ prt f):)
 
+checkCompleteInstance :: SourceRes -> SourceRes -> Check ()
+checkCompleteInstance abs cnc = mapM_ checkWarn $
+  checkComplete [f | (f, ResOper (Yes _) _) <- abs'] cnc'
+   where
+     abs' = tree2list $ jments abs
+     cnc' = mapTree fst $ jments cnc
+     checkComplete sought given = foldr ckOne [] sought
+       where
+         ckOne f = if isInBinTree f given 
+                      then id
+                      else (("Warning: no definition given to" +++ prt f):)
+
 -- General Principle: only Yes-values are checked. 
 -- A May-value has always been checked in its origin module.
 

src/GF/Compile/Compile.hs

@@ -144,8 +144,7 @@ makeSourceModule opts env@(k,gr,can) mo@(i,mi) = case mi of
  where
    putp = putPointE opts
 
-compileSourceModule :: Options -> CompileEnv -> SourceModule -> 
+compileSourceModule :: Options -> CompileEnv -> SourceModule -> IOE (Int,SourceModule)
-                       IOE (Int,SourceModule)
 compileSourceModule opts env@(k,gr,can) mo@(i,mi) = do
 
   let putp = putPointE opts
@@ -158,7 +157,7 @@ compileSourceModule opts env@(k,gr,can) mo@(i,mi) = do
 
   (k',mo3r:_) <- ioeErr $ refreshModule (k,mos) mo3
 
-  mo4:_ <- putp "  optimizing" $ ioeErr $ evalModule mos mo3r
+  mo4:_ <- putp "  optimizing " $ ioeErr $ evalModule mos mo3r
 
   return (k',mo4)
 
@@ -172,16 +171,16 @@ generateModuleCode opts path minfo@(name,info) = do
 
   -- for resource, also emit gfr
   case info of
-    ModMod m | mtype m == MTResource && emit && nomulti -> do
+    ModMod m | isResourceModule info && isCompilableModule info && emit && nomulti -> do
       let (file,out) = (gfrFile pname, prGrammar (MGrammar [minfo]))
       ioeIO $ writeFile file out >> putStr ("  wrote file" +++ file)
     _ -> return ()
   (file,out) <- do
       code <- return $ MkGFC.prCanonModInfo minfo'
       return (gfcFile pname, code)
-  if emit && nomulti 
+  if isCompilableModule info && emit && nomulti 
      then ioeIO $ writeFile file out >> putStr ("  wrote file" +++ file)
-     else return ()
+     else ioeIO $ putStrFlush "no need to save for this module "
   return minfo'
  where 
    nomulti = not $ oElem makeMulti opts

src/GF/Compile/Extend.hs

@@ -17,10 +17,10 @@ import Monad
 
 extendModInfo :: Ident -> SourceModInfo -> SourceModInfo -> Err SourceModInfo
 extendModInfo name old new = case (old,new) of
-  (ModMod m0, ModMod (Module mt fs _ ops js)) -> do
+  (ModMod m0, ModMod (Module mt st fs _ ops js)) -> do
     testErr (mtype m0 == mt) ("illegal extension type at module" +++ show name)
     js' <- extendMod name (jments m0) js
-    return $ ModMod (Module mt fs Nothing ops js)
+    return $ ModMod (Module mt st fs Nothing ops js)
 
 -- this is what happens when extending a module: new information is inserted,
 -- and the process is interrupted if unification fails

src/GF/Compile/GrammarToCanon.hs

@@ -28,7 +28,10 @@ showGFC = err id id . liftM (P.printTree . grammar2canon) . redGrammar
 -- abstract syntax without dependent types
 
 redGrammar :: SourceGrammar -> Err C.CanonGrammar
-redGrammar (MGrammar gr) = liftM MGrammar $ mapM redModInfo gr
+redGrammar (MGrammar gr) = liftM MGrammar $ mapM redModInfo $ filter active gr where
+  active (_,m) = case typeOfModule m of
+    MTInterface -> False
+    _ -> True
 
 redModInfo :: (Ident, SourceModInfo) -> Err (Ident, C.CanonModInfo)
 redModInfo (c,info) = do
@@ -43,19 +46,25 @@ redModInfo (c,info) = do
            return (a', MTConcrete a') 
          MTAbstract -> return (c',MTAbstract) --- c' not needed
          MTResource -> return (c',MTResource) --- c' not needed
+         MTInterface -> return (c',MTResource) ---- not needed
+         MTInstance _ -> return (c',MTResource) --- c' not needed
          MTTransfer x y -> return (c',MTTransfer (om x) (om y)) --- c' not needed
-      defss <- mapM (redInfo a) $ tree2list $ jments m
+
+      ---- this generates empty GFC. Better: none 
+      let js = if mstatus m == MSIncomplete then NT else jments m
+
+      defss <- mapM (redInfo a) $ tree2list $ js
       defs  <- return $ sorted2tree $ concat defss  -- sorted, but reduced
-      return $ ModMod $ Module mt flags e os defs
+      return $ ModMod $ Module mt MSComplete flags e os defs
   return (c',info')
  where
    redExtOpen m = do
      e' <- case extends m of
        Just e -> liftM Just $ redIdent e
        _ -> return Nothing
-     os' <- mapM (\ (OQualif _ i) -> liftM OSimple (redIdent i)) $ opens m
+     os' <- mapM (\ (OQualif q _ i) -> liftM (OSimple q) (redIdent i)) $ opens m
      return (e',os')
-   om = OSimple . openedModule --- normalizing away qualif
+   om = oSimple . openedModule --- normalizing away qualif
 
 redInfo :: Ident -> (Ident,Info) -> Err [(Ident,C.Info)]
 redInfo am (c,info) = errIn ("translating definition of" +++ prt c) $ do

src/GF/Compile/MkResource.hs

@@ -30,7 +30,7 @@ makeReuse gr r me c = do
       _ -> prtBad "expected concrete to be the type of" c
     _ -> prtBad "expected concrete to be the type of" c
 
-  return $ Module MTResource flags me ops jms
+  return $ Module MTResource MSComplete flags me ops jms
 
 mkResDefs :: Ident -> Ident -> Maybe Ident -> Maybe Ident -> 
              BinTree (Ident,Info) -> BinTree (Ident,Info) -> 

src/GF/Compile/ModDeps.hs

@@ -39,7 +39,7 @@ checkUniqueErr ms = do
 
 checkUniqueImportNames :: [Ident] -> SourceModInfo -> Err ()
 checkUniqueImportNames ns mo = case mo of
-  ModMod m -> test [n | OQualif n v <- opens m, n /= v]
+  ModMod m -> test [n | OQualif _ n v <- opens m, n /= v]
 
  where
 
@@ -80,7 +80,7 @@ moduleDeps ms = mapM deps ms where
   -- check for superficial compatibility, not submodule relation etc
   compatMType mt0 mt = case (mt0,mt) of
     (MTConcrete _, MTConcrete _) -> True
-    (MTResourceImpl _, MTResourceImpl _) -> True
+    (MTInstance _, MTInstance _) -> True
     (MTReuse _, MTReuse _) -> True
     ---- some more
     _ -> mt0 == mt

src/GF/Compile/Optimize.hs

@@ -29,7 +29,7 @@ evalModule :: [(Ident,SourceModInfo)] -> (Ident,SourceModInfo) ->
                Err [(Ident,SourceModInfo)]
 evalModule ms mo@(name,mod) = case mod of
 
-  ModMod (Module mt fs me ops js) -> case mt of
+  ModMod (Module mt st fs me ops js) | st == MSComplete -> case mt of
     MTResource -> do
       let deps = allOperDependencies name js
       ids <- topoSortOpers deps
@@ -37,9 +37,10 @@ evalModule ms mo@(name,mod) = case mod of
       return $ mod' : ms
     MTConcrete a -> do
       js' <- mapMTree (evalCncInfo gr0 name a) js
-      return $ (name, ModMod (Module mt fs me ops js')) : ms
+      return $ (name, ModMod (Module mt st fs me ops js')) : ms
 
     _ -> return $ (name,mod):ms
+  _ -> return $ (name,mod):ms
  where
    gr0 = MGrammar $ ms
    gr  = MGrammar $ (name,mod) : ms

src/GF/Compile/RemoveLiT.hs

@@ -21,9 +21,9 @@ removeLiT gr = liftM MGrammar $ mapM (remlModule gr) (modules gr)
 
 remlModule :: SourceGrammar -> (Ident,SourceModInfo) -> Err (Ident,SourceModInfo)
 remlModule gr mi@(name,mod) = case mod of
-  ModMod (Module mt fs me ops js) -> do
+  ModMod (Module mt st fs me ops js) -> do
     js1 <- mapMTree (remlResInfo gr) js
-    let mod2 = ModMod $ Module mt fs me ops js1
+    let mod2 = ModMod $ Module mt st fs me ops js1
     return $ (name,mod2)
   _ -> return mi
 

src/GF/Compile/Rename.hs

@@ -32,17 +32,17 @@ renameSourceTerm g m t = do
 
 renameModule :: [SourceModule] -> SourceModule -> Err [SourceModule]
 renameModule ms (name,mod) = errIn ("renaming module" +++ prt name) $ case mod of
-  ModMod (Module mt fs me ops js) -> do
+  ModMod (Module mt st fs me ops js) -> do
     (_,mod1@(ModMod m)) <- extendModule ms (name,mod)
     let js1 = jments m
     status <- buildStatus (MGrammar ms) name mod1
     js2    <- mapMTree (renameInfo status) js1
-    let mod2 = ModMod $ Module mt fs me (map forceQualif ops) js2
+    let mod2 = ModMod $ Module mt st fs me (map forceQualif ops) js2
     return $ (name,mod2) : ms
 
 extendModule :: [SourceModule] -> SourceModule -> Err SourceModule
 extendModule ms (name,mod) = case mod of
-  ModMod (Module mt fs me ops js0) -> do
+  ModMod (Module mt st fs me ops js0) -> do
     js  <- case mt of
 {- --- building the {s : Str} lincat
       MTConcrete a -> do
@@ -62,7 +62,7 @@ extendModule ms (name,mod) = case mod of
           _ -> Bad $ "cannot find extended module" +++ prt n
         extendMod n (jments m0) js
       _ -> return js
-    return $ (name,ModMod (Module mt fs me ops js1))
+    return $ (name,ModMod (Module mt st fs me ops js1))
 
 
 type Status = (StatusTree, [(OpenSpec Ident, StatusTree)])
@@ -91,9 +91,9 @@ renameIdentTerm env@(act,imps) t =
     return $ f c
   _ -> return t
  where
-   opens   = act : [st  | (OSimple _,st) <- imps]
+   opens   = act : [st  | (OSimple _ _,st) <- imps]
-   qualifs = [(m, st) | (OQualif m _, st) <- imps] ++ 
+   qualifs = [(m, st) | (OQualif _ m _, st) <- imps] ++ 
-             [(m, st) | (OSimple m, st) <- imps] -- qualifying is always possible
+             [(m, st) | (OSimple _ m, st) <- imps] -- qualifying is always possible
 
 --- would it make sense to optimize this by inlining?
 renameIdentPatt :: Status -> Patt -> Err Patt
@@ -114,14 +114,14 @@ info2status mq (c,i) = (c, case i of
 
 tree2status :: OpenSpec Ident -> BinTree (Ident,Info) -> BinTree (Ident,StatusInfo)
 tree2status o = case o of
-  OSimple i   -> mapTree (info2status (Just i))
+  OSimple _ i   -> mapTree (info2status (Just i))
-  OQualif i j -> mapTree (info2status (Just j))
+  OQualif _ i j -> mapTree (info2status (Just j))
 
 buildStatus :: SourceGrammar -> Ident -> SourceModInfo -> Err Status
 buildStatus gr c mo = let mo' = self2status c mo in case mo of
   ModMod m -> do
     let gr1 = MGrammar $ (c,mo) : modules gr 
-        ops = [OSimple e | e <- allExtends gr1 c] ++ allOpens m
+        ops = [OSimple OQNormal e | e <- allExtends gr1 c] ++ allOpens m
     mods <- mapM (lookupModule gr1 . openedModule) ops
     let sts = map modInfo2status $ zip ops mods    
     return $ if isModCnc m
@@ -144,8 +144,8 @@ self2status c i = mapTree (info2status (Just c)) js where   -- qualify internal
     _ -> True
 
 forceQualif o = case o of
-  OSimple i   -> OQualif i i
+  OSimple q i   -> OQualif q i i
-  OQualif _ i -> OQualif i i
+  OQualif q _ i -> OQualif q i i
   
 renameInfo :: Status -> (Ident,Info) -> Err (Ident,Info)
 renameInfo status (i,info) = errIn ("renaming definition of" +++ prt i) $ 

src/GF/Grammar/Refresh.hs

@@ -86,9 +86,9 @@ refreshGrammar = liftM (MGrammar . snd) . foldM refreshModule (0,[]) . modules
 
 refreshModule :: (Int,[SourceModule]) -> SourceModule -> Err (Int,[SourceModule])
 refreshModule (k,ms) mi@(i,m) = case m of
-    ModMod mo@(Module mt fs me ops js) | (isModCnc mo || mt == MTResource) -> do
+    ModMod mo@(Module mt fs st me ops js) | (isModCnc mo || mt == MTResource) -> do
       (k',js') <- foldM refreshRes (k,[]) $ tree2list js
-      return (k', (i, ModMod(Module mt fs me ops (buildTree js'))) : ms)
+      return (k', (i, ModMod(Module mt fs st me ops (buildTree js'))) : ms)
     _ -> return (k, mi:ms)
  where
   refreshRes (k,cs) ci@(c,info) = case info of

src/GF/Infra/Modules.hs

@@ -18,11 +18,13 @@ data MGrammar i f a = MGrammar {modules :: [(i,ModInfo i f a)]}
 
 data ModInfo i f a =
     ModMainGrammar (MainGrammar i)
-  | ModMod (Module i f a)
+  | ModMod  (Module i f a)
+  | ModWith (ModuleType i) ModuleStatus i [OpenSpec i]
   deriving Show
 
 data Module i f a = Module {
     mtype   :: ModuleType i ,
+    mstatus :: ModuleStatus ,
     flags   :: [f] ,
     extends :: Maybe i ,
     opens   :: [OpenSpec i] ,
@@ -30,6 +32,20 @@ data Module i f a = Module {
   }
   deriving Show
 
+-- encoding the type of the module
+data ModuleType i = 
+    MTAbstract 
+  | MTTransfer (OpenSpec i) (OpenSpec i) 
+  | MTResource
+  | MTConcrete i
+
+  -- up to this, also used in GFC. Below, source only.
+
+  | MTInterface
+  | MTInstance i 
+  | MTReuse i
+  deriving (Eq,Show)
+
 -- destructive update
 
 --- dep order preserved since old cannot depend on new
@@ -41,8 +57,8 @@ updateMGrammar old new = MGrammar $
    ns = modules new
 
 updateModule :: Ord i => Module i f t -> i -> t -> Module i f t
-updateModule (Module  mt fs me ops js) i t = 
+updateModule (Module  mt ms fs me ops js) i t = 
-  Module mt fs me ops (updateTree (i,t) js)
+  Module mt ms fs me ops (updateTree (i,t) js)
 
 data MainGrammar i = MainGrammar {
     mainAbstract  :: i ,
@@ -58,13 +74,29 @@ data MainConcreteSpec i = MainConcreteSpec {
   }
   deriving Show
 
-data OpenSpec i = OSimple i | OQualif i i
+data OpenSpec i = 
+   OSimple OpenQualif i 
+ | OQualif OpenQualif i i
+  deriving (Eq,Show)
+
+data OpenQualif =
+   OQNormal
+ | OQInterface
+ | OQIncomplete
+  deriving (Eq,Show)
+
+oSimple = OSimple OQNormal
+oQualif = OQualif OQNormal
+
+data ModuleStatus = 
+   MSComplete 
+ | MSIncomplete 
   deriving (Eq,Show)
 
 openedModule :: OpenSpec i -> i
 openedModule o = case o of
-  OSimple m -> m
+  OSimple _ m -> m
-  OQualif _ m -> m
+  OQualif _ _ m -> m
 
 allOpens m = case mtype m of
   MTTransfer a b -> a : b : opens m
@@ -75,9 +107,9 @@ depPathModule :: Ord i => Module i f a -> [OpenSpec i]
 depPathModule m = fors m ++ exts m ++ opens m where
   fors m = case mtype m of
     MTTransfer i j -> [i,j]
-    MTConcrete i   -> [OSimple i]
+    MTConcrete i   -> [oSimple i]
     _              -> []
-  exts m = map OSimple $ maybe [] return $ extends m
+  exts m = map oSimple $ maybe [] return $ extends m
 
 -- all modules that a module extends, directly or indirectly
 allExtends :: (Show i,Ord i) => MGrammar i f a -> i -> [i]
@@ -89,7 +121,7 @@ allExtends gr i = case lookupModule gr i of
 
 -- initial search path: the nonqualified dependencies
 searchPathModule :: Ord i => Module i f a -> [i]
-searchPathModule m = [i | OSimple i <- depPathModule m]
+searchPathModule m = [i | OSimple _ i <- depPathModule m]
 
 -- a new module can safely be added to the end, since nothing old can depend on it
 addModule :: Ord i => 
@@ -108,27 +140,14 @@ data IdentM i = IdentM {
   }
   deriving (Eq,Show)
 
--- encoding the type of the module
-data ModuleType i = 
-    MTAbstract 
-  | MTTransfer (OpenSpec i) (OpenSpec i) 
-  | MTResource
-  | MTResourceInt
-  | MTResourceImpl i 
-  | MTConcrete i
-  | MTConcreteInt i i 
-  | MTConcreteImpl i i i
-  | MTReuse i
-  deriving (Eq,Show)
-
 typeOfModule mi = case mi of
   ModMod m -> mtype m
 
 isResourceModule mi = case typeOfModule mi of
   MTResource -> True
   MTReuse _ -> True
-  MTResourceInt -> True
+---  MTInterface -> True
-  MTResourceImpl _ -> True
+  MTInstance _ -> True
   _ -> False
 
 abstractOfConcrete :: (Show i, Eq i) => MGrammar i f a -> i -> Err i
@@ -187,3 +206,11 @@ isModTrans m = case mtype m of
 sameMType m n = case (m,n) of
   (MTConcrete _, MTConcrete _) -> True
   _ -> m == n
+
+-- don't generate code for interfaces and for incomplete modules
+isCompilableModule m = case m of
+  ModMod m -> case mtype m of
+    MTInterface -> False
+    _ -> mstatus m == MSComplete
+  _ -> False ---
+

src/GF/Infra/ReadFiles.hs

@@ -91,15 +91,17 @@ gfFile  = suffixFile "gf"
 
 importsOfFile :: String -> [FilePath]
 importsOfFile = 
+  drop 1 .                   -- ignore module name itself
   filter (not . spec) .      -- ignore keywords and special symbols
   unqual .                   -- take away qualifiers
   takeWhile (not . term) .   -- read until curly or semic
-  drop 2 .                   -- ignore keyword and module name
   lexs .                     -- analyse into lexical tokens
   unComm                     -- ignore comments before the headed line
  where
     term = flip elem ["{",";"]
-    spec = flip elem ["of", "open","in", ":", "->", "reuse", "=", "(", ")",",","**"]
+    spec = flip elem ["of", "open","in", ":", "->", "reuse", "=", "(", ")",",","**","with",
+                      "abstract","concrete","resource","transfer","interface","incomplete",
+                      "instance"]
     unqual ws = case ws of
       "(":q:ws' -> unqual ws'
       w:ws' -> w:unqual ws'

src/GF/Source/AbsGF.hs

@@ -5,7 +5,6 @@ import Ident --H
 -- Haskell module generated by the BNF converter, except --H
 
 -- newtype Ident = Ident String deriving (Eq,Ord,Show) --H
-
 newtype LString = LString String deriving (Eq,Ord,Show)
 data Grammar =
    Gr [ModDef]
@@ -13,17 +12,7 @@ data Grammar =
 
 data ModDef =
    MMain Ident Ident [ConcSpec]
- | MAbstract Ident Extend Opens [TopDef]
+ | MModule ComplMod ModType ModBody
- | MResource Ident Extend Opens [TopDef]
- | MResourceInt Ident Extend Opens [TopDef]
- | MResourceImp Ident Ident Opens [TopDef]
- | MConcrete Ident Ident Extend Opens [TopDef]
- | MConcreteInt Ident Ident Extend Opens [TopDef]
- | MConcreteImp Open Ident Ident
- | MTransfer Ident Open Open Extend Opens [TopDef]
- | MReuseAbs Ident Ident
- | MReuseCnc Ident Ident
- | MReuseAll Ident Extend Ident
   deriving (Eq,Ord,Show)
 
 data ConcSpec =
@@ -39,6 +28,21 @@ data Transfer =
  | TransferOut Open
   deriving (Eq,Ord,Show)
 
+data ModType =
+   MTAbstract Ident
+ | MTResource Ident
+ | MTInterface Ident
+ | MTConcrete Ident Ident
+ | MTInstance Ident Ident
+ | MTTransfer Ident Open Open
+  deriving (Eq,Ord,Show)
+
+data ModBody =
+   MBody Extend Opens [TopDef]
+ | MWith Ident [Open]
+ | MReuse Ident
+  deriving (Eq,Ord,Show)
+
 data Extend =
    Ext Ident
  | NoExt
@@ -51,7 +55,19 @@ data Opens =
 
 data Open =
    OName Ident
- | OQual Ident Ident
+ | OQualQO QualOpen Ident
+ | OQual QualOpen Ident Ident
+  deriving (Eq,Ord,Show)
+
+data ComplMod =
+   CMCompl
+ | CMIncompl
+  deriving (Eq,Ord,Show)
+
+data QualOpen =
+   QOCompl
+ | QOIncompl
+ | QOInterface
   deriving (Eq,Ord,Show)
 
 data Def =

src/GF/Source/CompileM.hs

@@ -1,141 +0,0 @@
-module CompileM where
-
-import Grammar
-import Ident
-import Option
-import PrGrammar
-import Update
-import Lookup
-import Modules
----import Rename
-
-import Operations
-import UseIO
-
-import Monad
-
-compileMGrammar :: Options -> SourceGrammar -> IOE SourceGrammar
-compileMGrammar opts sgr = do
-
-  ioeErr $ checkUniqueModuleNames sgr
-
-  deps <- ioeErr $ moduleDeps sgr
-
-  deplist <- either return 
-                 (\ms -> ioeBad $ "circular modules" +++ unwords (map show ms)) $ 
-                 topoTest deps
-
-  let deps' = closureDeps deps
-
-  foldM (compileModule opts deps' sgr) emptyMGrammar deplist
-
-checkUniqueModuleNames :: MGrammar i f a r c -> Err ()
-checkUniqueModuleNames gr = do
-  let ms = map fst $ tree2list $ modules gr
-      msg = checkUnique ms
-  if null msg then return () else Bad $ unlines msg
-
--- to decide what modules immediately depend on what, and check if the
--- dependencies are appropriate
-
-moduleDeps :: MGrammar i f a c r -> Err Dependencies
-moduleDeps gr = mapM deps $ tree2list $ modules gr where
-  deps (c,mi) = errIn ("checking dependencies of module" +++ prt c) $ case mi of
-    ModAbs m -> chDep (IdentM c MTAbstract) 
-                      (extends m) MTAbstract (opens m) MTAbstract
-    ModRes m -> chDep (IdentM c MTResource) 
-                      (extends m) MTResource (opens m) MTResource
-    ModCnc m -> do
-      a:ops <- case opens m of
-        os@(_:_) -> return os
-        _ -> Bad "no abstract indicated for concrete module"
-      aty <- lookupModuleType gr a
-      testErr (aty == MTAbstract) "the for-module is not an abstract syntax" 
-      chDep (IdentM c (MTConcrete a)) (extends m) MTResource ops MTResource
-
-  chDep it es ety os oty = do
-    ests <- mapM (lookupModuleType gr) es
-    testErr (all (==ety) ests) "inappropriate extension module type" 
-    osts <- mapM (lookupModuleType gr) os
-    testErr (all (==oty) osts) "inappropriate open module type" 
-    return (it, [IdentM e ety | e <- es] ++ [IdentM o oty | o <- os])
-
-type Dependencies = [(IdentM Ident,[IdentM Ident])]
-
----compileModule :: Options -> Dependencies -> SourceGrammar -> 
----                 CanonGrammar -> IdentM -> IOE CanonGrammar
-compileModule opts deps sgr cgr i = do
-  
-   let name = identM i 
-
-   testIfCompiled deps name
-
-   mi <- ioeErr $ lookupModule sgr name
-
-   mi' <- case typeM i of
-     -- previously compiled cgr used as symbol table
-     MTAbstract   -> compileAbstract cgr mi
-     MTResource   -> compileResource cgr mi
-     MTConcrete a -> compileConcrete a cgr mi 
-
-   ifIsOpt doOutput $ writeCanonFile name mi'
-
-   return $ addModule cgr name mi'
-
- where
-
-   ifIsOpt o f = if (oElem o opts) then f else return ()
-   doOutput    = iOpt "o"
-
-
-testIfCompiled :: Dependencies -> Ident -> IOE Bool
-testIfCompiled _ _ = return False ----
-
----writeCanonFile :: Ident -> CanonModInfo -> IOE ()
-writeCanonFile name mi' = ioeIO $ writeFile (canonFileName name) [] ----
-
-canonFileName n = n ++ ".gfc" ---- elsewhere!
-
----compileAbstract :: CanonGrammar -> SourceModInfo -> IOE CanonModInfo
-compileAbstract can (ModAbs m0) = do
-  let m1 = renameMAbstract m0
-{-
-  checkUnique
-  typeCheck
-  generateCode
-  addToCanon
--}
-  ioeBad "compile abs not yet"
-
----compileResource :: CanonGrammar -> SourceModInfo -> IOE CanonModInfo
-compileResource can md = do
-{-
-  checkUnique
-  typeCheck
-  topoSort
-  compileOpers -- conservative, since more powerful than lin
-  generateCode
-  addToCanon
--}
-  ioeBad "compile res not yet"
-
----compileConcrete :: Ident -> CanonGrammar -> SourceModInfo -> IOE CanonModInfo
-compileConcrete ab can md = do
-{-
-  checkUnique
-  checkComplete ab
-  typeCheck
-  topoSort
-  compileOpers
-  optimize
-  createPreservedOpers
-  generateCode
-  addToCanon
--}
-  ioeBad "compile cnc not yet"
-
-
--- to be imported
-
-closureDeps :: [(a,[a])] -> [(a,[a])]
-closureDeps ds = ds ---- fix-point iteration

src/GF/Source/GF.cf

@@ -0,0 +1,286 @@
+-- AR 2/5/2003, 14-16 o'clock, Torino
+
+entrypoints Grammar, ModDef, OldGrammar, Exp ; -- let's see if more are needed
+
+comment "--" ;
+comment "{-" "-}" ;
+
+-- the top-level grammar
+
+Gr. Grammar ::= [ModDef] ;
+
+-- semicolon after module is permitted but not obligatory
+
+terminator ModDef "" ;
+_. ModDef ::= ModDef ";" ;
+
+-- The $main$ multilingual grammar structure
+
+MMain. ModDef ::= "grammar" Ident "=" "{" "abstract" "=" Ident ";" [ConcSpec] "}" ;
+
+ConcSpec. ConcSpec ::= Ident "=" ConcExp ;
+separator ConcSpec ";" ;
+
+ConcExp. ConcExp ::= Ident [Transfer] ;
+
+separator Transfer "" ;
+TransferIn.  Transfer ::= "(" "transfer" "in" Open ")" ;  
+TransferOut. Transfer ::= "(" "transfer" "out" Open ")" ;  
+
+-- the individual modules
+
+MModule. ModDef ::= ComplMod ModType "=" ModBody ;
+
+MTAbstract.  ModType ::= "abstract" Ident ;
+MTResource.  ModType ::= "resource" Ident ;
+MTInterface. ModType ::= "interface" Ident ;
+MTConcrete.  ModType ::= "concrete" Ident "of" Ident ;
+MTInstance.  ModType ::= "instance" Ident "of" Ident ;
+MTTransfer.  ModType ::= "transfer" Ident ":" Open "->" Open ;
+
+MBody.  ModBody ::= Extend Opens "{" [TopDef] "}" ;
+MWith.  ModBody ::= Ident "with" [Open] ;
+MReuse. ModBody ::= "reuse" Ident ;
+
+separator TopDef "" ;
+
+Ext.   Extend ::= Ident "**" ;
+NoExt. Extend ::= ;
+
+separator Open "," ;
+NoOpens. Opens ::= ;
+Opens.   Opens ::= "open" [Open] "in" ;
+
+OName.   Open ::= Ident ;
+OQualQO. Open ::= "(" QualOpen Ident ")" ;
+OQual.   Open ::= "(" QualOpen Ident "=" Ident ")" ;
+
+CMCompl.   ComplMod ::= ;
+CMIncompl. ComplMod ::= "incomplete" ;
+
+QOCompl.     QualOpen ::= ;
+QOIncompl.   QualOpen ::= "incomplete" ;
+QOInterface. QualOpen ::= "interface" ;
+
+-- definitions after the $oper$ keywords
+
+DDecl.  Def ::= [Ident] ":" Exp ;
+DDef.   Def ::= [Ident] "=" Exp ;
+DPatt.  Def ::= Ident [Patt] "=" Exp ;  -- non-empty pattern list
+DFull.  Def ::= [Ident] ":" Exp "=" Exp ;
+
+-- top-level definitions
+
+DefCat.    TopDef ::= "cat" [CatDef] ;
+DefFun.    TopDef ::= "fun" [FunDef] ;
+DefDef.    TopDef ::= "def" [Def] ;
+DefData.   TopDef ::= "data" [DataDef] ;
+
+DefTrans.  TopDef ::= "transfer" [Def] ;
+
+DefPar.    TopDef ::= "param" [ParDef] ;
+DefOper.   TopDef ::= "oper"  [Def] ;
+
+DefLincat. TopDef ::= "lincat" [PrintDef] ;
+DefLindef. TopDef ::= "lindef" [Def] ;
+DefLin.    TopDef ::= "lin"    [Def] ;
+
+DefPrintCat. TopDef ::= "printname" "cat" [PrintDef] ;
+DefPrintFun. TopDef ::= "printname" "fun" [PrintDef] ;
+DefFlag.     TopDef ::= "flags" [FlagDef] ;
+
+CatDef.    CatDef ::= Ident [DDecl] ;
+FunDef.    FunDef ::= [Ident] ":" Exp ;
+
+DataDef.   DataDef    ::= Ident "=" [DataConstr] ;
+DataId.    DataConstr ::= Ident ;
+DataQId.   DataConstr ::= Ident "." Ident ;
+separator DataConstr "|" ;
+
+
+ParDef.      ParDef ::= Ident "=" [ParConstr] ;
+ParDefIndir. ParDef ::= Ident "=" "(" "in" Ident ")" ;
+ParDefAbs.   ParDef ::= Ident ;
+
+ParConstr. ParConstr ::= Ident [DDecl] ;
+
+PrintDef. PrintDef ::= [Ident] "=" Exp ;
+
+FlagDef. FlagDef ::= Ident "=" Ident ;
+
+terminator nonempty Def ";" ;
+terminator nonempty CatDef ";" ;
+terminator nonempty FunDef ";" ;
+terminator nonempty DataDef ";" ;
+terminator nonempty ParDef ";" ;
+
+terminator nonempty PrintDef ";" ;
+terminator nonempty FlagDef ";" ;
+
+separator ParConstr "|" ;
+
+separator nonempty Ident "," ;
+
+-- definitions in records and $let$ expressions
+
+LDDecl.  LocDef ::= [Ident] ":" Exp ;
+LDDef.   LocDef ::= [Ident] "=" Exp ;
+LDFull.  LocDef ::= [Ident] ":" Exp "=" Exp ;
+
+separator LocDef ";" ;
+
+-- terms and types
+
+EIdent.    Exp4 ::= Ident ;
+EConstr.   Exp4 ::= "{" Ident "}" ;
+ECons.     Exp4 ::= "[" Ident "]" ;
+ESort.     Exp4 ::= Sort ;
+EString.   Exp4 ::= String ;
+EInt.      Exp4 ::= Integer ;
+EMeta.     Exp4 ::= "?" ;
+EEmpty.    Exp4 ::= "[" "]" ;
+EStrings.  Exp4 ::= "[" String "]" ;
+ERecord.   Exp4 ::= "{" [LocDef] "}" ; -- !
+ETuple.    Exp4 ::= "<" [TupleComp] ">" ;  --- needed for separator ","
+EIndir.    Exp4 ::= "(" "in" Ident ")" ;   -- indirection, used in judgements
+ETyped.    Exp4 ::= "<" Exp ":" Exp ">" ;  -- typing, used for annotations
+
+EProj.     Exp3 ::= Exp3 "." Label ;
+EQConstr.  Exp3 ::= "{" Ident "." Ident "}" ;  -- qualified constructor
+EQCons.    Exp3 ::= "[" Ident "." Ident "]" ;  -- qualified constant
+
+EApp.      Exp2 ::= Exp2 Exp3 ;
+ETable.    Exp2 ::= "table" "{" [Case] "}" ;
+ETTable.   Exp2 ::= "table" Exp4 "{" [Case] "}" ;
+ECase.     Exp2 ::= "case" Exp "of" "{" [Case] "}" ;
+EVariants. Exp2 ::= "variants" "{" [Exp] "}" ;
+EPre.      Exp2 ::= "pre" "{" Exp ";" [Altern] "}" ;
+EStrs.     Exp2 ::= "strs" "{" [Exp] "}" ;
+EConAt.    Exp2 ::= Ident "@" Exp4 ;
+
+ESelect.   Exp1 ::= Exp1 "!" Exp2 ;
+ETupTyp.   Exp1 ::= Exp1 "*" Exp2 ;
+EExtend.   Exp1 ::= Exp1 "**" Exp2 ;
+
+EAbstr.    Exp  ::= "\\" [Bind] "->" Exp ;
+ECTable.   Exp  ::= "\\""\\" [Bind] "=>" Exp ;
+EProd.     Exp  ::= Decl "->" Exp ;
+ETType.    Exp  ::= Exp1 "=>" Exp ; -- these are thus right associative
+EConcat.   Exp  ::= Exp1 "++" Exp ;
+EGlue.     Exp  ::= Exp1 "+"  Exp ;
+ELet.      Exp  ::= "let" "{" [LocDef] "}" "in" Exp ;
+EEqs.      Exp  ::= "fn" "{" [Equation] "}" ;
+
+coercions Exp 4 ;
+
+separator Exp ";" ; -- in variants
+
+-- patterns
+
+PW.    Patt1 ::= "_" ;
+PV.    Patt1 ::= Ident ;
+PCon.  Patt1 ::= "{" Ident "}" ;
+PQ.    Patt1 ::= Ident "." Ident ;
+PInt.  Patt1 ::= Integer ;
+PStr.  Patt1 ::= String ;
+PR.    Patt1 ::= "{" [PattAss] "}" ;
+PTup.  Patt1 ::= "<" [PattTupleComp] ">" ;
+PC.    Patt  ::= Ident [Patt] ;
+PQC.   Patt  ::= Ident "." Ident [Patt] ;
+
+coercions Patt 1 ;
+
+PA.  PattAss ::= [Ident] "=" Patt ;
+
+-- labels
+
+LIdent. Label ::= Ident ;
+LVar.   Label ::= "$" Integer ;
+
+-- basic types
+
+rules Sort ::= "Type" | "PType" | "Tok" | "Str" | "Strs" ;
+
+separator PattAss ";" ;
+
+AltP. PattAlt ::= Patt ;
+
+-- this is explicit to force higher precedence level on rhs
+(:[]). [Patt] ::= Patt1 ;
+(:).   [Patt] ::= Patt1 [Patt] ;
+
+separator nonempty PattAlt "|" ;
+
+-- binds in lambdas and lin rules
+
+BIdent. Bind ::= Ident ;
+BWild.  Bind ::= "_" ;
+
+separator Bind "," ;
+
+
+-- declarations in function types
+
+DDec.  Decl ::= "(" [Bind] ":" Exp ")" ;
+DExp.  Decl ::= Exp2 ; -- can thus be an application
+
+-- tuple component (term or pattern)
+
+TComp. TupleComp ::= Exp ;
+PTComp. PattTupleComp ::= Patt ;
+
+separator TupleComp "," ;
+separator PattTupleComp "," ;
+
+-- case branches
+
+Case. Case ::= [PattAlt] "=>" Exp ;
+
+separator nonempty Case ";" ;
+
+-- cases in abstract syntax
+
+Equ. Equation ::= [Patt] "->" Exp ;
+
+separator Equation ";" ;
+
+-- prefix alternatives
+
+Alt. Altern ::= Exp "/" Exp ;
+
+separator Altern ";" ;
+
+-- in a context, higher precedence is required than in function types
+
+DDDec.  DDecl ::= "(" [Bind] ":" Exp ")" ;
+DDExp.  DDecl ::= Exp4 ;  -- can thus *not* be an application
+
+separator DDecl "" ;
+
+
+--------------------------------------
+
+-- for backward compatibility
+
+OldGr. OldGrammar ::= Include [TopDef] ;
+
+NoIncl. Include ::= ;
+Incl.   Include ::= "include" [FileName] ;
+
+FString. FileName ::= String ;
+
+terminator nonempty FileName ";" ;
+
+FIdent.  FileName ::= Ident ;
+FSlash.  FileName ::= "/" FileName ;
+FDot.    FileName ::= "." FileName ;
+FMinus.  FileName ::= "-" FileName ;
+FAddId.  FileName ::= Ident FileName ;
+
+token LString '\'' (char - '\'')* '\'' ;
+ELString.  Exp4 ::= LString ;
+ELin.      Exp2 ::= "Lin" Ident ;
+
+DefPrintOld.  TopDef ::= "printname" [PrintDef] ;
+DefLintype.   TopDef ::= "lintype"   [Def] ;
+DefPattern.   TopDef ::= "pattern"   [Def] ;

src/GF/Source/GrammarToSource.hs

@@ -15,16 +15,20 @@ trGrammar (MGrammar ms) = P.Gr (map trModule ms) -- no includes
 
 trModule :: (Ident,SourceModInfo) -> P.ModDef
 trModule (i,mo) = case mo of
-  ModMod m -> mkModule i' (trExtend (extends m)) (mkOpens (map trOpen (opens m)))
+  ModMod m -> P.MModule compl typ body where
-                 (mkTopDefs (concatMap trAnyDef (tree2list (jments m)) ++ 
+    compl = P.CMCompl -- always complete module
-                            (map trFlag (flags m))))
+    i' = tri i
- where
+    typ = case typeOfModule mo of
-   i' = tri i
+      MTResource -> P.MTResource i'
-   mkModule m = case typeOfModule mo of
+      MTAbstract -> P.MTAbstract i'
-     MTResource -> P.MResource m
+      MTConcrete a -> P.MTConcrete i' (tri a)
-     MTAbstract -> P.MAbstract m
+      MTTransfer a b -> P.MTTransfer i' (trOpen a) (trOpen b)
-     MTConcrete a -> P.MConcrete m (tri a)
+      MTInstance a -> P.MTInstance i' (tri a)
-     MTTransfer a b -> P.MTransfer m (trOpen a) (trOpen b)
+      MTInterface -> P.MTInterface i'
+    body = P.MBody 
+             (trExtend (extends m)) 
+             (mkOpens (map trOpen (opens m)))
+             (mkTopDefs (concatMap trAnyDef (tree2list (jments m)) ++ map trFlag (flags m)))
 
 trExtend :: Maybe Ident -> P.Extend
 trExtend i = maybe P.NoExt (P.Ext . tri) i
@@ -34,8 +38,15 @@ forName (MTConcrete a) = tri a
 
 trOpen :: OpenSpec Ident -> P.Open
 trOpen o = case o of
-  OSimple i   -> P.OName (tri i)
+  OSimple OQNormal i -> P.OQualQO P.QOCompl (tri i)
-  OQualif i j -> P.OQual (tri i) (tri j)
+  OSimple q i -> P.OQualQO (trQualOpen q) (tri i)
+  OQualif q i j -> P.OQual (trQualOpen q) (tri i) (tri j)
+
+trQualOpen q = case q of
+  OQNormal -> P.QOCompl
+  OQIncomplete -> P.QOIncompl
+  OQInterface -> P.QOInterface
+
 
 mkOpens ds = if null ds then P.NoOpens else P.Opens ds
 mkTopDefs ds = ds

src/GF/Source/LexGF.hs

@@ -55,7 +55,7 @@ tokens_scan = load_scan (tokens_acts,stop_act) tokens_lx
 eitherResIdent :: (String -> Tok) -> String -> Tok
 eitherResIdent tv s = if isResWord s then (TS s) else (tv s) where
   isResWord s = isInTree s $
-    B "let" (B "concrete" (B "Tok" (B "Str" (B "PType" (B "Lin" N N) N) (B "Strs" N N)) (B "case" (B "abstract" (B "Type" N N) N) (B "cat" N N))) (B "fun" (B "flags" (B "def" (B "data" N N) N) (B "fn" N N)) (B "in" (B "grammar" N N) (B "include" N N)))) (B "pattern" (B "of" (B "lindef" (B "lincat" (B "lin" N N) N) (B "lintype" N N)) (B "out" (B "oper" (B "open" N N) N) (B "param" N N))) (B "strs" (B "resource" (B "printname" (B "pre" N N) N) (B "reuse" N N)) (B "transfer" (B "table" N N) (B "variants" N N))))
+    B "interface" (B "data" (B "Type" (B "Str" (B "PType" (B "Lin" N N) N) (B "Tok" (B "Strs" N N) N)) (B "cat" (B "case" (B "abstract" N N) N) (B "concrete" N N))) (B "grammar" (B "fn" (B "flags" (B "def" N N) N) (B "fun" N N)) (B "incomplete" (B "include" (B "in" N N) N) (B "instance" N N)))) (B "pattern" (B "of" (B "lincat" (B "lin" (B "let" N N) N) (B "lintype" (B "lindef" N N) N)) (B "out" (B "oper" (B "open" N N) N) (B "param" N N))) (B "strs" (B "resource" (B "printname" (B "pre" N N) N) (B "reuse" N N)) (B "variants" (B "transfer" (B "table" N N) N) (B "with" N N))))
 
 data BTree = N | B String BTree BTree deriving (Show)
 
@@ -114,7 +114,7 @@ lx__14_0 = (True,[(3,"pTSpec",[],Nothing,Nothing)],-1,(('0','0'),[]))
 lx__15_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
 lx__15_0 = (False,[],15,(('\'','\''),[('\'',16)]))
 lx__16_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
-lx__16_0 = (True,[(4,"mk_LString",[],Nothing,Nothing)],15,(('\'','\''),[('\'',16)]))
+lx__16_0 = (True,[(4,"mk_LString",[],Nothing,Nothing)],-1,(('0','0'),[]))
 lx__17_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
 lx__17_0 = (True,[(5,"ident",[],Nothing,Nothing)],-1,(('\'','\255'),[('\'',17),('0',17),('1',17),('2',17),('3',17),('4',17),('5',17),('6',17),('7',17),('8',17),('9',17),('A',17),('B',17),('C',17),('D',17),('E',17),('F',17),('G',17),('H',17),('I',17),('J',17),('K',17),('L',17),('M',17),('N',17),('O',17),('P',17),('Q',17),('R',17),('S',17),('T',17),('U',17),('V',17),('W',17),('X',17),('Y',17),('Z',17),('_',17),('a',17),('b',17),('c',17),('d',17),('e',17),('f',17),('g',17),('h',17),('i',17),('j',17),('k',17),('l',17),('m',17),('n',17),('o',17),('p',17),('q',17),('r',17),('s',17),('t',17),('u',17),('v',17),('w',17),('x',17),('y',17),('z',17),('\192',17),('\193',17),('\194',17),('\195',17),('\196',17),('\197',17),('\198',17),('\199',17),('\200',17),('\201',17),('\202',17),('\203',17),('\204',17),('\205',17),('\206',17),('\207',17),('\208',17),('\209',17),('\210',17),('\211',17),('\212',17),('\213',17),('\214',17),('\216',17),('\217',17),('\218',17),('\219',17),('\220',17),('\221',17),('\222',17),('\223',17),('\224',17),('\225',17),('\226',17),('\227',17),('\228',17),('\229',17),('\230',17),('\231',17),('\232',17),('\233',17),('\234',17),('\235',17),('\236',17),('\237',17),('\238',17),('\239',17),('\240',17),('\241',17),('\242',17),('\243',17),('\244',17),('\245',17),('\246',17),('\248',17),('\249',17),('\250',17),('\251',17),('\252',17),('\253',17),('\254',17),('\255',17)]))
 lx__18_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))

src/GF/Source/PrintGF.hs

@@ -7,6 +7,7 @@ import Ident --H
 import Char
 
 -- the top-level printing method
+
 printTree :: Print a => a -> String
 printTree = render . prt 0
 
@@ -88,17 +89,7 @@ instance Print Grammar where
 instance Print ModDef where
   prt i e = case e of
    MMain id0 id concspecs -> prPrec i 0 (concat [["grammar"] , prt 0 id0 , ["="] , ["{"] , ["abstract"] , ["="] , prt 0 id , [";"] , prt 0 concspecs , ["}"]])
-   MAbstract id extend opens topdefs -> prPrec i 0 (concat [["abstract"] , prt 0 id , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
+   MModule complmod modtype modbody -> prPrec i 0 (concat [prt 0 complmod , prt 0 modtype , ["="] , prt 0 modbody])
-   MResource id extend opens topdefs -> prPrec i 0 (concat [["resource"] , prt 0 id , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
-   MResourceInt id extend opens topdefs -> prPrec i 0 (concat [["resource"] , ["abstract"] , prt 0 id , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
-   MResourceImp id0 id opens topdefs -> prPrec i 0 (concat [["resource"] , prt 0 id0 , ["of"] , prt 0 id , ["="] , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
-   MConcrete id0 id extend opens topdefs -> prPrec i 0 (concat [["concrete"] , prt 0 id0 , ["of"] , prt 0 id , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
-   MConcreteInt id0 id extend opens topdefs -> prPrec i 0 (concat [["concrete"] , ["abstract"] , ["of"] , prt 0 id0 , ["in"] , prt 0 id , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
-   MConcreteImp open id0 id -> prPrec i 0 (concat [["concrete"] , ["of"] , prt 0 open , ["="] , prt 0 id0 , ["**"] , prt 0 id])
-   MTransfer id open0 open extend opens topdefs -> prPrec i 0 (concat [["transfer"] , prt 0 id , [":"] , prt 0 open0 , ["->"] , prt 0 open , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
-   MReuseAbs id0 id -> prPrec i 0 (concat [["resource"] , ["abstract"] , prt 0 id0 , ["="] , ["reuse"] , prt 0 id])
-   MReuseCnc id0 id -> prPrec i 0 (concat [["resource"] , ["concrete"] , prt 0 id0 , ["="] , ["reuse"] , prt 0 id])
-   MReuseAll id0 extend id -> prPrec i 0 (concat [["resource"] , prt 0 id0 , ["="] , prt 0 extend , ["reuse"] , prt 0 id])
 
   prtList es = case es of
    [] -> (concat [])
@@ -127,6 +118,23 @@ instance Print Transfer where
    [] -> (concat [])
    x:xs -> (concat [prt 0 x , prt 0 xs])
 
+instance Print ModType where
+  prt i e = case e of
+   MTAbstract id -> prPrec i 0 (concat [["abstract"] , prt 0 id])
+   MTResource id -> prPrec i 0 (concat [["resource"] , prt 0 id])
+   MTInterface id -> prPrec i 0 (concat [["interface"] , prt 0 id])
+   MTConcrete id0 id -> prPrec i 0 (concat [["concrete"] , prt 0 id0 , ["of"] , prt 0 id])
+   MTInstance id0 id -> prPrec i 0 (concat [["instance"] , prt 0 id0 , ["of"] , prt 0 id])
+   MTTransfer id open0 open -> prPrec i 0 (concat [["transfer"] , prt 0 id , [":"] , prt 0 open0 , ["->"] , prt 0 open])
+
+
+instance Print ModBody where
+  prt i e = case e of
+   MBody extend opens topdefs -> prPrec i 0 (concat [prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
+   MWith id opens -> prPrec i 0 (concat [prt 0 id , ["with"] , prt 0 opens])
+   MReuse id -> prPrec i 0 (concat [["reuse"] , prt 0 id])
+
+
 instance Print Extend where
   prt i e = case e of
    Ext id -> prPrec i 0 (concat [prt 0 id , ["**"]])
@@ -142,13 +150,27 @@ instance Print Opens where
 instance Print Open where
   prt i e = case e of
    OName id -> prPrec i 0 (concat [prt 0 id])
-   OQual id0 id -> prPrec i 0 (concat [["("] , prt 0 id0 , ["="] , prt 0 id , [")"]])
+   OQualQO qualopen id -> prPrec i 0 (concat [["("] , prt 0 qualopen , prt 0 id , [")"]])
+   OQual qualopen id0 id -> prPrec i 0 (concat [["("] , prt 0 qualopen , prt 0 id0 , ["="] , prt 0 id , [")"]])
 
   prtList es = case es of
    [] -> (concat [])
    [x] -> (concat [prt 0 x])
    x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
 
+instance Print ComplMod where
+  prt i e = case e of
+   CMCompl  -> prPrec i 0 (concat [])
+   CMIncompl  -> prPrec i 0 (concat [["incomplete"]])
+
+
+instance Print QualOpen where
+  prt i e = case e of
+   QOCompl  -> prPrec i 0 (concat [])
+   QOIncompl  -> prPrec i 0 (concat [["incomplete"]])
+   QOInterface  -> prPrec i 0 (concat [["interface"]])
+
+
 instance Print Def where
   prt i e = case e of
    DDecl ids exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp])

src/GF/Source/SkelGF.hs

@@ -27,17 +27,7 @@ transGrammar x = case x of
 transModDef :: ModDef -> Result
 transModDef x = case x of
   MMain id0 id concspecs  -> failure x
-  MAbstract id extend opens topdefs  -> failure x
+  MModule complmod modtype modbody  -> failure x
-  MResource id extend opens topdefs  -> failure x
-  MResourceInt id extend opens topdefs  -> failure x
-  MResourceImp id0 id opens topdefs  -> failure x
-  MConcrete id0 id extend opens topdefs  -> failure x
-  MConcreteInt id0 id extend opens topdefs  -> failure x
-  MConcreteImp open id0 id  -> failure x
-  MTransfer id open0 open extend opens topdefs  -> failure x
-  MReuseAbs id0 id  -> failure x
-  MReuseCnc id0 id  -> failure x
-  MReuseAll id0 extend id  -> failure x
 
 
 transConcSpec :: ConcSpec -> Result
@@ -56,6 +46,23 @@ transTransfer x = case x of
   TransferOut open  -> failure x
 
 
+transModType :: ModType -> Result
+transModType x = case x of
+  MTAbstract id  -> failure x
+  MTResource id  -> failure x
+  MTInterface id  -> failure x
+  MTConcrete id0 id  -> failure x
+  MTInstance id0 id  -> failure x
+  MTTransfer id open0 open  -> failure x
+
+
+transModBody :: ModBody -> Result
+transModBody x = case x of
+  MBody extend opens topdefs  -> failure x
+  MWith id opens  -> failure x
+  MReuse id  -> failure x
+
+
 transExtend :: Extend -> Result
 transExtend x = case x of
   Ext id  -> failure x
@@ -71,7 +78,21 @@ transOpens x = case x of
 transOpen :: Open -> Result
 transOpen x = case x of
   OName id  -> failure x
-  OQual id0 id  -> failure x
+  OQualQO qualopen id  -> failure x
+  OQual qualopen id0 id  -> failure x
+
+
+transComplMod :: ComplMod -> Result
+transComplMod x = case x of
+  CMCompl  -> failure x
+  CMIncompl  -> failure x
+
+
+transQualOpen :: QualOpen -> Result
+transQualOpen x = case x of
+  QOCompl  -> failure x
+  QOIncompl  -> failure x
+  QOInterface  -> failure x
 
 
 transDef :: Def -> Result

src/GF/Source/SourceToGrammar.hs

@@ -35,56 +35,63 @@ transGrammar x = case x of
 
 transModDef :: ModDef -> Err (Ident, G.SourceModInfo)
 transModDef x = case x of
+
   MMain id0 id concspecs  -> do
     id0' <- transIdent id0
     id'  <- transIdent id
     concspecs' <- mapM transConcSpec concspecs
     return $ (id0', GM.ModMainGrammar (GM.MainGrammar id' concspecs'))
-  MAbstract id extends opens defs  -> do
-    id'      <- transIdent id
-    extends' <- transExtend extends
-    opens'   <- transOpens opens
-    defs0    <- mapM transAbsDef $ getTopDefs defs
-    defs'    <- U.buildAnyTree [d | Left  ds <- defs0, d <- ds]
-    flags    <- return       [f | Right fs <- defs0, f <- fs]
-    return $ (id', GM.ModMod (GM.Module GM.MTAbstract flags extends' opens' defs')) 
-  MResource id extends opens defs  -> do
-    id'      <- transIdent id
-    extends' <- transExtend extends
-    opens'   <- transOpens opens
-    defs0    <- mapM transResDef $ getTopDefs defs
-    defs'    <- U.buildAnyTree [d | Left  ds <- defs0, d <- ds]
-    flags    <- return       [f | Right fs <- defs0, f <- fs]
-    return $ (id', GM.ModMod (GM.Module GM.MTResource flags extends' opens' defs')) 
-  MConcrete id open extends opens defs -> do
-    id'      <- transIdent id
-    open'    <- transIdent open
-    extends' <- transExtend extends
-    opens'   <- transOpens opens
-    defs0    <- mapM transCncDef $ getTopDefs defs
-    defs'    <- U.buildAnyTree [d | Left  ds <- defs0, d <- ds]
-    flags    <- return       [f | Right fs <- defs0, f <- fs]
-    return $ (id', 
-      GM.ModMod (GM.Module (GM.MTConcrete open') flags extends' opens' defs'))
-  MTransfer id open0 open extends opens defs -> do
-    id'      <- transIdent id
-    open0'   <- transOpen open0
-    open'    <- transOpen open
-    extends' <- transExtend extends
-    opens'   <- transOpens opens
-    defs0    <- mapM transAbsDef $ getTopDefs defs
-    defs'    <- U.buildAnyTree [d | Left  ds <- defs0, d <- ds]
-    flags    <- return       [f | Right fs <- defs0, f <- fs]
-    return $ (id', 
-     GM.ModMod (GM.Module (GM.MTTransfer open0' open') flags extends' opens' defs'))
 
-  MReuseAbs id0 id  -> failure x
+  MModule compl mtyp body -> do
-  MReuseCnc id0 id  -> failure x
+
-  MReuseAll r e c  -> do
+    let mstat' = transComplMod compl
-    r' <- transIdent r
+
-    e' <- transExtend e
+    (trDef, mtyp', id') <- case mtyp of
-    c' <- transIdent c
+      MTAbstract id -> do
-    return $ (r', GM.ModMod (GM.Module (GM.MTReuse c') [] e' [] NT)) 
+        id' <- transIdent id
+        return (transAbsDef, GM.MTAbstract, id')
+      MTResource id -> case body of
+        MReuse c -> do
+          id' <- transIdent id
+          c' <- transIdent c
+          return (transResDef, GM.MTReuse c', id')
+        _ -> do
+          id' <- transIdent id
+          return (transResDef, GM.MTResource, id')
+      MTConcrete id open -> do
+        id'   <- transIdent id
+        open' <- transIdent open
+        return (transCncDef, GM.MTConcrete open', id')
+      MTTransfer id a b -> do
+        id'  <- transIdent id
+        a'   <- transOpen a
+        b'   <- transOpen a
+        return (transAbsDef, GM.MTTransfer a' b', id')
+      MTInterface id -> do
+        id' <- transIdent id
+        return (transResDef, GM.MTInterface, id')
+      MTInstance id open -> do
+        id'   <- transIdent id
+        open' <- transIdent open
+        return (transResDef, GM.MTInstance open', id')
+
+    (extends', opens', defs',flags') <- case body of
+      MBody extends opens defs -> do
+        extends' <- transExtend extends
+        opens'   <- transOpens opens
+        defs0    <- mapM trDef $ getTopDefs defs
+        defs'    <- U.buildAnyTree [d | Left  ds <- defs0, d <- ds]
+        flags'   <- return       [f | Right fs <- defs0, f <- fs]
+        return $ (extends', opens', defs',flags')
+      MReuse _ ->
+        return (Nothing,[],NT,[])
+
+    return $ (id', GM.ModMod (GM.Module mtyp' mstat' flags' extends' opens' defs'))  
+
+transComplMod :: ComplMod -> GM.ModuleStatus
+transComplMod x = case x of
+  CMCompl  -> GM.MSComplete
+  CMIncompl  -> GM.MSIncomplete
 
 getTopDefs :: [TopDef] -> [TopDef]
 getTopDefs x = x
@@ -130,8 +137,15 @@ transOpens x = case x of
 
 transOpen :: Open -> Err (GM.OpenSpec Ident)
 transOpen x = case x of
-  OName id   -> liftM  GM.OSimple $ transIdent id
+  OName id     -> liftM   (GM.OSimple GM.OQNormal) $ transIdent id
-  OQual id m -> liftM2 GM.OQualif (transIdent id) (transIdent m)
+  OQualQO q id -> liftM2  GM.OSimple (transQualOpen q) (transIdent id)
+  OQual q id m -> liftM3  GM.OQualif  (transQualOpen q) (transIdent id) (transIdent m)
+
+transQualOpen :: QualOpen -> Err GM.OpenQualif
+transQualOpen x = case x of
+  QOCompl  -> return GM.OQNormal
+  QOInterface  -> return GM.OQInterface
+  QOIncompl  -> return GM.OQIncomplete
 
 transAbsDef :: TopDef -> Err (Either [(Ident, G.Info)] [GO.Option])
 transAbsDef x = case x of
@@ -489,10 +503,13 @@ transOldGrammar x name = case x of
      DefPrintCat printdefs  -> (a,r,d:c)
      DefPrintFun printdefs  -> (a,r,d:c)
      DefPrintOld printdefs  -> (a,r,d:c)
-   mkAbs a = MAbstract absName NoExt (Opens []) $ topDefs a
+   mkAbs a = MModule q (MTAbstract absName) (MBody ne (Opens []) (topDefs a))
-   mkRes r = MResource resName NoExt (Opens []) $ topDefs r
+   mkRes r = MModule q (MTResource resName) (MBody ne  (Opens []) (topDefs r))
-   mkCnc r = MConcrete cncName absName NoExt (Opens [OName resName]) $ topDefs r
+   mkCnc r = MModule q (MTConcrete cncName absName) 
+                                            (MBody ne (Opens [OName resName]) (topDefs r))
    topDefs t = t
+   ne = NoExt
+   q = CMCompl
 
    absName = identC topic
    resName = identC ("Res" ++ lang)

src/Today.hs

@@ -1 +1 @@
-module Today where today = "Tue Oct 21 17:20:02 CEST 2003"
+module Today where today = "Thu Oct 23 17:57:21 CEST 2003"