Working with interfaces and incomplete modules.

4 files changed, 161 insertions, 10 deletions

diff --git a/src/GF/Canon/CanonToGrammar.hs b/src/GF/Canon/CanonToGrammar.hs
index 1a677e1a9..93dac97f6 100644
--- a/src/GF/Canon/CanonToGrammar.hs
+++ b/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')
 
diff --git a/src/GF/Canon/GFC.cf b/src/GF/Canon/GFC.cf
new file mode 100644
index 000000000..1816a77ad
--- /dev/null
+++ b/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 "," ;
+
diff --git a/src/GF/Canon/MkGFC.hs b/src/GF/Canon/MkGFC.hs
index d747634d2..7547280a9 100644
--- a/src/GF/Canon/MkGFC.hs
+++ b/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))
-      in (a,M.ModMod (M.Module mt' flags (ee e) (oo os) defs'))
+            MTTrans a x y -> (a,M.MTTransfer (M.oSimple x) (M.oSimple y))
+      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
diff --git a/src/GF/Canon/Share.hs b/src/GF/Canon/Share.hs
index fc4d82b06..63e12436a 100644
--- a/src/GF/Canon/Share.hs
+++ b/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) -> 
-    (i,M.ModMod (M.Module mt fs me ops (mapTree (shareInfo opt) js)))
+  M.ModMod (M.Module mt st fs me ops 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)