-
Notifications
You must be signed in to change notification settings - Fork 1
/
main.sml
144 lines (128 loc) · 4.86 KB
/
main.sml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
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
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
(* main.sml
*
* Driver routine for MLPolyR compiler.
*
* Copyright (c) 2005 by Matthias Blume ([email protected])
*)
structure Main : sig
val compile :
{ pclust: bool, pbbt: bool, pigraph: bool, no_ra: bool, pdefs: bool } ->
string * string -> bool
val main : string * string list -> OS.Process.status
end = struct
datatype state = ToAsm | ToTC | ToObj | ToExe
val rts = "rt/mlpr-rt.o"
fun remove file =
OS.FileSys.remove file handle _ => ()
fun typecheck { pclust, pbbt, pigraph, no_ra, pdefs } file =
let val (ast, source) = Parse.parse file
in if ErrorMsg.anyErrors (ErrorMsg.errors source) then false
else let val asyn = Elaborate.elaborate
(source, BaseEnv.elabBase, pdefs) ast
in if pclust then
let val { lambda, strings = _} =
Translate.translate (asyn, BaseEnv.transBase)
val res = LambdaInterpreter.eval
Interpreter.runtime
(Interpreter.makeProgram lambda)
val _ = Interpreter.printResult res
in
true
end
else true
end
end
fun compile cflags (file, asmfile) =
let val (ast, source) = Parse.parse file
in if ErrorMsg.anyErrors (ErrorMsg.errors source) then false
else let val asm_s = TextIO.openOut asmfile
in Compile.compile cflags (ast, source, asm_s)
before TextIO.closeOut asm_s
end
end
fun main (self, args) = let
fun complain msg =
TextIO.output (TextIO.stdErr, concat (self :: ": " :: msg))
fun system cmd =
if OS.Process.system cmd = OS.Process.success then true
else (complain ["command `", cmd, "' failed\n"];
false)
fun assemble (asmfile, objfile) =
system (concat ["as -o ", objfile, " ", asmfile])
fun link (objfile, executable) =
system (concat ["cc -o ", executable, " ",
objfile, " ", rts])
fun onefile (flags, state, target, file) = let
fun aoe base =
(OS.Path.joinBaseExt { base = base, ext = SOME "s" },
OS.Path.joinBaseExt { base = base, ext = SOME "o" },
base)
val (asmfile, objfile, executable) =
case OS.Path.splitBaseExt file of
{ base, ext = SOME "mlpr" } => aoe base
| _ => aoe file
in case state of
ToAsm => compile flags (file, getOpt (target, asmfile))
| ToTC => typecheck flags file
| ToObj =>
((compile flags (file, asmfile) andalso
assemble (asmfile, getOpt (target, objfile)))
before remove asmfile)
| ToExe =>
((((compile flags (file, asmfile) andalso
assemble (asmfile, objfile))
before remove asmfile) andalso
link (objfile, getOpt (target, executable)))
before remove objfile)
end
fun setPC { pclust, pbbt, pigraph, no_ra, pdefs } =
{ pclust = true, pbbt = pbbt, pigraph = pigraph,
no_ra = no_ra, pdefs = pdefs }
fun setPT { pclust, pbbt, pigraph, no_ra, pdefs } =
{ pclust = pclust, pbbt = true, pigraph = pigraph,
no_ra = no_ra, pdefs = pdefs }
fun setSG { pclust, pbbt, pigraph, no_ra, pdefs } =
{ pclust = pclust, pbbt = pbbt, pigraph = true,
no_ra = no_ra, pdefs = pdefs }
fun setNORA { pclust, pbbt, pigraph, no_ra, pdefs } =
{ pclust = pclust, pbbt = pbbt, pigraph = pigraph,
no_ra = true, pdefs = pdefs }
fun setPD { pclust, pbbt, pigraph, no_ra, pdefs } =
{ pclust = pclust, pbbt = pbbt, pigraph = pigraph,
no_ra = no_ra, pdefs = true }
val noflags =
{ pclust = false, pbbt = false, pigraph = false,
no_ra = false, pdefs = false }
fun process (flags, state, _, "-o" :: target :: rest) =
process (flags, state, SOME target, rest)
| process (_, _, _, ["-o"]) =
(complain ["option -o given without argument\n"];
OS.Process.failure)
| process (flags, _, target, "-S" :: rest) =
process (flags, ToAsm, target, rest)
| process (flags, _, target, "-t" :: rest) =
process (flags, ToTC, target, rest)
| process (flags, _, target, "-e" :: rest) =
process (setPC flags, ToTC, target, rest)
| process (flags, _, target, "-c" :: rest) =
process (flags, ToObj, target, rest)
| process (flags, state, target, "-PC" :: rest) =
process (setPC flags, state, target, rest)
| process (flags, state, target, "-PT" :: rest) =
process (setPT flags, state, target, rest)
| process (flags, state, target, "-SG" :: rest) =
process (setSG flags, state, target, rest)
| process (flags, state, target, "-NORA" :: rest) =
process (setNORA flags, state, target, rest)
| process (flags, state, target, "-PD" :: rest) =
process (setPD flags, state, target, rest)
| process (flags, state, target, file :: rest) =
if onefile (flags, state, target, file)
then process (flags, state, target, rest)
else OS.Process.failure
| process (_, _, _, []) = OS.Process.success
in process (noflags, ToExe, NONE, args)
end handle e =>
(TextIO.output (TextIO.stdErr, General.exnMessage e ^ "\n");
OS.Process.failure)
end