sort records so that s field is first (use Macros.sortRec)

3 files changed, 22 insertions, 7 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 +++
diff --git a/src-3.0/GF/Compile/GrammarToGFCC.hs b/src-3.0/GF/Compile/GrammarToGFCC.hs
index 928180973..2aad8bb05 100644
--- a/src-3.0/GF/Compile/GrammarToGFCC.hs
+++ b/src-3.0/GF/Compile/GrammarToGFCC.hs
@@ -399,7 +399,7 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
   App _ _ -> mkValCase (unrec tr)
   QC  _ _ -> mkValCase tr 
   R rs    -> R [(mkLab i, (Nothing, t2t t)) | 
-                 (i,(l,(_,t))) <- zip [0..] (sort (unlock rs))]
+                 (i,(l,(_,t))) <- zip [0..] (GM.sortRec (unlock rs))]
   P  t l   -> r2r tr
   PI t l i -> EInt $ toInteger i
 
@@ -529,7 +529,7 @@ notlock (l, t) = case t of --- need not look at l
      _ -> True
 
 unlockTy ty = case ty of
-  RecType ls -> RecType $ sort [(l, unlockTy t) | (l,t) <- ls, notlock (l,t)]
+  RecType ls -> RecType $ GM.sortRec [(l, unlockTy t) | (l,t) <- ls, notlock (l,t)]
   _ -> GM.composSafeOp unlockTy ty
 
 
diff --git a/src-3.0/GF/Grammar/Macros.hs b/src-3.0/GF/Grammar/Macros.hs
index f6543ea6c..be03c02a7 100644
--- a/src-3.0/GF/Grammar/Macros.hs
+++ b/src-3.0/GF/Grammar/Macros.hs
@@ -28,6 +28,7 @@ import GF.Grammar.PrGrammar
 
 import Control.Monad (liftM, liftM2)
 import Data.Char (isDigit)
+import Data.List (sortBy)
 
 firstTypeForm :: Type -> Err (Context, Type)
 firstTypeForm t = case t of
@@ -719,3 +720,14 @@ isInOneType t = case t of
   Prod _ a b -> a == b
   _ -> False
 
+-- normalize records and record types; put s first
+
+sortRec :: [(Label,a)] -> [(Label,a)]
+sortRec = sortBy ordLabel where
+  ordLabel (r1,_) (r2,_) = case (prt r1, prt r2) of
+    ("s",_) -> LT
+    (_,"s") -> GT
+    (s1,s2) -> compare s1 s2
+
+
+