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

unifying judgement information - now easy

Browse Source
This commit is contained in:
aarne
2007-12-04 15:23:49 +00:00
parent 4279b17762
commit 61763b5784
2 changed files with 10 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -64,6 +64,11 @@ paramConstructors p cs =
-- unifying contents of judgements -- unifying contents of judgements
---- used in SourceToGF; make error-free and informative
unifyJudgements (Left j) (Left k) = Left $ case unifyJudgement j k of
Ok l -> l
Bad s -> error s
unifyJudgement :: Judgement -> Judgement -> Err Judgement unifyJudgement :: Judgement -> Judgement -> Err Judgement
unifyJudgement old new = do unifyJudgement old new = do
testErr (jform old == jform new) "different judment forms" testErr (jform old == jform new) "different judment forms"

7
src/GF/Devel/Grammar/SourceToGF.hs
View File

@@ -79,6 +79,7 @@ transModDef x = case x of
MAbstract id -> do MAbstract id -> do
id' <- transIdent id id' <- transIdent id
return (transAbsDef, MTAbstract, id') return (transAbsDef, MTAbstract, id')
MGrammar id -> mkModRes id MTGrammar body
MResource id -> mkModRes id MTGrammar body MResource id -> mkModRes id MTGrammar body
MConcrete id open -> do MConcrete id open -> do
id' <- transIdent id id' <- transIdent id
@@ -98,7 +99,8 @@ transModDef x = case x of
extends' <- transExtend extends extends' <- transExtend extends
opens' <- transOpens opens opens' <- transOpens opens
defs0 <- mapM trDef $ getTopDefs defs defs0 <- mapM trDef $ getTopDefs defs
let defs' = Map.fromList [(i,Left d) | Left ds <- defs0, (i,d) <- ds] let defs' = Map.fromListWith unifyJudgements
[(i,Left d) | Left ds <- defs0, (i,d) <- ds]
let flags' = Map.fromList [f | Right fs <- defs0, f <- fs] let flags' = Map.fromList [f | Right fs <- defs0, f <- fs]
return (id', Module mtyp' [] [] extends' opens' flags' defs') return (id', Module mtyp' [] [] extends' opens' flags' defs')
@@ -111,7 +113,8 @@ transModDef x = case x of
insts' <- mapM transOpen insts insts' <- mapM transOpen insts
opens' <- transOpens opens opens' <- transOpens opens
defs0 <- mapM trDef $ getTopDefs defs defs0 <- mapM trDef $ getTopDefs defs
let defs' = Map.fromList [(i,Left d) | Left ds <- defs0, (i,d) <- ds] let defs' = Map.fromListWith unifyJudgements
[(i,Left d) | Left ds <- defs0, (i,d) <- ds]
let flags' = Map.fromList [f | Right fs <- defs0, f <- fs] let flags' = Map.fromList [f | Right fs <- defs0, f <- fs]
return (id', Module mtyp' [] [(m',insts')] extends' opens' flags' defs') return (id', Module mtyp' [] [(m',insts')] extends' opens' flags' defs')
_ -> fail "deprecated module form" _ -> fail "deprecated module form"