From 109822675bc5fc61efdf2d3d157b4395409bb33c Mon Sep 17 00:00:00 2001
From: "John J. Camilleri" <john@digitalgrammars.com>
Date: Mon, 15 Feb 2021 00:43:53 +0100
Subject: [PATCH] Pass test with FoodsFin, by forcibly resorting record fields
 to make s first

---
 src/compiler/GF/Compile/GrammarToLPGF.hs | 40 ++++++++++++++++++++++--
 1 file changed, 37 insertions(+), 3 deletions(-)

diff --git a/src/compiler/GF/Compile/GrammarToLPGF.hs b/src/compiler/GF/Compile/GrammarToLPGF.hs
index ed89c7790..81290d4f3 100644
--- a/src/compiler/GF/Compile/GrammarToLPGF.hs
+++ b/src/compiler/GF/Compile/GrammarToLPGF.hs
@@ -15,7 +15,7 @@ import GF.Text.Pretty (pp, render)
 import qualified Control.Monad.State as CMS
 import Control.Monad (unless, forM_)
 import Data.Either (lefts, rights)
-import Data.List (elemIndex, find, groupBy)
+import Data.List (elemIndex, find, groupBy, sortBy)
 import qualified Data.Map as Map
 import Data.Maybe (catMaybes)
 import Text.Printf (printf)
@@ -90,10 +90,17 @@ mkCanon2lpgf opts gr am = do
                   term = foldl L.LFProjection tuple (L.LFInt (pidIx+1):pids')
                 return term
 
-              C.PredefValue (C.PredefId "BIND") -> return L.LFBind
+              C.PredefValue (C.PredefId pid) -> case pid of
+                "BIND" -> return L.LFBind
+                -- "SOFT_BIND" ->
+                -- "SOFT_SPACE" ->
+                -- "CAPIT" ->
+                -- "ALL_CAPIT" ->
+                _ -> Left $ printf "Unknown predef function: %s" pid
 
               C.RecordValue rrvs -> do
-                ts <- sequence [ val2lin lv | C.RecordRow lid lv <- rrvs ]
+                let rrvs' = sortRecordRows rrvs
+                ts <- sequence [ val2lin lv | C.RecordRow lid lv <- rrvs' ]
                 return $ L.LFTuple ts
 
               C.TableValue lt trvs | isRecordType lt -> go trvs
@@ -203,6 +210,22 @@ mkParamTuples defs = map (\def -> CMS.evalState (mk' def) 1) defs
           ]
       return $ L.LFTuple ns
 
+-- | Always put 's' reocord field first, then sort alphabetically
+-- This seems to be done inconsistently in the canonical format
+-- Based on GF.Granmar.Macros.sortRec
+sortRecord :: C.LinValue -> C.LinValue
+sortRecord (C.RecordValue rrvs) = C.RecordValue (sortRecordRows rrvs)
+sortRecord lv = lv
+
+sortRecordRows :: [C.RecordRowValue] -> [C.RecordRowValue]
+sortRecordRows = sortBy ordLabel
+  where
+    ordLabel (C.RecordRow (C.LabelId l1) _) (C.RecordRow (C.LabelId l2) _) =
+      case (l1,l2) of
+        ("s",_) -> LT
+        (_,"s") -> GT
+        (s1,s2) -> compare s1 s2
+
 isParamType :: C.LinType -> Bool
 isParamType (C.ParamType _) = True
 isParamType _ = False
@@ -249,9 +272,20 @@ ppCanonical = putStrLn . render . pp
 dumpCanonical :: C.Grammar -> IO ()
 dumpCanonical (C.Grammar ab cncs) = do
   putStrLn ""
+
+  let (C.Abstract modId flags cats funs) = ab
+  print modId
+  mapM_ print cats
+  putStrLn ""
+  mapM_ print funs
+  putStrLn ""
+
   forM_ cncs $ \(C.Concrete modId absModId flags params lincats lindefs) -> do
+    print modId
     mapM_ print params
     putStrLn ""
+    mapM_ print lincats
+    putStrLn ""
     mapM_ print lindefs
     putStrLn ""