Translating linearization functions to Haskell: move a common record type to PGF.Haskell

Move the Haskell representation of the common linearization type {s:T} to the
shared module PGF.Haskell, so that the same overloaded projection function
proj_s can be used for all concrete syntaxes.

1 files changed, 8 insertions, 3 deletions

diff --git a/src/compiler/GF/Compile/ConcreteToHaskell.hs b/src/compiler/GF/Compile/ConcreteToHaskell.hs
index 93becd16e..daeb4dfb6 100644
--- a/src/compiler/GF/Compile/ConcreteToHaskell.hs
+++ b/src/compiler/GF/Compile/ConcreteToHaskell.hs
@@ -38,11 +38,16 @@ concrete2haskell opts gr cenv absname cnc modinfo =
       "--- Linearization types and linearization functions ---" $$
       vcat (map ppDef defs) $$ "" $$
       "--- Type classes for projection functions ---" $$
-      vcat (map labelClass (S.toList (S.unions (map S.fromList rs)))) $$ "" $$
+      vcat (map labelClass (S.toList labels)) $$ "" $$
       "--- Record types ---" $$
-      vcat (map recordType rs)
+      vcat (map recordType recs)
   where
-    rs = S.toList (S.insert [ident2label (identS "s")] (records rhss))
+    labels = S.difference (S.unions (map S.fromList recs)) common_labels
+    recs = S.toList (S.difference (records rhss) common_records)
+    common_records = S.fromList [[label_s]]
+    common_labels = S.fromList [label_s]
+    label_s = ident2label (identS "s")
+
     rhss = map (snd.snd) defs
     defs = sortBy (compare `on` fst) .
            concatMap (toHaskell gId gr absname cenv) .