added extra integer to store the offset of a parameter constructor

src/compiler/GF/Compile/Rename.hs

@@ -118,7 +118,7 @@ renameIdentTerm' env@(act,imps) t0 =
 info2status :: Maybe ModuleName -> (Ident,Info) -> StatusInfo
 info2status mq (c,i) = case i of
   AbsFun _ _ Nothing _ -> maybe Con (curry QC) mq
-  ResValue _  -> maybe Con (curry QC) mq
+  ResValue _ _  -> maybe Con (curry QC) mq
   ResParam _ _  -> maybe Con (curry QC) mq
   AnyInd True m -> maybe Con (const (curry QC m)) mq
   AnyInd False m -> maybe Cn (const (curry Q m)) mq
@@ -156,9 +156,9 @@ renameInfo cwd status (m,mi) i info =
     ResParam (Just pp) m -> do
       pp' <- renLoc (mapM (renParam status)) pp
       return (ResParam (Just pp') m)
-    ResValue t -> do
+    ResValue offset ty -> do
-      t <- renLoc (renameTerm status []) t
+      t <- renLoc (renameTerm status []) ty
-      return (ResValue t)
+      return (ResValue offset ty)
     CncCat mcat mdef mref mpr mpmcfg -> liftM5 CncCat (renTerm mcat) (renTerm mdef) (renTerm mref) (renTerm mpr) (return mpmcfg)
     CncFun mty mtr mpr mpmcfg -> liftM3 (CncFun mty)         (renTerm mtr) (renTerm mpr) (return mpmcfg)
     _ -> return info

src/compiler/GF/Compile/Tags.hs

@@ -31,7 +31,7 @@ getLocalTags x (m,mi) =
     getLocations (AbsFun mb_type _ mb_eqs _)    = maybe (ltype "fun")        mb_type ++
                                                   maybe (list (loc "def"))   mb_eqs  
     getLocations (ResParam mb_params _)         = maybe (loc "param")        mb_params
-    getLocations (ResValue mb_type)             = ltype "param-value"          mb_type
+    getLocations (ResValue _ mb_type)           = ltype "param-value"          mb_type
     getLocations (ResOper  mb_type mb_def)      = maybe (ltype "oper-type")  mb_type ++
                                                   maybe (loc "oper-def")     mb_def
     getLocations (ResOverload _ defs)           = list (\(x,y) -> ltype "overload-type" x ++ 

src/compiler/GF/Compile/TypeCheck/Primitives.hs

@@ -8,7 +8,7 @@ typPredefined :: Ident -> Maybe Type
 typPredefined f = case Map.lookup f primitives of
                     Just (ResOper (Just (L _ ty)) _) -> Just ty
                     Just (ResParam _ _)              -> Just typePType
-                    Just (ResValue (L _ ty))         -> Just ty
+                    Just (ResValue _ (L _ ty))       -> Just ty
                     _                                -> Nothing
 
 primitives = Map.fromList
@@ -17,8 +17,8 @@ primitives = Map.fromList
   , (cFloat    , ResOper (Just (noLoc typePType)) Nothing)
   , (cInts     , fun [typeInt] typePType)
   , (cPBool    , ResParam (Just (noLoc [(cPTrue,[]),(cPFalse,[])])) (Just [QC (cPredef,cPTrue), QC (cPredef,cPFalse)]))
-  , (cPTrue    , ResValue (noLoc typePBool))
+  , (cPTrue    , ResValue 0 (noLoc typePBool))
-  , (cPFalse   , ResValue (noLoc typePBool))
+  , (cPFalse   , ResValue 1 (noLoc typePBool))
   , (cError    , fun [typeStr] typeError)  -- non-can. of empty set
   , (cLength   , fun [typeTok] typeInt)
   , (cDrop     , fun [typeInt,typeTok] typeTok)

src/compiler/GF/Compile/Update.hs

@@ -163,7 +163,7 @@ extendMod gr isCompl ((name,mi),cond) base new = foldM try new $ Map.toList (jme
     indirInfo :: ModuleName -> Info -> Info
     indirInfo n info = AnyInd b n' where 
       (b,n') = case info of
-        ResValue _ -> (True,n)
+        ResValue _ _ -> (True,n)
         ResParam _ _ -> (True,n)
         AbsFun _ _ Nothing _ -> (True,n) 
         AnyInd b k -> (b,k)
@@ -174,7 +174,7 @@ globalizeLoc fpath i =
     AbsCat mc             -> AbsCat (fmap gl mc)
     AbsFun mt ma md moper -> AbsFun (fmap gl mt) ma (fmap (fmap gl) md) moper
     ResParam mt mv        -> ResParam (fmap gl mt) mv
-    ResValue t            -> ResValue (gl t)
+    ResValue offset t    -> ResValue offset (gl t)
     ResOper mt m          -> ResOper (fmap gl mt) (fmap gl m)
     ResOverload ms os     -> ResOverload ms (map (\(x,y) -> (gl x,gl y)) os)
     CncCat mc md mr mp mpmcfg-> CncCat (fmap gl mc) (fmap gl md) (fmap gl mr) (fmap gl mp) mpmcfg
@@ -196,8 +196,8 @@ unifyAnyInfo m i j = case (i,j) of
 
   (ResParam mt1 mv1, ResParam mt2 mv2) ->
     liftM2 ResParam (unifyMaybeL mt1 mt2) (unifyMaybe mv1 mv2)
-  (ResValue (L l1 t1), ResValue (L l2 t2)) 
+  (ResValue offset1 (L l1 t1), ResValue offset2 (L l2 t2)) 
-      | t1==t2    -> return (ResValue (L l1 t1))
+      | offset1 == offset2 && t1==t2 -> return (ResValue offset1 (L l1 t1))
       | otherwise                    -> fail ""
   (_, ResOverload ms t) | elem m ms ->
     return $ ResOverload ms t

src/compiler/GF/Grammar/Analyse.hs

@@ -29,7 +29,7 @@ stripInfo i = case i of
   AbsCat _ -> i
   AbsFun mt mi me mb -> AbsFun mt mi Nothing mb
   ResParam mp mt -> ResParam mp Nothing
-  ResValue lt -> i ----
+  ResValue _ lt -> i ----
   ResOper mt md -> ResOper mt Nothing
   ResOverload is fs -> ResOverload is [(lty, L loc (EInt 0)) | (lty,L loc _) <- fs]
   CncCat mty mte _ mtf mpmcfg -> CncCat mty Nothing Nothing Nothing Nothing
@@ -108,7 +108,7 @@ sizeInfo i = case i of
     sum [sum (map (sizeTerm . patt2term) ps) + sizeTerm t | Just es <- [me], L _ (ps,t) <- es]
   ResParam mp mt -> 
     1 + sum [1 + sum [1 + sizeTerm ty | (_,_,ty) <- co] | Just (L _ ps) <- [mp], (_,co) <- ps]
-  ResValue lt -> 0
+  ResValue _ lt -> 0
   ResOper mt md -> 1 + msize mt + msize md
   ResOverload is fs -> 1 + sum [sizeTerm ty + sizeTerm tr | (L _ ty, L _ tr) <- fs]
   CncCat mty _ _ _ _ -> 1 + msize mty   -- ignoring lindef, linref and printname

src/compiler/GF/Grammar/Binary.hs

@@ -25,7 +25,7 @@ import GF.Grammar.Grammar
 import PGF2.Internal(Literal(..),Symbol(..))
 
 -- Please change this every time when the GFO format is changed
-gfoVersion = "GF04"
+gfoVersion = "GF05"
 
 instance Binary Ident where
   put id = put (ident2utf8 id)
@@ -119,7 +119,7 @@ instance Binary Info where
   put (AbsCat x)       = putWord8 0 >> put x
   put (AbsFun w x y z) = putWord8 1 >> put (w,x,y,z)
   put (ResParam x y)   = putWord8 2 >> put (x,y)
-  put (ResValue x)     = putWord8 3 >> put x
+  put (ResValue x y)   = putWord8 3 >> put (x,y)
   put (ResOper x y)    = putWord8 4 >> put (x,y)
   put (ResOverload x y)= putWord8 5 >> put (x,y)
   put (CncCat v w x y z)=putWord8 6 >> put (v,w,x,y,z)
@@ -130,7 +130,7 @@ instance Binary Info where
              0 -> get >>= \x         -> return (AbsCat x)
              1 -> get >>= \(w,x,y,z) -> return (AbsFun w x y z)
              2 -> get >>= \(x,y)     -> return (ResParam x y)
-             3 -> get >>= \x         -> return (ResValue x)
+             3 -> get >>= \(x,y)     -> return (ResValue x y)
              4 -> get >>= \(x,y)     -> return (ResOper x y)
              5 -> get >>= \(x,y)     -> return (ResOverload x y)
              6 -> get >>= \(v,w,x,y,z)->return (CncCat v w x y z)

src/compiler/GF/Grammar/Grammar.hs

@@ -330,7 +330,7 @@ data Info =
 
 -- judgements in resource
  | ResParam (Maybe (L [Param])) (Maybe [Term])   -- ^ (/RES/) the second parameter is list of all possible values
- | ResValue (L Type)                             -- ^ (/RES/) to mark parameter constructors for lookup
+ | ResValue Int (L Type)                         -- ^ (/RES/) to mark parameter constructors for lookup
  | ResOper  (Maybe (L Type)) (Maybe (L Term))    -- ^ (/RES/)
 
  | ResOverload [ModuleName] [(L Type,L Term)]         -- ^ (/RES/) idents: modules inherited

src/compiler/GF/Grammar/Lookup.hs

@@ -83,7 +83,7 @@ lookupResDefLoc gr (m,c)
 
         AnyInd _ n        -> look n c
         ResParam _ _      -> return (noLoc (QC (m,c)))
-        ResValue _        -> return (noLoc (QC (m,c)))
+        ResValue _ _      -> return (noLoc (QC (m,c)))
         _   -> raise $ render (c <+> "is not defined in resource" <+> m)
 
 lookupResType :: ErrorMonad m => Grammar -> QIdent -> m Type
@@ -99,7 +99,7 @@ lookupResType gr (m,c) = do
           return $ mkProd cont val' []
     AnyInd _ n        -> lookupResType gr (n,c)
     ResParam _ _      -> return typePType
-    ResValue (L _ t)  -> return t
+    ResValue _ (L _ t)-> return t
     _   -> raise $ render (c <+> "has no type defined in resource" <+> m)
 
 lookupOverloadTypes :: ErrorMonad m => Grammar -> QIdent -> m [(Term,Type)]
@@ -114,7 +114,7 @@ lookupOverloadTypes gr id@(m,c) = do
           val' <- lock cat val 
           ret $ mkProd cont val' []
     ResParam _ _      -> ret typePType
-    ResValue (L _ t)  -> ret t
+    ResValue _ (L _ t)  -> ret t
     ResOverload os tysts -> do
             tss <- mapM (\x -> lookupOverloadTypes gr (x,c)) os
             return $ [(tr,ty) | (L _ ty,L _ tr) <- tysts] ++
@@ -226,7 +226,7 @@ allOpers gr =
     typesIn info = case info of
       AbsFun  (Just ltyp) _ _ _ -> [ltyp]
       ResOper (Just ltyp) _     -> [ltyp]
-      ResValue ltyp             -> [ltyp]
+      ResValue _ ltyp           -> [ltyp]
       ResOverload _ tytrs       -> [ltyp | (ltyp,_) <- tytrs]
       CncFun  (Just (i,ctx,typ)) _ _ _ ->
                                    [L NoLoc (mkProdSimple ctx (lock' i typ))]

src/compiler/GF/Grammar/Parser.y

@@ -266,7 +266,7 @@ DataDef
 ParamDef :: { [(Ident,Info)] }
 ParamDef
   : Posn LhsIdent '=' ListParConstr Posn { ($2, ResParam (Just (mkL $1 $5 [param | L loc param <- $4])) Nothing) :
-                                        [(f, ResValue (L loc (mkProdSimple co (Cn $2)))) | L loc (f,co) <- $4] }
+                                        [(f, ResValue 0 (L loc (mkProdSimple co (Cn $2)))) | L loc (f,co) <- $4] }
   | Posn LhsIdent                   Posn { [($2, ResParam Nothing Nothing)] }
 
 OperDef :: { [(Ident,Info)] }
@@ -773,7 +773,7 @@ checkInfoType mt jment@(id,info) =
     CncCat pty pd pr ppn _->ifConcrete mt (locPerh pty ++ locPerh pd ++ locPerh pr ++ locPerh ppn)
     CncFun _   pd ppn _  -> ifConcrete mt (locPerh pd ++ locPerh ppn)
     ResParam pparam _    -> ifResource mt (locPerh pparam)
-    ResValue ty          -> ifResource mt (locL ty)
+    ResValue _ ty        -> ifResource mt (locL ty)
     ResOper  pty pt      -> ifOper mt pty pt
     ResOverload _ xs     -> ifResource mt (concat [[loc1,loc2] | (L loc1 _,L loc2 _) <- xs])
   where

src/compiler/GF/Grammar/Printer.hs

@@ -106,7 +106,7 @@ ppJudgement q (id, ResParam pparams _) =
   (case pparams of
      Just (L _ ps) -> '=' <+> ppParams q ps
      _             -> empty) <+> ';'
-ppJudgement q (id, ResValue pvalue) = 
+ppJudgement q (id, ResValue _ pvalue) = 
   "-- param constructor" <+> id <+> ':' <+> 
   (case pvalue of
      (L _ ty) -> ppTerm q 0 ty) <+> ';'

src/compiler/SimpleEditor/Convert.hs

@@ -119,7 +119,7 @@ convCncJment (name,jment) =
   case jment of
     ResParam ops _ ->
       return $ Pa $ Param i (maybe "" (render . ppParams q . unLoc) ops)
-    ResValue _ -> return Ignored
+    ResValue _ _ -> return Ignored
     CncCat (Just (L _ typ)) Nothing Nothing pprn _ -> -- ignores printname !!
       return $ LC $ Lincat i (render $ ppTerm q 0 typ)
     ResOper oltyp (Just lterm) -> return $ Op $ Oper lhs rhs