restructure ResParam and ResValue

4 files changed, 18 insertions, 16 deletions

diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs
index 6b73adff5..21cb35b7b 100644
--- a/src/GF/Compile/CheckGrammar.hs
+++ b/src/GF/Compile/CheckGrammar.hs
@@ -207,9 +207,9 @@ checkInfo gr (m,mo) c info = do
         sort [let (xs,t) = typeFormCnc x in t : map (\(b,x,t) -> t) xs | (_,x) <- tysts1]
       return (ResOverload os [(y,x) | (x,y) <- tysts'])
 
-    ResParam (Just (pcs,_)) -> chIn "parameter type" $ do
+    ResParam (Just pcs) _ -> chIn "parameter type" $ do
       ts <- checkErr $ lookupParamValues gr m c
-      return (ResParam (Just (pcs, Just ts)))
+      return (ResParam (Just pcs) (Just ts))
 
     _ ->  return info
  where
@@ -293,7 +293,7 @@ allDependencies ism b =
     opty _ = []
     pts i = case i of
       ResOper pty pt -> [pty,pt]
-      ResParam (Just (ps,_)) -> [Just t | (_,cont) <- ps, (_,_,t) <- cont]
+      ResParam (Just ps) _ -> [Just t | (_,cont) <- ps, (_,_,t) <- cont]
       CncCat pty _ _ -> [pty]
       CncFun _   pt _ -> [pt]  ---- (Maybe (Ident,(Context,Type))
       AbsFun pty _ ptr -> [pty] --- ptr is def, which can be mutual
diff --git a/src/GF/Compile/GrammarToGFCC.hs b/src/GF/Compile/GrammarToGFCC.hs
index dd3a14f38..bf854e7ac 100644
--- a/src/GF/Compile/GrammarToGFCC.hs
+++ b/src/GF/Compile/GrammarToGFCC.hs
@@ -309,8 +309,8 @@ canon2canon opts abs cg0 =
 
     -- flatten record arguments of param constructors
   p2p (f,j) = case j of
-      ResParam (Just (ps,v)) -> 
-        ResParam (Just ([(c,concatMap unRec cont) | (c,cont) <- ps],Nothing))
+      ResParam (Just ps) _ -> 
+        ResParam (Just [(c,concatMap unRec cont) | (c,cont) <- ps]) Nothing
       _ -> j
   unRec (bt,x,ty) = case ty of
       RecType fs -> [ity | (_,typ) <- fs, ity <- unRec (Explicit,identW,typ)] 
@@ -355,7 +355,7 @@ paramValues cgr = (labels,untyps,typs) where
               ty  <- typsFrom ty0
             ] ++ [
              Q m ty | 
-              (m,(ty,ResParam _)) <- jments
+              (m,(ty,ResParam _ _)) <- jments
             ] ++ [ty | 
               (_,(_,CncFun _ (Just tr) _)) <- jments,
               ty  <- err (const []) snd $ appSTM (typsFromTrm tr) []
diff --git a/src/GF/Compile/Rename.hs b/src/GF/Compile/Rename.hs
index d037aaafc..30616b4cb 100644
--- a/src/GF/Compile/Rename.hs
+++ b/src/GF/Compile/Rename.hs
@@ -107,7 +107,7 @@ info2status :: Maybe Ident -> (Ident,Info) -> StatusInfo
 info2status mq (c,i) = case i of
   AbsFun _ _ Nothing -> maybe Con QC mq
   ResValue _  -> maybe Con QC mq
-  ResParam _  -> maybe Con QC mq
+  ResParam _ _  -> maybe Con QC mq
   AnyInd True m -> maybe Con (const (QC m)) mq
   AnyInd False m -> maybe Cn (const (Q m)) mq
   _           -> maybe Cn  Q mq
@@ -148,12 +148,12 @@ renameInfo mo status i info = checkIn
   ResOverload os tysts -> 
     liftM (ResOverload os) (mapM (pairM rent) tysts)
 
-  ResParam (Just (pp,m)) -> do
+  ResParam (Just pp) m -> do
     pp' <- mapM (renameParam status) pp
-    return $ ResParam $ Just (pp',m)
-  ResValue (Just (t,m)) -> do
-    t' <- rent t
-    return $ ResValue $ Just (t',m)
+    return (ResParam (Just pp') m)
+  ResValue t -> do
+    t <- rent t
+    return (ResValue t)
   CncCat pty ptr ppr -> liftM3 CncCat (ren pty) (ren ptr) (ren ppr)
   CncFun mt  ptr ppr -> liftM2 (CncFun mt)      (ren ptr) (ren ppr)
   _ -> return info
diff --git a/src/GF/Compile/Update.hs b/src/GF/Compile/Update.hs
index e4e827451..1e39a2e03 100644
--- a/src/GF/Compile/Update.hs
+++ b/src/GF/Compile/Update.hs
@@ -162,7 +162,7 @@ extendMod gr isCompl (name,cond) base old new = foldM try new $ Map.toList old
     indirInfo n info = AnyInd b n' where 
       (b,n') = case info of
         ResValue _ -> (True,n)
-        ResParam _ -> (True,n)
+        ResParam _ _ -> (True,n)
         AbsFun _ _ Nothing -> (True,n) 
         AnyInd b k -> (b,k)
         _ -> (False,n) ---- canonical in Abs
@@ -174,9 +174,11 @@ unifyAnyInfo m i j = case (i,j) of
   (AbsFun mt1 ma1 md1, AbsFun mt2 ma2 md2) -> 
     liftM3 AbsFun (unifMaybe mt1 mt2) (unifAbsArrity ma1 ma2) (unifAbsDefs md1 md2) -- adding defs
 
-  (ResParam mt1, ResParam mt2) -> liftM ResParam $ unifMaybe mt1 mt2
-  (ResValue mt1, ResValue mt2) -> 
-    liftM ResValue $ unifMaybe mt1 mt2
+  (ResParam mt1 mv1, ResParam mt2 mv2) ->
+    liftM2 ResParam (unifMaybe mt1 mt2) (unifMaybe mv1 mv2)
+  (ResValue t1, ResValue t2) 
+      | t1==t2    -> return (ResValue t1)
+      | otherwise -> fail ""
   (_, ResOverload ms t) | elem m ms ->
     return $ ResOverload ms t
   (ResOper mt1 m1, ResOper mt2 m2) ->