From 7db4b641ce6abe90dd404459cd5eccb6e67f618c Mon Sep 17 00:00:00 2001 From: krasimir Date: Wed, 20 May 2009 21:03:56 +0000 Subject: refactor the PGF.Expr type and the evaluation of abstract expressions --- src/GF/Grammar/Binary.hs | 4 ---- src/GF/Grammar/Grammar.hs | 5 +---- src/GF/Grammar/Lookup.hs | 2 +- src/GF/Grammar/Macros.hs | 4 ---- src/GF/Grammar/Parser.y | 33 ++++++++++----------------------- src/GF/Grammar/Printer.hs | 10 ++-------- 6 files changed, 14 insertions(+), 44 deletions(-) (limited to 'src/GF/Grammar') 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])) -- cgit v1.2.3