Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/compiler/FLINT/main/control.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/FLINT/main/control.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1200, Fri May 17 19:53:41 2002 UTC revision 1201, Fri May 17 20:48:38 2002 UTC
# Line 3  Line 3 
3  structure FLINT_Control (* : FLINTCONTROL *) =  structure FLINT_Control (* : FLINTCONTROL *) =
4  struct  struct
5     local     local
6         val m = Controls.registry { name = "optimizer (FLINT) settings",         val priority = [10, 11, 1]
7                                     priority = [10, 11, 1],         val obscurity = 5
8                                     obscurity = 5,         val prefix = "flint"
9                                     prefix = "flint-",  
10                                     default_suffix = SOME "-default",         val registry = ControlRegistry.new
11                                     mk_ename = NONE }                            { help = "optimizer (FLINT) settings" }
12    
13         val flag_r = Controls.group m Controls.bool         val _ = BasicControl.nest (prefix, registry)
14    
15         val int_r = Controls.group m Controls.int         val flag_cvt = { tyName = "bool",
16                            fromString = Bool.fromString,
17         val stringList_r = Controls.group m Controls.stringList                          toString = Bool.toString }
18           val int_cvt = { tyName = "int",
19         fun new (r, s, d, f) =                         fromString = Int.fromString,
20             Controls.new r { stem = s, descr = d, fallback = f }                         toString = Int.toString }
21           val sl_cvt =
22               { tyName = "string list",
23                 fromString = SOME o String.tokens Char.isSpace,
24                 toString = concat o foldr (fn (s, r) => " " :: s :: r) [] }
25    
26    
27           fun new (c, n, e, h, d) = let
28               val r = ref d
29               val ctl = Controls.control { name = n,
30                                            pri = priority,
31                                            obscurity = obscurity,
32                                            help = h,
33                                            ctl = r }
34           in
35               ControlRegistry.register
36                   registry
37                   { ctl = Controls.stringControl c ctl,
38                     envName = SOME ("FLINT_" ^ e) };
39               r
40           end
41     in     in
42    
43      val print           = new (flag_r, "print", "show IR", false)      val print           = new (flag_cvt, "print", "PRINT", "show IR", false)
44      val printPhases     = new (flag_r, "print-phases", "show phases", false)      val printPhases     = new (flag_cvt, "print-phases", "PRINT_PHASES",
45      val printFctTypes   = new (flag_r, "print-fct-types",                                 "show phases", false)
46        val printFctTypes   = new (flag_cvt, "print-fct-types", "PRINT_FCT_TYPES",
47                                 "show function types", false)                                 "show function types", false)
48      (* `split' should probably be called just after `fixfix' since      (* `split' should probably be called just after `fixfix' since
49       * fcontract might eliminate some uncurry wrappers which are       * fcontract might eliminate some uncurry wrappers which are
50       * locally unused but could be cross-module inlined. *)       * locally unused but could be cross-module inlined. *)
51      val phases =      val phases =
52          new (stringList_r, "phases", "FLINT phases",          new (sl_cvt, "phases", "PHASES", "FLINT phases",
53               ["lcontract", (* Cruder but quicker than fcontract *)               ["lcontract", (* Cruder but quicker than fcontract *)
54                "fixfix", "fcontract",                "fixfix", "fcontract",
55                "specialize",                "specialize",
# Line 36  Line 57 
57                "wrap", "fcontract", "reify",                "wrap", "fcontract", "reify",
58                (*"abcopt",*) "fcontract", "fixfix", "fcontract+eta"])                (*"abcopt",*) "fcontract", "fixfix", "fcontract+eta"])
59    
60      val inlineThreshold =      val inlineThreshold = new (int_cvt, "inline-theshold", "INLINE_THRESHOLD",
61          new (int_r, "inline-theshold", "inline threshold", 16)                                 "inline threshold", 16)
62      (* val splitThreshold  = ref 0 *)      (* val splitThreshold  = ref 0 *)
63      val unrollThreshold =      val unrollThreshold = new (int_cvt, "unroll-threshold", "UNROLL_THRESHOLD",
64          new (int_r, "unroll-threshold", "unroll threshold", 20)                                 "unroll threshold", 20)
65      val maxargs =      val maxargs = new (int_cvt, "maxargs", "MAXARGS",
66          new (int_r, "maxargs", "max number of arguments", 6)                         "max number of arguments", 6)
67      val dropinvariant =      val dropinvariant = new (flag_cvt, "dropinvariant", "DROPINVARIANT",
68          new (flag_r, "dropinvariant", "dropinvariant", true)                               "dropinvariant", true)
69    
70      val specialize =      val specialize = new (flag_cvt, "specialize", "SPECIALIZE",
71          new (flag_r, "specialize", "whether to specialize", true)                            "whether to specialize", true)
72      (* val liftLiterals = ref false *)      (* val liftLiterals = ref false *)
73      val sharewrap =      val sharewrap = new (flag_cvt, "sharewrap", "SHAREWRAP",
74          new (flag_r, "sharewrap", "whether to share wrappers", true)                           "whether to share wrappers", true)
75      val saytappinfo =      val saytappinfo = new (flag_cvt, "saytappinfo", "SAYTAPPINFO",
76          new (flag_r, "saytappinfo", "whether to show typelifting stats", false)                             "whether to show typelifting stats", false)
77    
78      (* only for temporary debugging *)      (* only for temporary debugging *)
79      val misc = ref 0      val misc = ref 0
80    
81      (* FLINT internal type-checking controls *)      (* FLINT internal type-checking controls *)
82      val check =      val check = new (flag_cvt, "check", "CHECK",
83          new (flag_r, "check", "whether to typecheck the IR", false)                       "whether to typecheck the IR", false)
84          (* fails on MLRISC/*/*RegAlloc.sml *)          (* fails on MLRISC/*/*RegAlloc.sml *)
85      val checkDatatypes =      val checkDatatypes = new (flag_cvt, "check-datatypes", "CHECK_DATATYPES",
86          new (flag_r, "check-datatypes", "typecheck datatypes", false)                                "typecheck datatypes", false)
87          (* loops on the new cm.sml *)          (* loops on the new cm.sml *)
88      val checkKinds =      val checkKinds = new (flag_cvt, "check-kinds", "CHECK_KINDS",
89          new (flag_r, "check-kinds", "check kinding information", true)                            "check kinding information", true)
90    
91      (* non-exported crap *)      (* non-exported crap *)
92      val recover : (int -> unit) ref = ref(fn x => ())      val recover : (int -> unit) ref = ref(fn x => ())

Legend:
Removed from v.1200  
changed lines
  Added in v.1201

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0