Decompose optimization passes (still work in progress)

minoki · Jul 6, 2024 · 4d9d7d5 · 4d9d7d5
1 parent 44b9e77
commit 4d9d7d5
Show file tree

Hide file tree

Showing 10 changed files with 400 additions and 170 deletions.
diff --git a/Makefile b/Makefile
@@ -52,6 +52,7 @@ sources = \
   src/cps/dead-code.sml \
   src/cps/uncurry.sml \
   src/cps/loop.sml \
+  src/cps/ref-cell.sml \
   src/cps/inline.sml \
   src/cps/decompose-recursive.sml \
   src/cps/unpack-record-parameter.sml \

diff --git a/src/cps.sml b/src/cps.sml
@@ -946,7 +946,6 @@ structure CpsSimplify :> sig
           end = struct
 local structure F = FSyntax
       structure C = CSyntax
-      structure P = Primitives
       datatype frequency = datatype CpsUsageAnalysis.frequency
 in
 type Context = { nextVId : int ref
@@ -1144,9 +1143,6 @@ and alphaConvert (ctx : Context, subst : C.Value TypedSyntax.VIdMap.map, csubst
                   }
       end
   | alphaConvert (_, _, _, e as C.Unreachable) = e
-datatype simplify_result = VALUE of C.Value
-                         | SIMPLE_EXP of C.SimpleExp
-                         | NOT_SIMPLIFIED
 type value_info = { exp : C.SimpleExp option, isDiscardableFunction : bool }
 fun isDiscardableDec (dec, env : value_info TypedSyntax.VIdMap.map)
     = case dec of

diff --git a/src/cps/dead-code.sml b/src/cps/dead-code.sml
diff --git a/src/cps/decompose-recursive.sml b/src/cps/decompose-recursive.sml
@@ -9,7 +9,7 @@ local structure C = CSyntax
 in
 fun goDec ctx (dec, acc)
     = case dec of
-          C.ValDec { exp = C.Abs { contParam, params, body, attr }, results as [SOME name] } =>
+          C.ValDec { exp = C.Abs { contParam, params, body, attr }, results as [SOME _] } =>
           C.ValDec { exp = C.Abs { contParam = contParam, params = params, body = goCExp (ctx, body), attr = attr }, results = results } :: acc
         | C.ValDec { exp = _, results = _ } => dec :: acc
         | C.RecDec defs =>

diff --git a/src/cps/loop.sml b/src/cps/loop.sml
@@ -44,17 +44,17 @@ local
                            else
                                TypedSyntax.VIdTable.insert env (v, ref neverUsed)
     in
-    fun goSimpleExp (env, _, _, C.PrimOp { primOp = _, tyargs = _, args }) = ()
-      | goSimpleExp (env, _, _, C.Record fields) = ()
-      | goSimpleExp (_, _, _, C.ExnTag { name = _, payloadTy = _ }) = ()
-      | goSimpleExp (env, _, results, C.Projection { label, record, fieldTypes = _ }) = ()
-      | goSimpleExp (env, renv, _, C.Abs { contParam, params, body, attr = _ })
+    fun goSimpleExp (_, _, C.PrimOp _) = ()
+      | goSimpleExp (_, _, C.Record _) = ()
+      | goSimpleExp (_, _, C.ExnTag _) = ()
+      | goSimpleExp (_, _, C.Projection _) = ()
+      | goSimpleExp (env, renv, C.Abs { contParam = _, params, body, attr = _ })
         = ( List.app (fn p => add (env, p)) params
           ; goCExp (env, renv, body)
           )
     and goDec (env, renv)
         = fn C.ValDec { exp, results } =>
-             ( goSimpleExp (env, renv, results, exp)
+             ( goSimpleExp (env, renv, exp)
              ; List.app (fn SOME result => add (env, result)
                         | NONE => ()
                         ) results
@@ -70,7 +70,7 @@ local
          ; TypedSyntax.VIdMap.appi (fn (f, v) => TypedSyntax.VIdTable.insert renv (f, v)) recursiveEnv
          ; List.app (fn { name, ... } => TypedSyntax.VIdTable.insert env (name, ref neverUsed)) defs
         end
-      | C.ContDec { name, params, body } =>
+      | C.ContDec { name = _, params, body } =>
         ( List.app (Option.app (fn p => add (env, p))) params
         ; goCExp (env, renv, body)
         )
@@ -86,15 +86,15 @@ local
               ( List.app (goDec (env, renv)) decs
               ; goCExp (env, renv, cont)
               )
-            | C.App { applied, cont, args, attr = _ } =>
+            | C.App { applied, cont, args = _, attr = _ } =>
               ( useValueAsCallee (env, cont, applied)
               )
-            | C.AppCont { applied, args } => ()
-            | C.If { cond, thenCont, elseCont } =>
+            | C.AppCont { applied = _, args = _ } => ()
+            | C.If { cond = _, thenCont, elseCont } =>
               ( goCExp (env, renv, thenCont)
               ; goCExp (env, renv, elseCont)
               )
-            | C.Handle { body, handler = (e, h), successfulExitIn, successfulExitOut } =>
+            | C.Handle { body, handler = (e, h), successfulExitIn = _, successfulExitOut = _ } =>
               ( goCExp (env, renv, body)
               ; add (env, e)
               ; goCExp (env, renv, h)
@@ -117,7 +117,7 @@ in
 type Context = { base : CpsSimplify.Context
                , rec_usage : CpsUsageAnalysis.usage_table
                }
-fun simplifyDec (ctx : Context, appliedCont : C.CVar option) (dec, acc : C.Dec list)
+fun simplifyDec (ctx : Context) (dec, acc : C.Dec list)
     = case dec of
           C.ValDec { exp, results } =>
           (case (exp, results) of
@@ -172,10 +172,7 @@ fun simplifyDec (ctx : Context, appliedCont : C.CVar option) (dec, acc : C.Dec l
 and simplifyCExp (ctx : Context, e)
     = case e of
           C.Let { decs, cont } =>
-          let val appliedCont = case cont of
-                                    C.AppCont { applied, args = _ } => SOME applied
-                                  | _ => NONE
-              val revDecs = List.foldl (simplifyDec (ctx, appliedCont)) [] decs
+          let val revDecs = List.foldl (simplifyDec ctx) [] decs
           in CpsTransform.prependRevDecs (revDecs, simplifyCExp (ctx, cont))
           end
         | C.App _ => e