summaryrefslogtreecommitdiff
path: root/main.ml
blob: 4d7d7da4b475976520f61386e04f233b52473cdd (plain)
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
(****************************************
      main.ml - là où tout converge
 ****************************************)

open Format
open Lexing
open Ast

(* Les options ... *)
let parse_only = ref false
let type_only = ref false
let verbose = ref false
let printtypes = ref false
let verbose_assembly = ref false

let ifile = ref ""
let ifile_length = ref 0
let ofile = ref ""

let set_file f s = f := s 

let options = 
    ["-parse-only", Arg.Set parse_only, 
     "  Arrête la compilation après la phase d'analyse syntaxique";
     "-type-only", Arg.Set type_only, 
     "  Arrête la compilation après la phase d'analyse sémantique";
     "-v", Arg.Set verbose,
     "  Affiche des informations supplémentaires sur la compilation";
     "-print-decl-types", Arg.Set printtypes,
     "  Affiche les types des déclarations de plus haut niveau";
     "-verbose-assembly", Arg.Set verbose_assembly,
     "  Active les commentaires du code assembleur produit";
     "-o", Arg.String (set_file ofile), 
     "<file>  Définit le nom du fichier de sortie)"]

let usage = "Usage: petit-caml [option] file.ml"

(* Localisation des erreurs venant du parser/lexer *)
let localisation pos =
    let l = pos.pos_lnum in
    let c = pos.pos_cnum - pos.pos_bol + 1 in
    eprintf "File \"%s\", line %d, characters %d-%d:\n" !ifile l (c-1) c
(* Localisation des erreurs du typeur (informations issues de l'ast) *)
let localisation_expr = function
    | None -> (* Ce cas ne devrait pas être atteignable, mais bon *)
        eprintf "File \"%s\", line 0, characters 0-%d:\n"
                !ifile
                !ifile_length
    | Some loc when loc.spos.l = loc.epos.l ->
        eprintf "File \"%s\", line %d, characters %d-%d:\n"
                !ifile
                loc.spos.l
                loc.spos.c
                loc.epos.c
    | Some loc ->
        eprintf "File \"%s\", line %d, characters %d-%d:\n"
                !ifile
                loc.spos.l
                loc.spos.c
                (loc.spos.c + loc.epos.raw_c - loc.spos.raw_c)

(* Le main du compilateur :
   * Vérification des arguments, du nom du fichier source
   * Génération éventuelle du nom de fichier de sortie
   * Ouverture du fichier source
   * Création d'un tampon d'analyse lexicale (lexbuf)
   * Lancement de l'analyse syntaxique avec ce lexbuf
   => arrêt éventuel à cet endroit (si parse-only)
   * Analyse sémantique
   => arrêt éventuel à cet endroit (si type-only)
   * Génération du code et écriture du fichier de sortie *)
let _ = 
    Arg.parse options (set_file ifile) usage;

    if !ifile = "" then begin
        eprintf "Aucun fichier à compiler\n@?";
        exit 1
    end;

    if not (Filename.check_suffix !ifile ".ml") then begin
        eprintf "Le fichier d'entrée doit avoir l'extension .ml\n@?";
        Arg.usage options usage;
        exit 1
    end;

    if !ofile = "" then
        ofile := Filename.chop_suffix !ifile ".ml" ^ ".s";
  
    let f = open_in !ifile in

    ifile_length := in_channel_length f;

    let buf = Lexing.from_channel f in
  
    try
        let a = Parser.fichier Lexer.token buf
        in
            close_in f;

            if !verbose then Utils.display_ast a;

            if !parse_only then exit 0;

            let _ = Typing.type_ast a
            in
                if !verbose then Utils.display_ast a;
                if !printtypes then Utils.print_types a;
                
                if !type_only then exit 0;

                Compile.compile a !ofile !verbose_assembly
    with
        | Lexer.Lexing_error err -> 
            localisation (Lexing.lexeme_start_p buf);
            eprintf "Erreur dans l'analyse lexicale : %s@." err;
            exit 1
        | Failure "int_of_string" ->
            eprintf "Erreur dans l'analyse lexicale (entier invalide)@.";
            exit 1
        | Parser.Error -> 
            localisation (Lexing.lexeme_start_p buf);
            eprintf "Erreur dans l'analyse syntaxique@.";
            exit 1
        | Typing.TypingFailure (loc, err) ->
            localisation_expr loc;
            eprintf "Erreur dans l'analyse sémantique : %s@." err;
            exit 1
        | _ ->
            eprintf "Erreur du compilateur@.";
            exit 2