simplifications

.github/workflows/main.yml

@@ -72,7 +72,7 @@ jobs:
           brew tap homebrew/cask
           mkdir phantomjs
           cd phantomjs
-          wget https://bitbucket.org/ariya/phantomjs/downloads/phantomjs-2.1.1-macosx.zip
+          wget -q https://bitbucket.org/ariya/phantomjs/downloads/phantomjs-2.1.1-macosx.zip
           unzip phantomjs-2.1.1-macosx.zip
           cp -p phantomjs-2.1.1-macosx/bin/phantomjs /usr/local/bin/
           cd ..
@@ -89,10 +89,10 @@ jobs:
         working-directory: ${{ env.RUNHOME }}
         run: |
           echo "[OS: $OS, HOME: $RUNHOME, THECC: ${{env.THECC}}]"
-          wget https://github.com/diku-dk/smlpkg/releases/download/v0.1.4/smlpkg-bin-dist-${{env.OS}}.tgz
+          wget -q https://github.com/diku-dk/smlpkg/releases/download/v0.1.4/smlpkg-bin-dist-${{env.OS}}.tgz
           tar xzf smlpkg-bin-dist-${{env.OS}}.tgz
           echo "$HOME/smlpkg-bin-dist-${{env.OS}}/bin" >> $GITHUB_PATH
-          wget https://github.com/melsman/mlkit/releases/download/v4.7.13/mlkit-bin-dist-${{env.OS}}.tgz
+          wget -q https://github.com/melsman/mlkit/releases/download/v4.7.13/mlkit-bin-dist-${{env.OS}}.tgz
           tar xzf mlkit-bin-dist-${{env.OS}}.tgz
           echo "$HOME/mlkit-bin-dist-${{env.OS}}/bin" >> $GITHUB_PATH
           mkdir -p .mlkit

src/Compiler/Backend/BACKEND_INFO.sml

@@ -78,6 +78,4 @@ signature BACKEND_INFO =
     val minCodeInBinSearch : int
     val maxDiff            : int
     val minJumpTabSize     : int
-
-    val down_growing_stack : bool         (* true for x86/x64 code generation *)
   end

src/Compiler/Backend/BackendInfo.sml

@@ -1,4 +1,4 @@
-functor BackendInfo(val down_growing_stack : bool) : BACKEND_INFO =
+structure BackendInfo : BACKEND_INFO =
   struct
     structure PP = PrettyPrint
     structure Labels = AddressLabels
@@ -134,5 +134,4 @@ functor BackendInfo(val down_growing_stack : bool) : BACKEND_INFO =
     val maxDiff = 10
     val minJumpTabSize = 5
 
-    val down_growing_stack = down_growing_stack
   end

src/Compiler/Backend/CalcOffset.sml

@@ -1,21 +1,20 @@
-functor CalcOffset(structure CallConv: CALL_CONV
-		       where type lvar = Lvars.lvar
-		   structure LineStmt: LINE_STMT
+functor CalcOffset(structure LineStmt: LINE_STMT
 		       where type con = Con.con
 		       where type excon = Excon.excon
 		       where type lvar = Lvars.lvar
 		       where type place = Effect.effect
 		       where type label = AddressLabels.label
 		       where type phsize = PhysSizeInf.phsize
 		       where type StringTree = PrettyPrint.StringTree
-		   sharing type CallConv.cc = LineStmt.cc
+		       where type cc = CallConv.cc
 		   structure FetchAndFlush: FETCH_AND_FLUSH
 		       where type lvar = Lvars.lvar
  		       where type label = AddressLabels.label
-                   sharing type FetchAndFlush.Atom = LineStmt.Atom
-		   structure BI : BACKEND_INFO)
+                   sharing type FetchAndFlush.Atom = LineStmt.Atom)
     : CALC_OFFSET =
 struct
+
+  structure BI = BackendInfo
   structure PP = PrettyPrint
   structure Labels = AddressLabels
   val _ = Flags.add_bool_entry

src/Compiler/Backend/CallConv.sml

@@ -7,8 +7,10 @@
 (* (e.g., resolve_cc, resolve_ccall, handl_arg_phreg,                   *)
 (*        handl_return_phreg, resolve_act_cc)                           *)
 
-functor CallConv(BI : BACKEND_INFO) : CALL_CONV =
+structure CallConv : CALL_CONV =
   struct
+
+    structure BI = BackendInfo
     type lvar = Lvars.lvar
     type offset = int
 
@@ -167,47 +169,12 @@ functor CallConv(BI : BACKEND_INFO) : CALL_CONV =
               val ((astys,stys), (ps,regs)) = resolv (stys,(ps,regs))
               val ((arstys,rstys), (ps,_)) = resolv (rstys,(ps,regs))
               val ((afstys,fstys), (ps,_)) = resolv (fstys,(ps,fregs))
-              val (astys',arstys',afstys') =
-                  if BI.down_growing_stack then
-                    let val afstys' = map assign_stack (rev fstys)
-                        val arstys' = map assign_stack (rev rstys)
-                        val astys' = map assign_stack (rev stys)
-                    in (astys',arstys',afstys')
-                    end
-                  else
-                    let val astys' = map assign_stack stys
-                        val arstys' = map assign_stack rstys
-                        val afstys' = map assign_stack fstys
-                    in (astys', arstys',afstys')
-                    end
+              val afstys' = map assign_stack (rev fstys)
+              val arstys' = map assign_stack (rev rstys)
+              val astys' = map assign_stack (rev stys)
           in (astys@astys', arstys@arstys', afstys@afstys', ps)
           end
 
-(*
-      fun resolve_stys_args ([], [], (acc,ph_regs)) = ([], [], (acc,ph_regs))
-        | resolve_stys_args (args_stys, reg_args_stys, (acc,[])) =      (* no more phregs *)
-        if BI.down_growing_stack then
-          let val reg_args = map assign_stack (rev reg_args_stys)
-              val args = map assign_stack (rev args_stys)
-          in (args, reg_args, (acc, []))
-          end
-        else
-          let val args = map assign_stack args_stys
-              val reg_args = map assign_stack reg_args_stys
-          in (args, reg_args, (acc, []))
-          end
-        | resolve_stys_args (asty::astys, rastys, (acc,ph_reg::ph_regs)) =
-        let val (astys', rastys', (lv_phreg_list,ph_regs')) = resolve_stys_args (astys, rastys, (acc,ph_regs))
-            val (asty', lv_phreg') = assign_phreg (asty, ph_reg)
-        in (asty'::astys', rastys', (lv_phreg'::lv_phreg_list,ph_regs'))
-        end
-        | resolve_stys_args ([], rasty::rastys, (acc,ph_reg::ph_regs)) =
-        let val (_,rastys', (lv_phreg_list,ph_regs')) = resolve_stys_args ([], rastys, (acc,ph_regs))
-            val (rasty', lv_phreg') = assign_phreg (rasty, ph_reg)
-        in ([], rasty'::rastys', (lv_phreg'::lv_phreg_list,ph_regs'))
-        end
-*)
-
       fun resolve_sty_opt (SOME sty,(ps,[])) = (SOME(assign_stack sty),(ps,[]))
         | resolve_sty_opt (SOME sty,(ps,r::rs)) =
           let val (sty,p) = assign_phreg(sty,r)

src/Compiler/Backend/ClosConvEnv.sml

@@ -1,7 +1,8 @@
 
-functor ClosConvEnv(BI : BACKEND_INFO where type label = AddressLabels.label) :  CLOS_CONV_ENV =
+structure ClosConvEnv :  CLOS_CONV_ENV =
   struct
 
+    structure BI = BackendInfo
     structure RegvarFinMap = EffVarEnv
     structure Labels = AddressLabels
     structure PP = PrettyPrint

src/Compiler/Backend/ClosExp.sml

@@ -1,14 +1,6 @@
-functor ClosExp(structure CallConv: CALL_CONV where type lvar = Lvars.lvar
-                structure ClosConvEnv: CLOS_CONV_ENV
-                  where type con = Con.con
-                  where type place = AtInf.place
-                  where type excon = Excon.excon
-                  where type lvar = Lvars.lvar
-                  where type label = AddressLabels.label
-                  where type phsize = PhysSizeInf.phsize
-                  where type StringTree = PrettyPrint.StringTree
-                structure BI : BACKEND_INFO) : CLOS_EXP =
+structure ClosExp : CLOS_EXP =
 struct
+  structure BI = BackendInfo
   structure PP = PrettyPrint
   structure Labels = AddressLabels
   structure RE = MulExp.RegionExp

src/Compiler/Backend/CodeGenUtil.sml

@@ -49,18 +49,13 @@ signature INSTS_COMMON = sig
 end
 
 functor CodeGenUtil(structure Insts : INSTS_COMMON
-                    structure BackendInfo : BACKEND_INFO
-                        where type label = AddressLabels.label
-                    structure CallConv: CALL_CONV
-                        where type lvar = Lvars.lvar
                     structure LineStmt: LINE_STMT
                         where type con = Con.con
                         where type excon = Excon.excon
                         where type lvar = Lvars.lvar
                         where type label = AddressLabels.label
                         where type place = Effect.effect
                         where type StringTree = PrettyPrint.StringTree
-                      sharing type CallConv.cc = LineStmt.cc
                     structure SubstAndSimplify: SUBST_AND_SIMPLIFY
                         where type ('a,'b,'c) LinePrg = ('a,'b,'c) LineStmt.LinePrg
                         where type lvar = Lvars.lvar

src/Compiler/Backend/FetchAndFlush.sml

@@ -1,14 +1,12 @@
-functor FetchAndFlush(structure CallConv: CALL_CONV
-			where type lvar = Lvars.lvar
-		      structure LineStmt: LINE_STMT
+functor FetchAndFlush(structure LineStmt: LINE_STMT
 		        where type con = Con.con
 		        where type excon = Excon.excon
 		        where type lvar = Lvars.lvar
                         where type place = Effect.effect
                         where type label = AddressLabels.label
 		        where type phsize = PhysSizeInf.phsize
                         where type StringTree = PrettyPrint.StringTree
-                        sharing type CallConv.cc = LineStmt.cc
+                        where type cc = CallConv.cc
 		      structure RegAlloc: REG_ALLOC
                         where type lvar = Lvars.lvar
                         where type label = AddressLabels.label

src/Compiler/Backend/JumpTables.sml

@@ -1,6 +1,7 @@
-functor JumpTables(BI : BACKEND_INFO) : JUMP_TABLES =
+structure JumpTables :> JUMP_TABLES =
   struct
 
+    structure BI = BackendInfo
     (***********)
     (* Logging *)
     (***********)

src/Compiler/Backend/LineStmt.sml

@@ -1,19 +1,9 @@
-functor LineStmt(structure CallConv: CALL_CONV
-                   where type lvar = Lvars.lvar
-                 structure ClosExp: CLOS_EXP
-                   where type con = Con.con
-                   where type excon = Excon.excon
-                   where type lvar = Lvars.lvar
-                   where type place = Effect.effect
-                   where type label = AddressLabels.label
-                   where type phsize = PhysSizeInf.phsize
-                   where type StringTree = PrettyPrint.StringTree
-                 sharing type CallConv.cc = ClosExp.cc
-                 structure BI : BACKEND_INFO
-                 structure RI : REGISTER_INFO
+functor LineStmt(structure RI : REGISTER_INFO
                    where type lvar = Lvars.lvar)
     : LINE_STMT =
 struct
+
+  structure BI = BackendInfo
   structure Labels = AddressLabels
   structure PP = PrettyPrint
   val _ = Flags.add_bool_entry

src/Compiler/Backend/NativeCompile.sml

@@ -16,9 +16,8 @@
 
 signature NATIVE_COMPILE =
   sig
-    structure CallConv : CALL_CONV
-    structure LineStmt : LINE_STMT
-    structure ClosExp : CLOS_EXP
+    structure LineStmt : LINE_STMT where type cc = CallConv.cc
+                                   where type lvar = Lvars.lvar
     structure SubstAndSimplify : SUBST_AND_SIMPLIFY
 
     type BackendEnv
@@ -35,7 +34,6 @@ signature NATIVE_COMPILE =
     type StoreTypeCO
     type Aty
 
-
     val compile : BackendEnv * ((place*pp)at,place*phsize,unit) LambdaPgm * bool * string(*vcg_file*) ->
       BackendEnv * {main_lab:label,
 		    code:(StoreTypeCO,offset,Aty) LinePrg,
@@ -47,44 +45,26 @@ signature NATIVE_COMPILE =
   end
 
 
-functor NativeCompile (structure BackendInfo : BACKEND_INFO
-			 where type label = AddressLabels.label
-		       structure RegisterInfo : REGISTER_INFO
+functor NativeCompile (structure RegisterInfo : REGISTER_INFO
 			 where type lvar = Lvars.lvar
 		       ) : NATIVE_COMPILE =
   struct
     structure RegionExp = MulExp.RegionExp
     structure PP = PrettyPrint
 
-    structure ClosConvEnv = ClosConvEnv(BackendInfo)
-
-    structure CallConv = CallConv(BackendInfo)
-
-    structure ClosExp = ClosExp(structure ClosConvEnv = ClosConvEnv
-				structure BI = BackendInfo
-				structure CallConv = CallConv)
-
-    structure LineStmt = LineStmt(structure CallConv = CallConv
-				  structure ClosExp = ClosExp
-				  structure RI = RegisterInfo
-				  structure BI = BackendInfo)
+    structure LineStmt = LineStmt(structure RI = RegisterInfo)
 
-    structure RegAlloc = RegAlloc(structure CallConv = CallConv
-				  structure LineStmt = LineStmt
+    structure RegAlloc = RegAlloc(structure LineStmt = LineStmt
 				  structure RI = RegisterInfo)
 
-    structure FetchAndFlush = FetchAndFlush(structure CallConv = CallConv
-					    structure LineStmt = LineStmt
+    structure FetchAndFlush = FetchAndFlush(structure LineStmt = LineStmt
 					    structure RegAlloc = RegAlloc
 					    structure RI = RegisterInfo)
 
-    structure CalcOffset = CalcOffset(structure CallConv = CallConv
-				      structure LineStmt = LineStmt
-				      structure FetchAndFlush = FetchAndFlush
-				      structure BI = BackendInfo)
+    structure CalcOffset = CalcOffset(structure LineStmt = LineStmt
+				      structure FetchAndFlush = FetchAndFlush)
 
-    structure SubstAndSimplify = SubstAndSimplify(structure CallConv = CallConv
-						  structure LineStmt = LineStmt
+    structure SubstAndSimplify = SubstAndSimplify(structure LineStmt = LineStmt
 						  structure CalcOffset = CalcOffset
 						  structure RI = RegisterInfo)
 

src/Compiler/Backend/RegAlloc.sml

@@ -1,13 +1,11 @@
-functor RegAlloc(structure CallConv: CALL_CONV
-                    where type lvar = Lvars.lvar
-                 structure LineStmt: LINE_STMT
+functor RegAlloc(structure LineStmt: LINE_STMT
                    where type con = Con.con
                    where type excon = Excon.excon
                    where type lvar = Lvars.lvar
                    where type place = Effect.effect
                    where type label = AddressLabels.label
                    where type StringTree = PrettyPrint.StringTree
-                   sharing type CallConv.cc = LineStmt.cc
+                   where type cc = CallConv.cc
                  structure RI : REGISTER_INFO
                    where type lvar = Lvars.lvar)
     : REG_ALLOC =

src/Compiler/Backend/SubstAndSimplify.sml

@@ -1,14 +1,12 @@
-functor SubstAndSimplify(structure CallConv: CALL_CONV
-                           where type lvar = Lvars.lvar
-                         structure LineStmt: LINE_STMT
+functor SubstAndSimplify(structure LineStmt: LINE_STMT
                            where type con = Con.con
                            where type excon = Excon.excon
                            where type lvar = Lvars.lvar
                            where type place = Effect.effect
                            where type label = AddressLabels.label
                            where type phsize = PhysSizeInf.phsize
                            where type StringTree = PrettyPrint.StringTree
-                         sharing type CallConv.cc = LineStmt.cc
+                           where type cc = CallConv.cc
                          structure CalcOffset: CALC_OFFSET
                            where type lvar = Lvars.lvar
                            where type place = Effect.place