main.sml 3.62 KB
Newer Older
mb0's avatar
mb0 committed
1
2
3
4
5
6
7
8
9

structure Main = struct

   structure Passes = struct
      open CompilationMonad
      infix >>= >>

      fun all ins =
         Parser.run ins >>=
10
         ResolveSymbols.run >>=
11
         Desugar.run >>=
mb0's avatar
mb0 committed
12
         CPSPasses.run >>=
mb0's avatar
mb0 committed
13
         CodegenPasses.run 
mb0's avatar
mb0 committed
14

15
16
      fun run fps = let
         val ers = Error.mkErrStream'()
mb0's avatar
mb0 committed
17
         val () = Controls.set (BasicControl.verbose, 1)
mb0's avatar
mb0 committed
18
         val () = Stats.resetAll()
mb0's avatar
mb0 committed
19
      in
20
         CompilationMonad.run ers (all fps >> return ())
mb0's avatar
mb0 committed
21
            before
22
               Stats.report()
mb0's avatar
mb0 committed
23
      end
mb0's avatar
mb0 committed
24
25
26
27
28
29

      fun allTc ins = 
         Parser.run ins >>=
         ResolveSymbols.run >>= (fn ast =>
         ResolveTypeInfo.run ast >>= (fn tInfo =>
         TypeInference.run (tInfo, ast) >>= (fn tys =>
30
         return () (*(TextIO.print (TypeInference.showTable tys))*)
31
         )))
mb0's avatar
mb0 committed
32

33
34
      fun runTc fps = let
         val ers = Error.mkErrStream'()
mb0's avatar
mb0 committed
35
         val () = Controls.set (BasicControl.verbose, 1)
36
         val () = Stats.resetAll()
mb0's avatar
mb0 committed
37
      in
38
         CompilationMonad.run ers (allTc fps >> return ())
mb0's avatar
mb0 committed
39
            before
40
               Stats.report()
mb0's avatar
mb0 committed
41
      end
mb0's avatar
mb0 committed
42
43
   end

mb0's avatar
mb0 committed
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
   fun showControls () = let
      fun err msg = TextIO.output (TextIO.stdErr, msg)
   in
      BasicControl.showAll
         err
         (Controls.name o #ctl,
          fn ci =>
            concat
               [#help (Controls.info (#ctl ci)),
                " : ", Controls.get (#ctl ci)])
         NONE
   end

   val usageMsg = "\
\usage: spec [options] file\n\
\  options:\n\
\    -C<control>=<v>  set named control\n\
\    -h               show help message\n\
\    -verbose         verbose mode\n\
\"

   fun processControl arg = let
      val spec = Substring.extract (arg, 2, NONE)
      val (name, value) = Substring.splitl (fn c => c <> #"=") spec
      val name = Substring.string name
      val names = String.fields (fn c => c = #".") name
      val value =
         if Substring.size value > 0
            then Substring.string (Substring.slice (value, 1, NONE))
         else ""
   in
      if name = "" orelse value = ""
         then bad (concat ["!* ill-formed -C option: `", arg, "'\n"])
      else
         (case ControlRegistry.control BasicControl.topRegistry names of
            NONE => bad (concat ["!* unknown control: ", name, "\n"])
          | SOME sctl =>
               (Controls.set (sctl, value)
                  handle Controls.ValueSyntax vse =>
                     bad
                        (concat
                           ["!* unable to parse value `",
                            value, "' for ", name, " : ", #tyName vse, "\n"])))
   end

   and processArgs args =
      case args of
         arg :: args =>
            if String.size arg > 0 andalso String.sub (arg, 0) = #"-"
               then processOption (arg, args)
            else processFile (arg, args)
       | _ => usage ()

97
   and processFile (file, files) = run (file::files)
mb0's avatar
mb0 committed
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121

   and processOption (arg, args) = let
      fun badopt () = bad (concat ["!* ill-formed option: '", arg, "'\n"])
      fun set ctl = (Controls.set(ctl, true); processArgs args)
   in
      if String.isPrefix "-C" arg
         then (processControl arg; processArgs args)
      else
         case arg of
            "-h" => usage ()
          | "-verbose" => (Controls.set(BasicControl.verbose, 1); processArgs args)
          | _ => badopt ()
   end

   and bad s =
      (TextIO.output (TextIO.stdErr, s)
      ;usage())

   and usage () =
      (showControls()
      ;TextIO.output (TextIO.stdErr, usageMsg)
      ;OS.Process.exit OS.Process.failure)

   and run fp = Passes.run fp
122
123
124
   fun main () =
      (processArgs (CommandLine.arguments())
      ;OS.Process.exit OS.Process.success)
125
end