restructure ResParam and ResValue

9 files changed, 100 insertions, 123 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) -> 
diff --git a/src/GF/Grammar/Binary.hs b/src/GF/Grammar/Binary.hs
index 21adca20c..fbad5ac7e 100644
--- a/src/GF/Grammar/Binary.hs
+++ b/src/GF/Grammar/Binary.hs
@@ -89,7 +89,7 @@ instance Binary Options where
 instance Binary Info where

   put (AbsCat x y)     = putWord8 0 >> put (x,y)

   put (AbsFun x y z)   = putWord8 1 >> put (x,y,z)

-  put (ResParam x)     = putWord8 2 >> put x

+  put (ResParam x y)   = putWord8 2 >> put (x,y)

   put (ResValue x)     = putWord8 3 >> put x

   put (ResOper x y)    = putWord8 4 >> put (x,y)

   put (ResOverload x y)= putWord8 5 >> put (x,y)

@@ -100,7 +100,7 @@ instance Binary Info where
            case tag of

              0 -> get >>= \(x,y)   -> return (AbsCat x y)

              1 -> get >>= \(x,y,z) -> return (AbsFun x y z)

-             2 -> get >>= \x       -> return (ResParam x)

+             2 -> get >>= \(x,y)   -> return (ResParam x y)

              3 -> get >>= \x       -> return (ResValue x)

              4 -> get >>= \(x,y)   -> return (ResOper x y)

              5 -> get >>= \(x,y)   -> return (ResOverload x y)

@@ -122,72 +122,72 @@ instance Binary Term where
   put (Vr x)        = putWord8 0  >> put x

   put (Cn x)        = putWord8 1  >> put x

   put (Con x)       = putWord8 2  >> put x

-  put (Sort x)      = putWord8 4  >> put x

-  put (EInt x)      = putWord8 5  >> put x

-  put (EFloat x)    = putWord8 6  >> put x

-  put (K x)         = putWord8 7  >> put x

-  put (Empty)       = putWord8 8

-  put (App x y)     = putWord8 9  >> put (x,y)

-  put (Abs x y z)   = putWord8 10 >> put (x,y,z)

-  put (Meta x)      = putWord8 11 >> put x

-  put (Prod w x y z)= putWord8 12 >> put (w,x,y,z)

-  put (Typed x y)   = putWord8 14 >> put (x,y)

-  put (Example x y) = putWord8 15 >> put (x,y)

-  put (RecType x)   = putWord8 16 >> put x

-  put (R x)         = putWord8 17 >> put x

-  put (P x y)       = putWord8 18 >> put (x,y)

-  put (ExtR x y)    = putWord8 20 >> put (x,y)

-  put (Table x y)   = putWord8 21 >> put (x,y)

-  put (T x y)       = putWord8 22 >> put (x,y)

-  put (V x y)       = putWord8 24 >> put (x,y)

-  put (S x y)       = putWord8 25 >> put (x,y)

-  put (Let x y)     = putWord8 27 >> put (x,y)

-  put (Q  x y)      = putWord8 29 >> put (x,y)

-  put (QC x y)      = putWord8 30 >> put (x,y)

-  put (C x y)       = putWord8 31 >> put (x,y)

-  put (Glue x y)    = putWord8 32 >> put (x,y)

-  put (EPatt x)     = putWord8 33 >> put x

-  put (EPattType x) = putWord8 34 >> put x

-  put (FV x)        = putWord8 35 >> put x

-  put (Alts x)      = putWord8 36 >> put x

-  put (Strs x)      = putWord8 37 >> put x

-  put (ELin x y)    = putWord8 38 >> put (x,y)

+  put (Sort x)      = putWord8 3  >> put x

+  put (EInt x)      = putWord8 4  >> put x

+  put (EFloat x)    = putWord8 5  >> put x

+  put (K x)         = putWord8 6  >> put x

+  put (Empty)       = putWord8 7

+  put (App x y)     = putWord8 8  >> put (x,y)

+  put (Abs x y z)   = putWord8 9 >> put (x,y,z)

+  put (Meta x)      = putWord8 10 >> put x

+  put (Prod w x y z)= putWord8 11 >> put (w,x,y,z)

+  put (Typed x y)   = putWord8 12 >> put (x,y)

+  put (Example x y) = putWord8 13 >> put (x,y)

+  put (RecType x)   = putWord8 14 >> put x

+  put (R x)         = putWord8 15 >> put x

+  put (P x y)       = putWord8 16 >> put (x,y)

+  put (ExtR x y)    = putWord8 17 >> put (x,y)

+  put (Table x y)   = putWord8 18 >> put (x,y)

+  put (T x y)       = putWord8 19 >> put (x,y)

+  put (V x y)       = putWord8 20 >> put (x,y)

+  put (S x y)       = putWord8 21 >> put (x,y)

+  put (Let x y)     = putWord8 22 >> put (x,y)

+  put (Q  x y)      = putWord8 23 >> put (x,y)

+  put (QC x y)      = putWord8 24 >> put (x,y)

+  put (C x y)       = putWord8 25 >> put (x,y)

+  put (Glue x y)    = putWord8 26 >> put (x,y)

+  put (EPatt x)     = putWord8 27 >> put x

+  put (EPattType x) = putWord8 28 >> put x

+  put (FV x)        = putWord8 29 >> put x

+  put (Alts x)      = putWord8 30 >> put x

+  put (Strs x)      = putWord8 31 >> put x

+  put (ELin x y)    = putWord8 32 >> put (x,y)

 

   get = do tag <- getWord8

            case tag of

              0  -> get >>= \x       -> return (Vr x)

              1  -> get >>= \x       -> return (Cn x)

              2  -> get >>= \x       -> return (Con x)

-             4  -> get >>= \x       -> return (Sort x)

-             5  -> get >>= \x       -> return (EInt x)

-             6  -> get >>= \x       -> return (EFloat x)

-             7  -> get >>= \x       -> return (K x)

-             8  ->                     return (Empty)

-             9  -> get >>= \(x,y)   -> return (App x y)

-             10 -> get >>= \(x,y,z) -> return (Abs x y z)

-             11 -> get >>= \x       -> return (Meta x)

-             12 -> get >>= \(w,x,y,z)->return (Prod w x y z)

-             14 -> get >>= \(x,y)   -> return (Typed x y)

-             15 -> get >>= \(x,y)   -> return (Example x y)

-             16 -> get >>= \x       -> return (RecType x)

-             17 -> get >>= \x       -> return (R x)

-             18 -> get >>= \(x,y)   -> return (P x y)

-             20 -> get >>= \(x,y)   -> return (ExtR x y)

-             21 -> get >>= \(x,y)   -> return (Table x y)

-             22 -> get >>= \(x,y)   -> return (T x y)

-             24 -> get >>= \(x,y)   -> return (V x y)

-             25 -> get >>= \(x,y)   -> return (S x y)

-             27 -> get >>= \(x,y)   -> return (Let x y)

-             29 -> get >>= \(x,y)   -> return (Q  x y)

-             30 -> get >>= \(x,y)   -> return (QC x y)

-             31 -> get >>= \(x,y)   -> return (C x y)

-             32 -> get >>= \(x,y)   -> return (Glue x y)

-             33 -> get >>= \x       -> return (EPatt x)

-             34 -> get >>= \x       -> return (EPattType x)

-             35 -> get >>= \x       -> return (FV x)

-             36 -> get >>= \x       -> return (Alts x)

-             37 -> get >>= \x       -> return (Strs x)

-             38 -> get >>= \(x,y)   -> return (ELin x y)

+             3  -> get >>= \x       -> return (Sort x)

+             4  -> get >>= \x       -> return (EInt x)

+             5  -> get >>= \x       -> return (EFloat x)

+             6  -> get >>= \x       -> return (K x)

+             7  ->                     return (Empty)

+             8  -> get >>= \(x,y)   -> return (App x y)

+             9  -> get >>= \(x,y,z) -> return (Abs x y z)

+             10 -> get >>= \x       -> return (Meta x)

+             11 -> get >>= \(w,x,y,z)->return (Prod w x y z)

+             12 -> get >>= \(x,y)   -> return (Typed x y)

+             13 -> get >>= \(x,y)   -> return (Example x y)

+             14 -> get >>= \x       -> return (RecType x)

+             15 -> get >>= \x       -> return (R x)

+             16 -> get >>= \(x,y)   -> return (P x y)

+             17 -> get >>= \(x,y)   -> return (ExtR x y)

+             18 -> get >>= \(x,y)   -> return (Table x y)

+             19 -> get >>= \(x,y)   -> return (T x y)

+             20 -> get >>= \(x,y)   -> return (V x y)

+             21 -> get >>= \(x,y)   -> return (S x y)

+             22 -> get >>= \(x,y)   -> return (Let x y)

+             23 -> get >>= \(x,y)   -> return (Q  x y)

+             24 -> get >>= \(x,y)   -> return (QC x y)

+             25 -> get >>= \(x,y)   -> return (C x y)

+             26 -> get >>= \(x,y)   -> return (Glue x y)

+             27 -> get >>= \x       -> return (EPatt x)

+             28 -> get >>= \x       -> return (EPattType x)

+             29 -> get >>= \x       -> return (FV x)

+             30 -> get >>= \x       -> return (Alts x)

+             31 -> get >>= \x       -> return (Strs x)

+             32 -> get >>= \(x,y)   -> return (ELin x y)

              _  -> decodingError

 

 instance Binary Patt where

diff --git a/src/GF/Grammar/Grammar.hs b/src/GF/Grammar/Grammar.hs
index 1b76fe27e..8d1468d9d 100644
--- a/src/GF/Grammar/Grammar.hs
+++ b/src/GF/Grammar/Grammar.hs
@@ -20,7 +20,6 @@ module GF.Grammar.Grammar (SourceGrammar,
         SourceModule,
         mapSourceModule,
         Info(..),
-        PValues,
         Type,
         Cat,
         Fun,
@@ -37,7 +36,6 @@ module GF.Grammar.Grammar (SourceGrammar,
         Labelling,
         Assign,
         Case,
-        Cases,
         LocalDef,
         Param,
         Altern,
@@ -66,9 +64,6 @@ type SourceModule = (Ident, SourceModInfo)
 mapSourceModule :: (SourceModInfo -> SourceModInfo) -> (SourceModule -> SourceModule)
 mapSourceModule f (i,mi) = (i, f mi)
 
--- this is created in CheckGrammar, and so are Val and PVal
-type PValues = [Term]
-
 -- | the constructors are judgements in 
 --
 --   - abstract syntax (/ABS/)
@@ -84,8 +79,8 @@ data Info =
  | AbsFun   (Maybe Type) (Maybe Int) (Maybe [Equation])  -- ^ (/ABS/) type, arrity and definition of function
 
 -- judgements in resource
- | ResParam (Maybe ([Param],Maybe PValues))  -- ^ (/RES/)
- | ResValue (Maybe (Type,Maybe Int))         -- ^ (/RES/) to mark parameter constructors for lookup
+ | ResParam (Maybe [Param]) (Maybe [Term])   -- ^ (/RES/) the second parameter is list of all possible values
+ | ResValue Type                             -- ^ (/RES/) to mark parameter constructors for lookup
  | ResOper  (Maybe Type) (Maybe Term)        -- ^ (/RES/)
 
  | ResOverload [Ident] [(Type,Term)]         -- ^ (/RES/) idents: modules inherited
diff --git a/src/GF/Grammar/Lookup.hs b/src/GF/Grammar/Lookup.hs
index 19dde6d09..93a3fdcd3 100644
--- a/src/GF/Grammar/Lookup.hs
+++ b/src/GF/Grammar/Lookup.hs
@@ -33,8 +33,7 @@ module GF.Grammar.Lookup (
 	       lookupAbsDef, 
 	       lookupLincat, 
 	       lookupFunType,
-	       lookupCatContext,
-	       opersForType
+	       lookupCatContext
 	      ) where
 
 import GF.Data.Operations
@@ -93,7 +92,7 @@ lookupResDefKind gr m c
       CncFun _                (Just tr) _ -> liftM (flip (,) 1) (return tr) ---- $ unlock c tr
 
       AnyInd _ n        -> look False n c
-      ResParam _        -> return (QC m c,2)
+      ResParam _ _      -> return (QC m c,2)
       ResValue _        -> return (QC m c,2)
       _   -> Bad $ render (ppIdent c <+> text "is not defined in resource" <+> ppIdent m)
   lookExt m c =
@@ -113,8 +112,8 @@ lookupResType gr m c = do
           return $ mkProd cont val' []
     CncFun _ _ _      -> lookFunType m m c
     AnyInd _ n        -> lookupResType gr n c
-    ResParam _        -> return $ typePType
-    ResValue (Just (t,_))  -> return $ qualifAnnotPar m t
+    ResParam _ _      -> return $ typePType
+    ResValue t        -> return $ qualifAnnotPar m t
     _   -> Bad $ render (ppIdent c <+> text "has no type defined in resource" <+> ppIdent m)
   where
     lookFunType e m c = do
@@ -152,15 +151,15 @@ lookupOrigInfo gr m c = do
       AnyInd _ n  -> lookupOrigInfo gr n c
       i           -> return (m,i)
 
-lookupParams :: SourceGrammar -> Ident -> Ident -> Err ([Param],Maybe PValues)
+lookupParams :: SourceGrammar -> Ident -> Ident -> Err ([Param],Maybe [Term])
 lookupParams gr = look True where 
   look isTop m c = do
     mo <- lookupModule gr m
     info <- lookupIdentInfo mo c
     case info of
-      ResParam (Just psm) -> return psm
-      AnyInd _ n          -> look False n c
-      _                   -> Bad $ render (ppIdent c <+> text "has no parameters defined in resource" <+> ppIdent m)
+      ResParam (Just psm) m -> return (psm,m)
+      AnyInd _ n            -> look False n c
+      _                     -> Bad $ render (ppIdent c <+> text "has no parameters defined in resource" <+> ppIdent m)
   lookExt m c =
     checks [look False n c | n <- allExtensions gr m]
 
@@ -261,22 +260,3 @@ lookupCatContext gr m c = do
     AbsCat (Just co) _ -> return co
     AnyInd _ n         -> lookupCatContext gr n c
     _                  -> Bad (render (text "unknown category" <+> ppIdent c))
-
--- The first type argument is uncomputed, usually a category symbol.
--- This is a hack to find implicit (= reused) opers.
-
-opersForType :: SourceGrammar -> Type -> Type -> [(QIdent,Term)]
-opersForType gr orig val = 
-  [((i,f),ty) | (i,m) <- modules gr, (f,ty) <- opers i m val] where
-    opers i m val = 
-      [(f,ty) |
-        (f,ResOper (Just ty) _) <- tree2list $ jments m,
-        elem (valTypeCnc ty) [val,orig]
-        ] ++
-      let cat = snd (valCat orig) in --- ignore module
-      [(f,ty) |
-        Ok a <- [abstractOfConcrete gr i >>= lookupModule gr],
-        (f, AbsFun (Just ty0) _ _) <- tree2list $ jments a,
-        let ty = redirectTerm i ty0,
-        cat == snd (valCat ty) ---
-        ]
diff --git a/src/GF/Grammar/Parser.y b/src/GF/Grammar/Parser.y
index 1c6b51e77..320053674 100644
--- a/src/GF/Grammar/Parser.y
+++ b/src/GF/Grammar/Parser.y
@@ -254,9 +254,9 @@ DataDef
 
 ParamDef :: { [(Ident,SrcSpan,Info)] }
 ParamDef
-  : Posn Ident '=' ListParConstr Posn {  ($2, ($1,$5), ResParam (Just ($4,Nothing))) :
-                                        [(f,  ($1,$5), ResValue (Just (mkProdSimple co (Cn $2),Nothing))) | (f,co) <- $4] }
-  | Posn Ident                   Posn { [($2, ($1,$3), ResParam Nothing)] }
+  : Posn Ident '=' ListParConstr Posn {  ($2, ($1,$5), ResParam (Just $4) Nothing) :
+                                        [(f,  ($1,$5), ResValue (mkProdSimple co (Cn $2))) | (f,co) <- $4] }
+  | Posn Ident                   Posn { [($2, ($1,$3), ResParam Nothing   Nothing)] }
 
 OperDef :: { [(Ident,SrcSpan,Info)] }
 OperDef
@@ -684,14 +684,14 @@ checkInfoType MTAbstract       (id,pos,info) =
     _            -> failLoc (fst pos) "illegal definition in abstract module" 
 checkInfoType MTResource       (id,pos,info) =
   case info of
-    ResParam _   -> return ()
+    ResParam _ _ -> return ()
     ResValue _   -> return ()
     ResOper  _ _ -> return ()
     ResOverload _ _ -> return ()
     _            -> failLoc (fst pos) "illegal definition in resource module" 
 checkInfoType MTInterface      (id,pos,info) =
   case info of
-    ResParam _   -> return ()
+    ResParam _ _ -> return ()
     ResValue _   -> return ()
     ResOper  _ _ -> return ()
     ResOverload _ _ -> return ()
@@ -700,14 +700,14 @@ checkInfoType (MTConcrete _)   (id,pos,info) =
   case info of
     CncCat _ _ _ -> return ()
     CncFun _ _ _ -> return ()
-    ResParam _   -> return ()
+    ResParam _ _ -> return ()
     ResValue _   -> return ()
     ResOper  _ _ -> return ()
     ResOverload _ _ -> return ()
     _            -> failLoc (fst pos) "illegal definition in concrete module" 
 checkInfoType (MTInstance _)   (id,pos,info) =
   case info of
-    ResParam _   -> return ()
+    ResParam _ _ -> return ()
     ResValue _   -> return ()
     ResOper  _ _ -> return ()
     _            -> failLoc (fst pos) "illegal definition in instance module" 
diff --git a/src/GF/Grammar/Printer.hs b/src/GF/Grammar/Printer.hs
index 80195b2d1..06cac9705 100644
--- a/src/GF/Grammar/Printer.hs
+++ b/src/GF/Grammar/Printer.hs
@@ -91,11 +91,11 @@ ppJudgement q (id, AbsFun ptype _ pexp) =
      Just []  -> empty

      Just eqs -> text "def" <+> vcat [ppIdent id <+> hsep (map (ppPatt q 2) ps) <+> equals <+> ppTerm q 0 e <+> semi | (ps,e) <- eqs]

      Nothing  -> empty)

-ppJudgement q (id, ResParam pparams) = 

+ppJudgement q (id, ResParam pparams _) = 

   text "param" <+> ppIdent id <+>

   (case pparams of

-     Just (ps,_) -> equals <+> fsep (intersperse (char '|') (map (ppParam q) ps))

-     _           -> empty) <+> semi

+     Just ps -> equals <+> fsep (intersperse (char '|') (map (ppParam q) ps))

+     _       -> empty) <+> semi

 ppJudgement q (id, ResValue pvalue) = empty

 ppJudgement q (id, ResOper  ptype pexp) =

   text "oper" <+> ppIdent id <+>