summaryrefslogtreecommitdiff
path: root/src-3.0/GF/Compile/CheckGrammar.hs
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2008-05-24 07:44:16 +0000
committeraarne <aarne@cs.chalmers.se>2008-05-24 07:44:16 +0000
commit77178cd2abf6774397259af547aec75ac07be26d (patch)
treea39604a037485d64577d38bf4f12f4b786f5a57a /src-3.0/GF/Compile/CheckGrammar.hs
parent1eb1d7e055ce91e4e972079c906deb24ebbf2fbd (diff)
sort records so that s field is first (use Macros.sortRec)
Diffstat (limited to 'src-3.0/GF/Compile/CheckGrammar.hs')
-rw-r--r--src-3.0/GF/Compile/CheckGrammar.hs13
1 files changed, 8 insertions, 5 deletions
diff --git a/src-3.0/GF/Compile/CheckGrammar.hs b/src-3.0/GF/Compile/CheckGrammar.hs
index 5e581cce2..9982aaf24 100644
--- a/src-3.0/GF/Compile/CheckGrammar.hs
+++ b/src-3.0/GF/Compile/CheckGrammar.hs
@@ -370,7 +370,7 @@ computeLType gr t = do
_ -> return $ ExtR r' s'
RecType fs -> do
- let fs' = sortBy (\x y -> compare (fst x) (fst y)) fs
+ let fs' = sortRec fs
liftM RecType $ mapPairsM comp fs'
_ | ty == typeTok -> return typeStr
@@ -395,7 +395,7 @@ labelIndex ty lab = case ty of
RecType ts -> maybe (error ("label index" +++ prt lab)) id $ lookup lab $ labs ts
_ -> error $ "label index" +++ prt ty
where
- labs ts = zip (map fst (sortBy (\ x y -> compare (fst x) (fst y)) ts)) [0..]
+ labs ts = zip (map fst (sortRec ts)) [0..]
-- the underlying algorithms
@@ -667,9 +667,12 @@ getOverload env@gr mt t = case appForm t of
vfs' -> case [(v,f) | (v,f) <- vfs', noProd v] of
[(val,fun)] -> do
- checkWarn $ "WARNING: overloading of" +++ prt f +++
- "resolved by excluding partial applications:" ++++
- unlines [prtType env ty | (ty,_) <- vfs', not (noProd ty)]
+
+----- unsafely exclude irritating warning AR 24/5/2008
+----- checkWarn $ "WARNING: overloading of" +++ prt f +++
+----- "resolved by excluding partial applications:" ++++
+----- unlines [prtType env ty | (ty,_) <- vfs', not (noProd ty)]
+
return (mkApp fun tts, val)
_ -> raise $ "ambiguous overloading of" +++ prt f +++