Putting def definitions in place.

4 files changed, 32 insertions, 17 deletions

diff --git a/src/GF/Compile/Extend.hs b/src/GF/Compile/Extend.hs
index 66a632445..582a1e6ae 100644
--- a/src/GF/Compile/Extend.hs
+++ b/src/GF/Compile/Extend.hs
@@ -35,6 +35,7 @@ indirInfo n info = AnyInd b n' where
   (b,n') = case info of
     ResValue _ -> (True,n)
     ResParam _ -> (True,n)
+    AbsFun _ (Yes EData) -> (True,n) 
     AnyInd b k -> (b,k)
     _ -> (False,n) ---- canonical in Abs
 
diff --git a/src/GF/Compile/GrammarToCanon.hs b/src/GF/Compile/GrammarToCanon.hs
index d5977b510..b097405de 100644
--- a/src/GF/Compile/GrammarToCanon.hs
+++ b/src/GF/Compile/GrammarToCanon.hs
@@ -60,9 +60,15 @@ redInfo am (c,info) = errIn ("translating definition of" +++ prt c) $ do
   c' <- redIdent c 
   case info of
     AbsCat (Yes cont) pfs -> do
-      returns c' $ C.AbsCat cont [] ---- constrs
+      let fs = case pfs of
+                 Yes ts -> [(m,c) | Q m c <- ts]
+                 _ -> []
+      returns c' $ C.AbsCat cont fs
     AbsFun (Yes typ) pdf -> do
-      returns c' $ C.AbsFun typ (Eqs []) ---- df
+      let df = case pdf of
+                 Yes t -> t
+                 _ -> EData --- data vs. primitive
+      returns c' $ C.AbsFun typ df
 
     ResParam (Yes ps) -> do
       ps' <- mapM redParam ps
diff --git a/src/GF/Compile/Rename.hs b/src/GF/Compile/Rename.hs
index 1e45b5fcc..eb6f6dcb9 100644
--- a/src/GF/Compile/Rename.hs
+++ b/src/GF/Compile/Rename.hs
@@ -101,7 +101,7 @@ renameIdentPatt env p = do
 
 info2status :: Maybe Ident -> (Ident,Info) -> (Ident,StatusInfo)
 info2status mq (c,i) = (c, case i of
-  AbsFun _ (Yes (Con g)) | g == c -> maybe Con QC mq
+  AbsFun _ (Yes EData) -> maybe Con QC mq
   ResValue _  -> maybe Con QC mq
   ResParam _  -> maybe Con QC mq
   AnyInd True m -> maybe Con (const (QC m)) mq
@@ -143,7 +143,7 @@ renameInfo :: Status -> (Ident,Info) -> Err (Ident,Info)
 renameInfo status (i,info) = errIn ("renaming definition of" +++ prt i) $ 
                                 liftM ((,) i) $ case info of
   AbsCat pco pfs -> liftM2 AbsCat (renPerh (renameContext status) pco)
-                                  (return pfs) ----
+                                  (renPerh (mapM rent) pfs)
   AbsFun pty ptr -> liftM2 AbsFun (ren pty) (ren ptr)
 
   ResOper pty ptr -> liftM2 ResOper (ren pty) (ren ptr)
@@ -172,8 +172,7 @@ renameTerm env vars = ren vars where
     Con _  -> renid trm
     Q _ _  -> renid trm
     QC _ _ -> renid trm
-
-----    Eqs eqs -> Eqs (map (renameEquation consts vs) eqs)
+    Eqs eqs -> liftM Eqs $ mapM (renameEquation env vars) eqs
     T i cs -> do
       i' <- case i of
         TTyped ty -> liftM TTyped $ ren vs ty -- the only annotation in source
@@ -212,9 +211,10 @@ renamePattern env patt = case patt of
     c' <- renameIdentTerm env $ Cn c
     psvss <- mapM renp ps
     let (ps',vs) = unzip psvss
-    return $ case c' of
-      QC p d -> (PP p d ps', concat vs)
-      _ -> (PC c ps', concat vs)
+    case c' of
+      QC p d -> return (PP p d ps', concat vs)
+      Q  p d -> return (PP p d ps', concat vs) ---- should not happen
+      _ -> prtBad "unresolved pattern" c' ---- (PC c ps', concat vs)
 
 ----  PP p c ps -> (PP p c ps',concat vs') where (ps',vs') = unzip $ map renp ps
 
@@ -255,9 +255,10 @@ renameContext b = renc [] where
     _ -> return cont
   ren = renameTerm b
 
-{-
-renameEquation :: Status -> [Ident] -> Equation -> Equation
-renameEquation b vs (ps,t) = (ps',renameTerm b (concat vs' ++ vs) t) where
-  (ps',vs') = unzip $ map (renamePattern b vs) ps
--}
+-- vars not needed in env, since patterns always overshadow old vars
 
+renameEquation :: Status -> [Ident] -> Equation -> Err Equation
+renameEquation b vs (ps,t) = do
+  (ps',vs') <- liftM unzip $ mapM (renamePattern b) ps
+  t'        <- renameTerm b (concat vs' ++ vs) t
+  return (ps',t')
diff --git a/src/GF/Compile/Update.hs b/src/GF/Compile/Update.hs
index 9bc16f03a..4eb4849ef 100644
--- a/src/GF/Compile/Update.hs
+++ b/src/GF/Compile/Update.hs
@@ -36,9 +36,9 @@ combineAnyInfos = combineInfos unifyAnyInfo
 unifyAnyInfo :: Ident -> Info -> Info -> Err Info
 unifyAnyInfo c i j = errIn ("combining information for" +++ prt c) $ case (i,j) of
   (AbsCat mc1 mf1, AbsCat mc2 mf2) -> 
-    liftM2 AbsCat (unifPerhaps mc1 mc2) (unifPerhaps mf1 mf2) ---- adding constrs
+    liftM2 AbsCat (unifPerhaps mc1 mc2) (unifConstrs mf1 mf2) -- adding constrs
   (AbsFun mt1 md1, AbsFun mt2 md2) -> 
-    liftM2 AbsFun (unifPerhaps mt1 mt2) (unifAbsDefs md1 md2) ---- adding defs
+    liftM2 AbsFun (unifPerhaps mt1 mt2) (unifAbsDefs md1 md2) -- adding defs
 
   (ResParam mt1, ResParam mt2) -> liftM ResParam $ unifPerhaps mt1 mt2
   (ResOper mt1 m1, ResOper mt2 m2) -> 
@@ -95,4 +95,11 @@ unifAbsDefs p1 p2 = case (p1,p2) of
   (Nope, _)  -> return p2
   (_, Nope)  -> return p1
   (Yes (Eqs bs), Yes (Eqs ds)) -> return $ yes $ Eqs $ bs ++ ds --- order!
-  _ -> Bad "update conflict"
+  _ -> Bad "update conflict for definitions"
+
+unifConstrs :: Perh [Term] -> Perh [Term] -> Err (Perh [Term])
+unifConstrs p1 p2 = case (p1,p2) of
+  (Nope, _)  -> return p2
+  (_, Nope)  -> return p1
+  (Yes bs, Yes ds) -> return $ yes $ bs ++ ds
+  _ -> Bad "update conflict for constructors"