test for new GF source format

7 files changed, 71 insertions, 27 deletions

diff --git a/src/GF/Devel/Grammar/Macros.hs b/src/GF/Devel/Grammar/Macros.hs
index 4848a5e1a..12fa1e747 100644
--- a/src/GF/Devel/Grammar/Macros.hs
+++ b/src/GF/Devel/Grammar/Macros.hs
@@ -45,6 +45,9 @@ mkDecl typ = (wildIdent, typ)
 typeType :: Type
 typeType = Sort "Type"
 
+meta0 :: Term
+meta0 = Meta 0
+
 ident2label :: Ident -> Label
 ident2label c = LIdent (prIdent c)
 
@@ -155,6 +158,10 @@ composOp co trm = case trm of
         aa' <- mapM (pairM co) aa
         return (Alts (t',aa'))
    FV ts -> mapM co ts >>= return . FV
+   Overload tts -> do
+     tts' <- mapM (pairM co) tts
+     return $ Overload tts'
+
    _ -> return trm -- covers K, Vr, Cn, Sort
 
 --- just aux to composOp?
diff --git a/src/GF/Devel/Grammar/MkJudgements.hs b/src/GF/Devel/Grammar/MkJudgements.hs
index 795bf6f67..833d2f695 100644
--- a/src/GF/Devel/Grammar/MkJudgements.hs
+++ b/src/GF/Devel/Grammar/MkJudgements.hs
@@ -47,17 +47,20 @@ resOperDef tr = addJDef tr (emptyJudgement JOper)
 resOper :: Type -> Term -> Judgement
 resOper ty tr = addJDef tr (resOperType ty)
 
--- param m.p = c g  is encoded as p : (ci : gi -> EData) -> Type
--- we use EData instead of m.p to make circularity check easier  
-resParam :: Ident -> Ident -> [(Ident,Context)] -> Judgement
-resParam m p cos = addJType constrs (emptyJudgement JParam) where
+resOverload :: [(Type,Term)] -> Judgement
+resOverload tts = resOperDef (Overload tts)
+
+-- param p = ci gi  is encoded as p : ((ci : gi) -> EData) -> Type
+-- we use EData instead of p to make circularity check easier  
+resParam :: [(Ident,Context)] -> Judgement
+resParam cos = addJType constrs (emptyJudgement JParam) where
   constrs = mkProd [(c,mkProd co EData) | (c,co) <- cos] typeType
 
 -- to enable constructor type lookup:
--- create an oper for each constructor m.p = c g, as c : g -> m.p = EData
-paramConstructors :: Ident -> Ident -> [(Ident,Context)] -> [(Ident,Judgement)]
-paramConstructors m p cs = 
-  [(c,resOper (mkProd co (QC m p)) EData) | (c,co) <- cs]
+-- create an oper for each constructor p = c g, as c : g -> p = EData
+paramConstructors :: Ident -> [(Ident,Context)] -> [(Ident,Judgement)]
+paramConstructors p cs = 
+  [(c,resOper (mkProd co (Con p)) EData) | (c,co) <- cs]
 
 -- unifying contents of judgements
 
diff --git a/src/GF/Devel/Grammar/Modules.hs b/src/GF/Devel/Grammar/Modules.hs
index 774cc6387..0d3d96114 100644
--- a/src/GF/Devel/Grammar/Modules.hs
+++ b/src/GF/Devel/Grammar/Modules.hs
@@ -27,13 +27,13 @@ data Module = Module {
   mextends    :: [(Ident,MInclude)],
   mopens      :: [(Ident,Ident)],           -- used name, original name
   mflags      :: Map Ident String,
-  mjments     :: Map Ident (Either Judgement Ident)  -- def or indirection
+  mjments     :: Map Ident (Either Judgement Indirection) -- def or indirection
   }
 
 emptyModule :: Ident -> Module
 emptyModule m = Module MTGrammar [] [] [] [] empty empty
 
-listJudgements :: Module -> [(Ident,Either Judgement Ident)]
+listJudgements :: Module -> [(Ident,Either Judgement Indirection)]
 listJudgements = assocs . mjments
 
 data ModuleType =
@@ -46,4 +46,5 @@ data MInclude =
   | MIExcept [Ident]
   | MIOnly [Ident]
 
+type Indirection = (Ident,Bool) -- module of origin, whether canonical
 
diff --git a/src/GF/Devel/Grammar/SourceToGF.hs b/src/GF/Devel/Grammar/SourceToGF.hs
index d40026851..cefc1192c 100644
--- a/src/GF/Devel/Grammar/SourceToGF.hs
+++ b/src/GF/Devel/Grammar/SourceToGF.hs
@@ -248,13 +248,7 @@ transResDef :: TopDef -> Err (Either [(Ident,Judgement)] [(Ident,String)])
 transResDef x = case x of
   DefPar pardefs -> do
     pardefs' <- mapM transParDef pardefs
-    returnl $ [] 
-        ---- [(p, resParam (if null pars 
-        ----                          then nope -- abstract param type 
-        ----                          else (yes (pars,Nothing)))) 
-        ----                             | (p,pars) <- pardefs']
-        ----   ++ [(f, G.ResValue (yes (M.mkProd co (G.Con p),Nothing))) |
-        ----             (p,pars) <- pardefs', (f,co) <- pars]
+    returnl $ concatMap mkParamDefs pardefs'   
 
   DefOper defs -> do
     defs' <- liftM concat $ mapM getDefs defs
@@ -267,19 +261,21 @@ transResDef x = case x of
   DefFlag defs -> liftM (Right . concat) $ mapM transFlagDef defs
   _ -> Bad $ "illegal definition form in resource" +++ printTree x
  where
-   mkOverload (c,j) = case j of
-{- ----
-     G.ResOper _ (Yes (G.App keyw (G.R fs@(_:_:_)))) | 
-                                          isOverloading keyw c fs -> 
-       [(c,G.ResOverload [(ty,fu) | (_,(Just ty,fu)) <- fs])]
+
+   mkParamDefs (p,pars) =
+     if null pars 
+       then [(p,addJType M.meta0 (emptyJudgement JParam))]  -- in an interface
+       else (p,resParam pars) : paramConstructors p pars
+
+   mkOverload (c,j) = case (jtype j, jdef j) of
+     (_,G.App keyw (G.R fs@(_:_:_))) | isOverloading keyw c fs -> 
+         [(c,resOverload [(ty,fu) | (_,(Just ty,fu)) <- fs])]
 
      -- to enable separare type signature --- not type-checked
-     G.ResOper (Yes (G.App keyw (G.RecType fs@(_:_:_)))) _ | 
-                                          isOverloading keyw c fs -> []
--}
+     (G.App keyw (G.RecType fs@(_:_:_)),_) | isOverloading keyw c fs -> []
      _ -> [(c,j)]
-   isOverloading keyw c fs = 
-     printTree keyw == "overload" &&       -- overload is a "soft keyword"
+   isOverloading (G.Vr keyw) c fs = 
+     prIdent keyw == "overload" &&       -- overload is a "soft keyword"
      False ---- all (== GP.prt c) (map (GP.prt . fst) fs)
 
 transParDef :: ParDef -> Err (Ident, [(Ident,G.Context)])
diff --git a/src/GF/Devel/Grammar/Terms.hs b/src/GF/Devel/Grammar/Terms.hs
index bfbdff7d0..d57e7c160 100644
--- a/src/GF/Devel/Grammar/Terms.hs
+++ b/src/GF/Devel/Grammar/Terms.hs
@@ -54,6 +54,8 @@ data Term =
 
  | Alts (Term, [(Term, Term)]) -- ^ prefix-dependent: @pre {t ; s\/c ; ...}@
 
+ | Overload [(Type,Term)]
+
   deriving (Read, Show, Eq, Ord)
 
 data Patt =
diff --git a/src/GF/Devel/TestGF3.hs b/src/GF/Devel/TestGF3.hs
new file mode 100644
index 000000000..3f3b9f358
--- /dev/null
+++ b/src/GF/Devel/TestGF3.hs
@@ -0,0 +1,29 @@
+module Main where
+
+import GF.Devel.Grammar.LexGF
+import GF.Devel.Grammar.ParGF
+---- import GF.Devel.Grammar.PrintGF
+import GF.Devel.Grammar.AbsGF
+
+import GF.Devel.Grammar.SourceToGF
+
+import qualified GF.Devel.Grammar.ErrM as GErr ----
+import GF.Data.Operations
+
+import System (getArgs)
+
+main = do
+  f:_ <- getArgs
+  s   <- readFile f
+  let tt = myLexer s
+  case pGrammar tt of
+    GErr.Bad s -> putStrLn s
+    GErr.Ok g -> compile g
+
+compile g = do
+  let eg = transGrammar g
+  case eg of
+    Ok _ -> putStrLn "OK"
+    Bad s -> putStrLn s
+  return ()
+
diff --git a/src/Makefile b/src/Makefile
index bdb94401c..4f342324d 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -34,6 +34,7 @@ GF_EXE=gf$(EXEEXT)
 GF_EXE_TMP=gf-bin$(EXEEXT)
 GF_DOC_EXE=gfdoc$(EXEEXT)
 GF3_EXE=gf3$(EXEEXT)
+TESTGF3_EXE=testgf3$(EXEEXT)
 
 
 ifeq ("$(READLINE)","readline")
@@ -206,6 +207,11 @@ gf3:
 	strip $(GF3_EXE)
 	mv $(GF3_EXE) ../bin/
 
+testgf3:
+	$(GHMAKE) $(GHCOPTFLAGS) -o testgf3 GF/Devel/TestGF3.hs
+	strip $(TESTGF3_EXE)
+	mv $(TESTGF3_EXE) ../bin/
+
 gfcc2c:
 	$(MAKE) -C tools/c
 	$(MAKE) -C ../lib/c