comparison ppc/main.ml @ 0:bfdcc3820b32

Basis
author Mike Spivey <mike@cs.ox.ac.uk>
date Thu, 05 Oct 2017 08:04:15 +0100
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:bfdcc3820b32
1 (* ppc/main.ml *)
2 (* Copyright (c) 2017 J. M. Spivey *)
3
4 open Print
5 open Mach
6 open Source
7
8 let debug = ref 0
9
10 let usage = "Usage: ppc [-b] [-d n] [-O] file.p"
11
12 let spec =
13 Arg.align
14 ["-b", Arg.Unit (function () -> Kgen.boundchk := true),
15 " enable bound checks";
16 "-d", Arg.Int (function x -> debug := x), "n set debug level";
17 "-O", Arg.Set Kgen.optflag, " enable peephole optimiser"]
18
19 let main () =
20 let fns = ref [] in
21 Arg.parse spec (function s -> fns := !fns @ [s]) usage;
22 if List.length !fns <> 1 then begin
23 fprintf stderr "$\n" [fStr usage]; exit 2
24 end;
25 let in_file = List.hd !fns in
26 let in_chan = open_in in_file in
27 let lexbuf = Lexing.from_channel in_chan in
28 Source.init in_file in_chan;
29 Peepopt.debug := !debug;
30 ignore (Parsing.set_trace (!debug > 2));
31
32 let prog =
33 try Parser.program Lexer.token lexbuf with
34 Parsing.Parse_error ->
35 let tok = Lexing.lexeme lexbuf in
36 Source.err_message "syntax error at token '$'" [fStr tok] !Lexer.lineno;
37 exit 1 in
38
39 if !debug > 0 then Tree.print_tree stdout "" prog;
40
41 begin try Check.annotate prog with
42 Check.Sem_error (fmt, args, ln) ->
43 Source.err_message fmt args ln;
44 exit 1
45 end;
46
47 printf "MODULE Main 0 0\n" [];
48 printf "IMPORT Lib 0\n" [];
49 printf "ENDHDR\n\n" [];
50 Kgen.translate prog;
51 printf "! End\n" [];
52 exit 0
53
54 let ppc = main ()