refactor the PGF.Expr type and the evaluation of abstract expressions

6 files changed, 14 insertions, 44 deletions

diff --git a/src/GF/Grammar/Binary.hs b/src/GF/Grammar/Binary.hs
index f61df1c67..0521ff9c3 100644
--- a/src/GF/Grammar/Binary.hs
+++ b/src/GF/Grammar/Binary.hs
@@ -115,7 +115,6 @@ 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 (EData)       = putWord8 3

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

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

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

@@ -125,7 +124,6 @@ instance Binary Term where
   put (Abs x y)     = putWord8 10 >> put (x,y)

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

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

-  put (Eqs x)       = putWord8 13 >> put x

   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

@@ -155,7 +153,6 @@ instance Binary Term where
              0  -> get >>= \x       -> return (Vr x)

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

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

-             3  ->                     return (EData)

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

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

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

@@ -165,7 +162,6 @@ instance Binary Term where
              10 -> get >>= \(x,y)   -> return (Abs x y)

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

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

-             13 -> get >>= \x       -> return (Eqs x)

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

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

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

diff --git a/src/GF/Grammar/Grammar.hs b/src/GF/Grammar/Grammar.hs
index c3f303655..37692ec39 100644
--- a/src/GF/Grammar/Grammar.hs
+++ b/src/GF/Grammar/Grammar.hs
@@ -81,7 +81,7 @@ type PValues = [Term]
 data Info =
 -- judgements in abstract syntax
    AbsCat   (Maybe Context) (Maybe [Term])   -- ^ (/ABS/) constructors; must be 'Id' or 'QId'
- | AbsFun   (Maybe Type) (Maybe Term)        -- ^ (/ABS/) 'Yes f' = canonical
+ | AbsFun   (Maybe Type) (Maybe [Equation])  -- ^ (/ABS/)
 
 -- judgements in resource
  | ResParam (Maybe ([Param],Maybe PValues))  -- ^ (/RES/)
@@ -108,7 +108,6 @@ data Term =
    Vr Ident             -- ^ variable
  | Cn Ident             -- ^ constant
  | Con Ident            -- ^ constructor
- | EData                -- ^ to mark in definition that a fun is a constructor
  | Sort Ident           -- ^ basic type
  | EInt Integer         -- ^ integer literal
  | EFloat Double        -- ^ floating point literal
@@ -119,8 +118,6 @@ data Term =
  | Abs Ident Term       -- ^ abstraction: @\x -> b@
  | Meta MetaSymb        -- ^ metavariable: @?i@ (only parsable: ? = ?0)
  | Prod Ident Term Term -- ^ function type: @(x : A) -> B@
- | Eqs [Equation]       -- ^ abstraction by cases: @fn {x y -> b ; z u -> c}@
-                        -- only used in internal representation
  | Typed Term Term      -- ^ type-annotated term
 --
 -- /below this, the constructors are only for concrete syntax/
diff --git a/src/GF/Grammar/Lookup.hs b/src/GF/Grammar/Lookup.hs
index 312cfd38e..3df2db7da 100644
--- a/src/GF/Grammar/Lookup.hs
+++ b/src/GF/Grammar/Lookup.hs
@@ -227,7 +227,7 @@ qualifAnnotPar m t = case t of
   Con c -> QC m c
   _ -> composSafeOp (qualifAnnotPar m) t
 
-lookupAbsDef :: SourceGrammar -> Ident -> Ident -> Err (Maybe Term)
+lookupAbsDef :: SourceGrammar -> Ident -> Ident -> Err (Maybe [Equation])
 lookupAbsDef gr m c = errIn ("looking up absdef of" +++ prt c) $ do
   mo <- lookupModule gr m
   info <- lookupIdentInfo mo c
diff --git a/src/GF/Grammar/Macros.hs b/src/GF/Grammar/Macros.hs
index 958ad9a68..fa1b75dda 100644
--- a/src/GF/Grammar/Macros.hs
+++ b/src/GF/Grammar/Macros.hs
@@ -593,10 +593,6 @@ composOp co trm =
         i'  <- changeTableType co i
         return (TSh i' cc')
 
-   Eqs cc -> 
-     do cc' <- mapPairListM (co . snd) cc
-        return (Eqs cc')
-
    V ty vs ->
      do ty' <- co ty
         vs' <- mapM co vs
diff --git a/src/GF/Grammar/Parser.y b/src/GF/Grammar/Parser.y
index fbdb541b4..981589ac0 100644
--- a/src/GF/Grammar/Parser.y
+++ b/src/GF/Grammar/Parser.y
@@ -72,7 +72,6 @@ import GF.Compile.Update (buildAnyTree)
  'data'       { T_data      }
  'def'        { T_def       }
  'flags'      { T_flags     }
- 'fn'         { T_fn        }
  'fun'        { T_fun       }
  'in'         { T_in        }
  'incomplete' { T_incomplete}
@@ -241,19 +240,19 @@ CatDef
 
 FunDef :: { [(Ident,SrcSpan,Info)] }
 FunDef
-  : Posn ListIdent ':' Exp Posn { [(fun, ($1,$5), AbsFun (Just $4) Nothing) | fun <- $2] } 
+  : Posn ListIdent ':' Exp Posn { [(fun, ($1,$5), AbsFun (Just $4) (Just [])) | fun <- $2] } 
 
 DefDef :: { [(Ident,SrcSpan,Info)] }
 DefDef
-  : Posn ListName '=' Exp         Posn { [(f, ($1,$5),AbsFun Nothing (Just $4)) | f <- $2] }
-  | Posn Name ListPatt '=' Exp    Posn { [($2,($1,$6),AbsFun Nothing (Just (Eqs [($3,$5)])))] }
+  : Posn ListName '=' Exp         Posn { [(f, ($1,$5),AbsFun Nothing (Just [([],$4)])) | f <- $2] }
+  | Posn Name ListPatt '=' Exp    Posn { [($2,($1,$6),AbsFun Nothing (Just [($3,$5)]))] }
 
 DataDef :: { [(Ident,SrcSpan,Info)] }
 DataDef
-  : Posn Ident '=' ListDataConstr Posn { ($2,   ($1,$5), AbsCat Nothing     (Just (map Cn $4))) :
-                                         [(fun, ($1,$5), AbsFun Nothing     (Just EData)) | fun <- $4] }
-  | Posn ListIdent ':' Exp Posn        { [(cat, ($1,$5), AbsCat Nothing     (Just (map Cn $2))) | Ok (_,cat) <- [valCat $4]] ++
-                                         [(fun, ($1,$5), AbsFun (Just $4) (Just EData)) | fun <- $2] }                                         
+  : Posn Ident '=' ListDataConstr Posn { ($2,   ($1,$5), AbsCat Nothing   (Just (map Cn $4))) :
+                                         [(fun, ($1,$5), AbsFun Nothing   Nothing) | fun <- $4] }
+  | Posn ListIdent ':' Exp Posn        { [(cat, ($1,$5), AbsCat Nothing   (Just (map Cn $2))) | Ok (_,cat) <- [valCat $4]] ++
+                                         [(fun, ($1,$5), AbsFun (Just $4) Nothing) | fun <- $2] }                                         
 
 ParamDef :: { [(Ident,SrcSpan,Info)] }
 ParamDef
@@ -385,7 +384,6 @@ Exp
   | Exp3 'where' '{' ListLocDef '}'   {%
                                         do defs <- mapM tryLoc $4
                                            return $ mkLet defs $1 }
-  | 'fn' '{' ListEquation '}'         { Eqs $3 }
   | 'in' Exp5 String                  { Example $2 $3 }
   | Exp1                              { $1 }
 
@@ -441,7 +439,6 @@ Exp6
   | Double                { EFloat $1 }
   | '?'                   { Meta (int2meta 0) }
   | '[' ']'               { Empty }
-  | 'data'                { EData }
   | '[' Ident Exps ']'    { foldl App (Vr (mkListId $2)) $3 }
   | '[' String ']'        { case $2 of
                               []   -> Empty
@@ -486,7 +483,6 @@ Patt2
   | '#' Ident '.' Ident       { PM $2 $4 }
   | '_'                       { wildPatt }
   | Ident                     { PV $1 }
-  | '{' Ident '}'             { PC $2 [] }
   | Ident '.' Ident           { PP $1 $3 [] }
   | Integer                   { PInt $1 }
   | Double                    { PFloat  $1 }
@@ -569,15 +565,6 @@ ListCase
   : Case              { [$1]    } 
   | Case ';' ListCase { $1 : $3 }
 
-Equation :: { Equation }
-Equation
-  : ListPatt '->' Exp         { ($1,$3) } 
-
-ListEquation :: { [Equation] }
-ListEquation
-  : Equation                  { (:[]) $1  }
-  | Equation ';' ListEquation { (:) $1 $3 }
-
 Altern :: { (Term,Term) }
 Altern
   : Exp '/' Exp { ($1,$3) } 
@@ -621,9 +608,9 @@ listCatDef id pos cont size = [catd,nilfund,consfund]
     baseId = mkBaseId id
     consId = mkConsId id
 
-    catd     = (listId, pos,   AbsCat (Just cont')   (Just [Cn baseId,Cn consId]))
-    nilfund  = (baseId, pos, AbsFun (Just niltyp)  (Just EData))
-    consfund = (consId, pos, AbsFun (Just constyp) (Just EData))
+    catd     = (listId, pos, AbsCat (Just cont')   (Just [Cn baseId,Cn consId]))
+    nilfund  = (baseId, pos, AbsFun (Just niltyp)  Nothing)
+    consfund = (consId, pos, AbsFun (Just constyp) Nothing)
 
     cont' = [(mkId x i,ty) | (i,(x,ty)) <- zip [0..] cont]
     xs = map (Vr . fst) cont'
diff --git a/src/GF/Grammar/Printer.hs b/src/GF/Grammar/Printer.hs
index 474b22fe9..b658cc9d1 100644
--- a/src/GF/Grammar/Printer.hs
+++ b/src/GF/Grammar/Printer.hs
@@ -84,10 +84,8 @@ ppJudgement q (id, AbsFun ptype pexp) =
      Just typ   -> text "fun" <+> ppIdent id <+> colon <+> ppTerm q 0 typ <+> semi

      Nothing    -> empty) $$

   (case pexp of

-     Just EData -> empty

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

-     Just exp   -> text "def" <+> ppIdent id <+> equals <+> ppTerm q 0 exp <+> semi

-     Nothing    -> 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) = 

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

   (case pparams of

@@ -145,9 +143,6 @@ ppTerm q d (Prod x a b)= if x == identW
 ppTerm q d (Table kt vt)=prec d 0 (ppTerm q 3 kt <+> text "=>" <+> ppTerm q 0 vt)

 ppTerm q d (Let l e)    = let (ls,e') = getLet e

                           in prec d 0 (text "let" <+> vcat (map (ppLocDef q) (l:ls)) $$ text "in" <+> ppTerm q 0 e')

-ppTerm q d (Eqs es)     = text "fn" <+> lbrace $$

-                          nest 2 (vcat (map (\e -> ppEquation q e <+> semi) es)) $$

-                          rbrace

 ppTerm q d (Example e s)=prec d 0 (text "in" <+> ppTerm q 5 e <+> text (show s))

 ppTerm q d (C e1 e2)    =prec d 1 (ppTerm q 2 e1 <+> text "++" <+> ppTerm q 1 e2)

 ppTerm q d (Glue e1 e2) =prec d 2 (ppTerm q 3 e1 <+> char '+'  <+> ppTerm q 2 e2)

@@ -182,7 +177,6 @@ ppTerm q d (EInt n)    = integer n
 ppTerm q d (EFloat f)  = double f

 ppTerm q d (Meta _)    = char '?'

 ppTerm q d (Empty)     = text "[]"

-ppTerm q d (EData)     = text "data"

 ppTerm q d (R xs)      = braces (fsep (punctuate semi [ppLabel l <+> 

                                                        fsep [case mb_t of {Just t -> colon <+> ppTerm q 0 t; Nothing -> empty},

                                                              equals <+> ppTerm q 0 e] | (l,(mb_t,e)) <- xs]))