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

refactor GF.Infra.Modules for better error messages

Browse Source
This commit is contained in:
krasimir
2010-01-31 15:54:25 +00:00
parent c93e406997
commit 4485e97181
10 changed files with 159 additions and 162 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -26,16 +26,16 @@ instance Binary Ident where
then return identW
else return (identC bs)
instance (Ord i, Binary i, Binary a) => Binary (MGrammar i a) where
instance Binary a => Binary (MGrammar a) where
put (MGrammar ms) = put ms
get = fmap MGrammar get
instance (Ord i, Binary i, Binary a) => Binary (ModInfo i a) where
instance Binary a => Binary (ModInfo a) where
put mi = do put (mtype mi,mstatus mi,flags mi,extend mi,mwith mi,opens mi,mexdeps mi,jments mi,positions mi)
get = do (mtype,mstatus,flags,extend,mwith,opens,med,jments,positions) <- get
return (ModInfo mtype mstatus flags extend mwith opens med jments positions)
instance (Binary i) => Binary (ModuleType i) where
instance Binary ModuleType where
put MTAbstract = putWord8 0
put MTResource = putWord8 2
put (MTConcrete i) = putWord8 3 >> put i
@@ -50,7 +50,7 @@ instance (Binary i) => Binary (ModuleType i) where
5 -> get >>= return . MTInstance
_ -> decodingError
instance (Binary i) => Binary (MInclude i) where
instance Binary MInclude where
put MIAll = putWord8 0
put (MIOnly xs) = putWord8 1 >> put xs
put (MIExcept xs) = putWord8 2 >> put xs
@@ -61,7 +61,7 @@ instance (Binary i) => Binary (MInclude i) where
2 -> fmap MIExcept get
_ -> decodingError
instance Binary i => Binary (OpenSpec i) where
instance Binary OpenSpec where
put (OSimple i) = putWord8 0 >> put i
put (OQualif i j) = putWord8 1 >> put (i,j)
get = do tag <- getWord8

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

@@ -53,11 +53,11 @@ import GF.Data.Operations
import qualified Data.ByteString.Char8 as BS
-- | grammar as presented to the compiler
type SourceGrammar = MGrammar Ident Info
type SourceGrammar = MGrammar Info
emptySourceGrammar = MGrammar []
type SourceModInfo = ModInfo Ident Info
type SourceModInfo = ModInfo Info
type SourceModule = (Ident, SourceModInfo)

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

@@ -55,7 +55,7 @@ lookupIdent c t =
Ok v -> return v
Bad _ -> Bad ("unknown identifier" +++ showIdent c)
lookupIdentInfo :: ModInfo Ident a -> Ident -> Err a
lookupIdentInfo :: ModInfo a -> Ident -> Err a
lookupIdentInfo mo i = lookupIdent i (jments mo)
lookupResDef :: SourceGrammar -> Ident -> Ident -> Err Term

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

@@ -135,7 +135,7 @@ ComplMod
: {- empty -} { MSComplete }
| 'incomplete' { MSIncomplete }
ModType :: { (ModuleType Ident,Ident) }
ModType :: { (ModuleType,Ident) }
ModType
: 'abstract' Ident { (MTAbstract, $2) }
| 'resource' Ident { (MTResource, $2) }
@@ -143,9 +143,9 @@ ModType
| 'concrete' Ident 'of' Ident { (MTConcrete $4, $2) }
| 'instance' Ident 'of' Ident { (MTInstance $4, $2) }
ModHeaderBody :: { ( [(Ident,MInclude Ident)]
, Maybe (Ident,MInclude Ident,[(Ident,Ident)])
, [OpenSpec Ident]
ModHeaderBody :: { ( [(Ident,MInclude)]
, Maybe (Ident,MInclude,[(Ident,Ident)])
, [OpenSpec]
) }
ModHeaderBody
: ListIncluded '**' Included 'with' ListInst '**' ModOpen { ($1, Just (fst $3,snd $3,$5), $7) }
@@ -156,14 +156,14 @@ ModHeaderBody
| Included 'with' ListInst { ([], Just (fst $1,snd $1,$3), []) }
| ModOpen { ([], Nothing, $1) }
ModOpen :: { [OpenSpec Ident] }
ModOpen :: { [OpenSpec] }
ModOpen
: { [] }
| 'open' ListOpen { $2 }
ModBody :: { ( [(Ident,MInclude Ident)]
, Maybe (Ident,MInclude Ident,[(Ident,Ident)])
, Maybe ([OpenSpec Ident],[(Ident,SrcSpan,Info)],Options)
ModBody :: { ( [(Ident,MInclude)]
, Maybe (Ident,MInclude,[(Ident,Ident)])
, Maybe ([OpenSpec],[(Ident,SrcSpan,Info)],Options)
) }
ModBody
: ListIncluded '**' Included 'with' ListInst '**' ModContent { ($1, Just (fst $3,snd $3,$5), Just $7) }
@@ -175,7 +175,7 @@ ModBody
| ModContent { ([], Nothing, Just $1) }
| ModBody ';' { $1 }
ModContent :: { ([OpenSpec Ident],[(Ident,SrcSpan,Info)],Options) }
ModContent :: { ([OpenSpec],[(Ident,SrcSpan,Info)],Options) }
ModContent
: '{' ListTopDef '}' { ([],[d | Left ds <- $2, d <- ds],concatOptions [o | Right o <- $2]) }
| 'open' ListOpen 'in' '{' ListTopDef '}' { ($2,[d | Left ds <- $5, d <- ds],concatOptions [o | Right o <- $5]) }
@@ -185,12 +185,12 @@ ListTopDef
: {- empty -} { [] }
| TopDef ListTopDef { $1 : $2 }
ListOpen :: { [OpenSpec Ident] }
ListOpen :: { [OpenSpec] }
ListOpen
: Open { [$1] }
| Open ',' ListOpen { $1 : $3 }
Open :: { OpenSpec Ident }
Open :: { OpenSpec }
Open
: Ident { OSimple $1 }
| '(' Ident '=' Ident ')' { OQualif $2 $4 }
@@ -204,12 +204,12 @@ Inst :: { (Ident,Ident) }
Inst
: '(' Ident '=' Ident ')' { ($2,$4) }
ListIncluded :: { [(Ident,MInclude Ident)] }
ListIncluded :: { [(Ident,MInclude)] }
ListIncluded
: Included { [$1] }
| Included ',' ListIncluded { $1 : $3 }
Included :: { (Ident,MInclude Ident) }
Included :: { (Ident,MInclude) }
Included
: Ident { ($1,MIAll ) }
| Ident '[' ListIdent ']' { ($1,MIOnly $3) }

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

@@ -9,7 +9,6 @@
module GF.Grammar.Printer
( TermPrintQual(..)
, ppIdent
, ppLabel
, ppModule
, ppJudgement
@@ -256,8 +255,6 @@ ppDDecl q (_,id,typ)
| id == identW = ppTerm q 6 typ
| otherwise = parens (ppIdent id <+> colon <+> ppTerm q 0 typ)
ppIdent = text . showIdent
ppQIdent q m id =
case q of
Qualified -> ppIdent m <> char '.' <> ppIdent id