String literal deduplication

1 files changed, 39 insertions, 37 deletions

diff --git a/emit.fun b/emit.fun
index ea4c455..ccdb6ce 100644
--- a/emit.fun
+++ b/emit.fun
@@ -149,31 +149,57 @@ functor Emit(I: IL) = struct
 
   fun handleStrlits strlits =
   let
+    fun unique l =
+    let
+      val l = sort (op <=) l
+      fun u [] acc = rev acc
+        | u (x :: xs) [] = u xs [x]
+        | u (x :: xs) (y :: ys) =
+          if x = y then
+            u xs (y :: ys)
+          else
+            u xs (x :: y :: ys)
+    in
+      u l []
+    end
+
     fun emitStrlit id =
     let
-      val () = fprint `".S" I id `":\t" %
       val symbols = PP.T.strlit2charList (PP.?? id)
 
-      fun pc c out =
-        if Char.isPrint c andalso not (Char.isSpace c) then
-          Printf out `"'" C c `"'" %
+      datatype strPart = SpStr of string | SpOrd of int
+
+      open Char
+
+      fun collectStr (c :: cs) acc =
+        if isPrint c andalso (c = #" " orelse not (isSpace c)) then
+          collectStr cs (c :: acc)
         else
-          Printf out I (ord c) %
+          let
+            val p = SpOrd (ord c)
+            val l = collectStr cs []
+          in
+            if null acc then l else SpStr (implode $ rev acc) :: p :: l
+          end
+        | collectStr [] acc =
+            if null acc then [] else [SpStr (implode $ rev acc)]
 
-      fun outputStrlit (c :: []) = fprint A1 pc c %
-        | outputStrlit [] = raise Unreachable
-        | outputStrlit (c :: cs) = (
-          fprint A1 pc c `", " %;
-          outputStrlit cs
-        )
+     fun printPart (SpStr s) out = Printf out `"'" `s `"'" %
+       | printPart (SpOrd v) out = Printf out I v %
 
+     fun printStr [] = ()
+       | printStr (p :: ps) = (fprint A1 printPart p `", " %; printStr ps)
+
+      val parts = collectStr symbols []
     in
+      fprint `".S" I id `":\t" %;
       fprint `"db " %;
-      outputStrlit symbols
+      List.app (fn p => fprint A1 printPart p `", " %) parts;
+      fprint `"0\n" %
     end
   in
     fprint `"\n" %;
-    List.app emitStrlit strlits
+    List.app emitStrlit (unique strlits)
   end
 
   fun handleLocalIniLayouts () =
@@ -490,30 +516,6 @@ functor Emit(I: IL) = struct
     Array.appi p rinfo
   end
 
-  fun sort _ [] = []
-    | sort _ [x] = [x]
-    | sort le l =
-    let
-      fun divide [] accp = accp
-        | divide [x] (acc1, acc2) = (x :: acc1, acc2)
-        | divide (x :: y :: tail) (acc1, acc2) =
-          divide tail (x :: acc1, y :: acc2)
-      val (part1, part2) = divide l ([], [])
-      val part1 = sort le part1
-      val part2 = sort le part2
-
-      fun merge [] [] acc = acc
-        | merge [] ys acc = rev $ List.revAppend (ys, acc)
-        | merge xs [] acc = rev $ List.revAppend (xs, acc)
-        | merge (x :: xs) (y :: ys) acc =
-            if le (x, y) then
-              merge xs (y :: ys) (x :: acc)
-            else
-              merge (x :: xs) ys (y :: acc)
-    in
-      merge part1 part2 []
-    end
-
   fun updateI i = fn z =>
   let
     fun from rinfo active pool intervals stackOff  =