diff options
| author | aarne <aarne@cs.chalmers.se> | 2007-12-04 15:23:49 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2007-12-04 15:23:49 +0000 |
| commit | 61763b57848eaeb5e08ca0429dc5c0926606ad6c (patch) | |
| tree | 3473be6bc1820d7339d5abec77f96c1d5d53697a /src/GF | |
| parent | 4279b1776270d813a68bb762d16bad6e8bc4e324 (diff) | |
unifying judgement information - now easy
Diffstat (limited to 'src/GF')
| -rw-r--r-- | src/GF/Devel/Grammar/MkJudgements.hs | 5 | ||||
| -rw-r--r-- | src/GF/Devel/Grammar/SourceToGF.hs | 7 |
2 files changed, 10 insertions, 2 deletions
diff --git a/src/GF/Devel/Grammar/MkJudgements.hs b/src/GF/Devel/Grammar/MkJudgements.hs index 833d2f695..011b83e62 100644 --- a/src/GF/Devel/Grammar/MkJudgements.hs +++ b/src/GF/Devel/Grammar/MkJudgements.hs @@ -64,6 +64,11 @@ paramConstructors p cs = -- 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 old new = do testErr (jform old == jform new) "different judment forms" diff --git a/src/GF/Devel/Grammar/SourceToGF.hs b/src/GF/Devel/Grammar/SourceToGF.hs index 0ad966648..d2690b4a7 100644 --- a/src/GF/Devel/Grammar/SourceToGF.hs +++ b/src/GF/Devel/Grammar/SourceToGF.hs @@ -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" |