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

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

@@ -79,6 +79,7 @@ transModDef x = case x of
MAbstract id -> do
id' <- transIdent id
return (transAbsDef, MTAbstract, id')
MGrammar id -> mkModRes id MTGrammar body
MResource id -> mkModRes id MTGrammar body
MConcrete id open -> do
id' <- transIdent id
@@ -98,7 +99,8 @@ transModDef x = case x of
extends' <- transExtend extends
opens' <- transOpens opens
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]
return (id', Module mtyp' [] [] extends' opens' flags' defs')
@@ -111,7 +113,8 @@ transModDef x = case x of
insts' <- mapM transOpen insts
opens' <- transOpens opens
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]
return (id', Module mtyp' [] [(m',insts')] extends' opens' flags' defs')
_ -> fail "deprecated module form"