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

no need to keep the list of constructors per category in .gfo

Browse Source
This commit is contained in:
krasimir
2010-02-16 09:34:02 +00:00
parent 61287f3925
commit 19b17dceb6
11 changed files with 25 additions and 29 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -87,7 +87,7 @@ instance Binary Options where
Bad msg -> fail msg
instance Binary Info where
put (AbsCat x y) = putWord8 0 >> put (x,y)
put (AbsCat x) = putWord8 0 >> put x
put (AbsFun x y z) = putWord8 1 >> put (x,y,z)
put (ResParam x y) = putWord8 2 >> put (x,y)
put (ResValue x) = putWord8 3 >> put x
@@ -98,7 +98,7 @@ instance Binary Info where
put (AnyInd x y) = putWord8 8 >> put (x,y)
get = do tag <- getWord8
case tag of
0 -> get >>= \(x,y) -> return (AbsCat x y)
0 -> get >>= \x -> return (AbsCat x)
1 -> get >>= \(x,y,z) -> return (AbsFun x y z)
2 -> get >>= \(x,y) -> return (ResParam x y)
3 -> get >>= \x -> return (ResValue x)

4
src/compiler/GF/Grammar/CF.hs
View File

@@ -99,9 +99,9 @@ cf2grammar rules = (buildTree abs, buildTree conc, cat) where
cat = case rules of
(_,(c,_)):_ -> c -- the value category of the first rule
_ -> error "empty CF"
cats = [(cat, AbsCat (Just []) (Just [])) |
cats = [(cat, AbsCat (Just [])) |
cat <- nub (concat (map cf2cat rules))] ----notPredef cat
lincats = [(cat, CncCat (Just defLinType) Nothing Nothing) | (cat,AbsCat _ _) <- cats]
lincats = [(cat, CncCat (Just defLinType) Nothing Nothing) | (cat,AbsCat _) <- cats]
(funs,lins) = unzip (map cf2rule rules)
cf2cat :: CFRule -> [Ident]

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

@@ -75,7 +75,7 @@ mapSourceModule f (i,mi) = (i, f mi)
-- and indirection to module (/INDIR/)
data Info =
-- judgements in abstract syntax
AbsCat (Maybe Context) (Maybe [Term]) -- ^ (/ABS/) the second parameter is list of constructors - must be 'Id' or 'QId'
AbsCat (Maybe Context)
| AbsFun (Maybe Type) (Maybe Int) (Maybe [Equation]) -- ^ (/ABS/) type, arrity and definition of function
-- judgements in resource

6
src/compiler/GF/Grammar/Lookup.hs
View File

@@ -183,6 +183,6 @@ lookupCatContext gr m c = do
mo <- lookupModule gr m
info <- lookupIdentInfo mo c
case info of
AbsCat (Just co) _ -> return co
AnyInd _ n -> lookupCatContext gr n c
_ -> Bad (render (text "unknown category" <+> ppIdent c))
AbsCat (Just co) -> return co
AnyInd _ n -> lookupCatContext gr n c
_ -> Bad (render (text "unknown category" <+> ppIdent c))

2
src/compiler/GF/Grammar/Macros.hs
View File

@@ -615,7 +615,7 @@ allDependencies ism b =
CncCat pty _ _ -> [pty]
CncFun _ pt _ -> [pt] ---- (Maybe (Ident,(Context,Type))
AbsFun pty _ ptr -> [pty] --- ptr is def, which can be mutual
AbsCat (Just co) _ -> [Just ty | (_,_,ty) <- co]
AbsCat (Just co) -> [Just ty | (_,_,ty) <- co]
_ -> []
topoSortJments :: SourceModule -> Err [(Ident,Info)]

10
src/compiler/GF/Grammar/Parser.y
View File

@@ -232,7 +232,7 @@ TopDef
CatDef :: { [(Ident,SrcSpan,Info)] }
CatDef
: Posn Ident ListDDecl Posn { [($2, ($1,$4), AbsCat (Just $3) Nothing)] }
: Posn Ident ListDDecl Posn { [($2, ($1,$4), AbsCat (Just $3))] }
| Posn '[' Ident ListDDecl ']' Posn { listCatDef $3 ($1,$6) $4 0 }
| Posn '[' Ident ListDDecl ']' '{' Integer '}' Posn { listCatDef $3 ($1,$9) $4 (fromIntegral $7) }
@@ -247,9 +247,9 @@ DefDef
DataDef :: { [(Ident,SrcSpan,Info)] }
DataDef
: Posn Ident '=' ListDataConstr Posn { ($2, ($1,$5), AbsCat Nothing (Just (map Cn $4))) :
: Posn Ident '=' ListDataConstr Posn { ($2, ($1,$5), AbsCat Nothing) :
[(fun, ($1,$5), AbsFun Nothing Nothing Nothing) | fun <- $4] }
| Posn ListIdent ':' Exp Posn { -- (snd (valCat $4), ($1,$5), AbsCat Nothing (Just (map Cn $2))) :
| Posn ListIdent ':' Exp Posn { -- (snd (valCat $4), ($1,$5), AbsCat Nothing) :
[(fun, ($1,$5), AbsFun (Just $4) Nothing Nothing) | fun <- $2] }
ParamDef :: { [(Ident,SrcSpan,Info)] }
@@ -621,7 +621,7 @@ 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]))
catd = (listId, pos, AbsCat (Just cont'))
nilfund = (baseId, pos, AbsFun (Just niltyp) Nothing Nothing)
consfund = (consId, pos, AbsFun (Just constyp) Nothing Nothing)
@@ -679,7 +679,7 @@ type SrcSpan = (Posn,Posn)
checkInfoType MTAbstract (id,pos,info) =
case info of
AbsCat _ _ -> return ()
AbsCat _ -> return ()
AbsFun _ _ _ -> return ()
_ -> failLoc (fst pos) "illegal definition in abstract module"
checkInfoType MTResource (id,pos,info) =

11
src/compiler/GF/Grammar/Printer.hs
View File

@@ -25,7 +25,7 @@ import GF.Grammar.Values
import GF.Grammar.Grammar
import Text.PrettyPrint
import Data.Maybe (maybe)
import Data.Maybe (maybe, isNothing)
import Data.List (intersperse)
import qualified Data.Map as Map
@@ -71,17 +71,14 @@ ppOptions opts =
text "flags" $$
nest 2 (vcat [text option <+> equals <+> str value <+> semi | (option,value) <- optionsGFO opts])
ppJudgement q (id, AbsCat pcont pconstrs) =
ppJudgement q (id, AbsCat pcont ) =
text "cat" <+> ppIdent id <+>
(case pcont of
Just cont -> hsep (map (ppDecl q) cont)
Nothing -> empty) <+> semi $$
case pconstrs of
Just costrs -> text "data" <+> ppIdent id <+> equals <+> fsep (intersperse (char '|') (map (ppTerm q 0) costrs)) <+> semi
Nothing -> empty
Nothing -> empty) <+> semi
ppJudgement q (id, AbsFun ptype _ pexp) =
(case ptype of
Just typ -> text "fun" <+> ppIdent id <+> colon <+> ppTerm q 0 typ <+> semi
Just typ -> text (if isNothing pexp then "data" else "fun") <+> ppIdent id <+> colon <+> ppTerm q 0 typ <+> semi
Nothing -> empty) $$
(case pexp of
Just [] -> empty