msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

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

Browse Source
This commit is contained in:
krasimir
2009-05-20 21:03:56 +00:00
parent f9574dcf77
commit e5399f2d0e
32 changed files with 245 additions and 360 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/GF/Grammar/Binary.hs
View File

@@ -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)

5
src/GF/Grammar/Grammar.hs
View File

@@ -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/

2
src/GF/Grammar/Lookup.hs
View File

@@ -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

4
src/GF/Grammar/Macros.hs
View File

@@ -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

33
src/GF/Grammar/Parser.y
View File

@@ -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'

10
src/GF/Grammar/Printer.hs
View File

@@ -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]))