PGF.Type.Hypo now can represent explicit and implicit arguments and argument without bound variable

3 files changed, 15 insertions, 25 deletions

diff --git a/src/GF/Compile/GFCCtoProlog.hs b/src/GF/Compile/GFCCtoProlog.hs
index 48c3e620d..dca6465fa 100644
--- a/src/GF/Compile/GFCCtoProlog.hs
+++ b/src/GF/Compile/GFCCtoProlog.hs
@@ -69,11 +69,11 @@ plCat :: (CId, [Hypo]) -> String
 plCat (cat, hypos) = plFact "cat" (plTypeWithHypos typ) 
     where ((_,subst), hypos') = alphaConvert emptyEnv hypos
           args = reverse [EVar x | (_,x) <- subst]
-          typ = wildcardUnusedVars $ DTyp hypos' cat args
+          typ = DTyp hypos' cat args
 
 plFun :: (CId, (Type, Int, [Equation])) -> String
 plFun (fun, (typ,_,_)) = plFact "fun" (plp fun : plTypeWithHypos typ')
-    where typ' = wildcardUnusedVars $ snd $ alphaConvert emptyEnv typ
+    where typ' = snd $ alphaConvert emptyEnv typ
 
 plTypeWithHypos :: Type -> [String]
 plTypeWithHypos (DTyp hypos cat args) = [plTerm (plp cat) (map plp args), plp hypos]
@@ -114,7 +114,9 @@ instance PLPrint Type where
         where result = plTerm (plp cat) (map plp args)
 
 instance PLPrint Hypo where
-    plp (Hyp var typ) = plOper ":" (plp var) (plp typ)
+    plp (Hyp      typ) = plOper ":" (plp wildCId) (plp typ)
+    plp (HypI var typ) = plOper ":" (plp var) (plp typ)
+    plp (HypV var typ) = plOper ":" (plp var) (plp typ)
 
 instance PLPrint Expr where
     plp (EVar x)    = plp x
@@ -261,7 +263,12 @@ instance AlphaConvert Type where
               ((ctr,_), args') = alphaConvert env' args
 
 instance AlphaConvert Hypo where
-    alphaConvert env (Hyp x typ) = ((ctr+1,(x,x'):subst), Hyp x' typ')
+    alphaConvert env (Hyp typ) = ((ctr+1,subst), Hyp typ')
+        where ((ctr,subst), typ') = alphaConvert env typ
+    alphaConvert env (HypI x typ) = ((ctr+1,(x,x'):subst), HypI x' typ')
+        where ((ctr,subst), typ') = alphaConvert env typ
+              x' = createLogicalVariable ctr
+    alphaConvert env (HypV x typ) = ((ctr+1,(x,x'):subst), HypV x' typ')
         where ((ctr,subst), typ') = alphaConvert env typ
               x' = createLogicalVariable ctr
 
@@ -281,21 +288,3 @@ instance AlphaConvert Equation where
     alphaConvert env@(_,subst) (Equ patterns result)
         = ((ctr,subst), Equ patterns result')
         where ((ctr,_), result') = alphaConvert env result
-
-----------------------------------------------------------------------
--- translate unused variables to wildcards
-
-wildcardUnusedVars :: Type -> Type
-wildcardUnusedVars typ@(DTyp hypos cat args) = DTyp hypos' cat args
-    where hypos' = [Hyp x' (wildcardUnusedVars typ') | 
-                    Hyp x typ' <- hypos,
-                    let x' = if unusedInType x typ then wildCId else x]
-
-          unusedInType x (DTyp hypos _cat args) 
-              = and [unusedInType x typ | Hyp _ typ <- hypos] &&
-                and [unusedInExpr x exp | exp <- args]
-
-          unusedInExpr x (EAbs y e)  = unusedInExpr x e
-          unusedInExpr x (EApp e e') = unusedInExpr x e && unusedInExpr x e'
-          unusedInExpr x (EVar y)    = x/=y
-          unusedInExpr x expr        = True
diff --git a/src/GF/Compile/GeneratePMCFG.hs b/src/GF/Compile/GeneratePMCFG.hs
index bb61a0461..8081495f7 100644
--- a/src/GF/Compile/GeneratePMCFG.hs
+++ b/src/GF/Compile/GeneratePMCFG.hs
@@ -371,8 +371,9 @@ expandHOAS abs_defs cnc_defs lincats env =
 
     hoCats :: [CId]
     hoCats = sortNub [c | (_,(ty,_,_)) <- abs_defs
-                        , Hyp _ ty <- case ty of {DTyp hyps val _ -> hyps}
-                        , c   <- fst (catSkeleton ty)]
+                        , h <- case ty of {DTyp hyps val _ -> hyps}
+                        , let ty = typeOfHypo h
+                        , c <- fst (catSkeleton ty)]
   
     -- add a range of PMCFG categories for each GF high-order category
     add_hoCat env@(GrammarEnv last_id catSet seqSet funSet crcSet prodSet) (n,cat) =
diff --git a/src/GF/Compile/GrammarToGFCC.hs b/src/GF/Compile/GrammarToGFCC.hs
index c8bb1c606..d7e46df3e 100644
--- a/src/GF/Compile/GrammarToGFCC.hs
+++ b/src/GF/Compile/GrammarToGFCC.hs
@@ -147,7 +147,7 @@ mkPatt p = case p of
 
 
 mkContext :: A.Context -> [C.Hypo]
-mkContext hyps = [C.Hyp (i2i x) (mkType ty) | (x,ty) <- hyps]
+mkContext hyps = [(if x == identW then C.Hyp else C.HypV (i2i x)) (mkType ty) | (x,ty) <- hyps]
 
 mkTerm :: Term -> C.Term
 mkTerm tr = case tr of