diff options
Diffstat (limited to '')
| -rw-r--r-- | compiler/Errors.ml | 2 | ||||
| -rw-r--r-- | compiler/Main.ml | 31 | ||||
| -rw-r--r-- | compiler/PrePasses.ml | 19 |
3 files changed, 35 insertions, 17 deletions
diff --git a/compiler/Errors.ml b/compiler/Errors.ml index 6057362e..68073ef7 100644 --- a/compiler/Errors.ml +++ b/compiler/Errors.ml @@ -7,7 +7,7 @@ let meta_to_string (span : Meta.span) = ^ loc_to_string span.end_loc let format_error_message (meta : Meta.meta) msg = - msg ^ ":" ^ meta_to_string meta.span + msg ^ "\n" ^ meta_to_string meta.span exception CFailure of string diff --git a/compiler/Main.ml b/compiler/Main.ml index 41addc81..88c32ca9 100644 --- a/compiler/Main.ml +++ b/compiler/Main.ml @@ -267,16 +267,31 @@ let () = definitions"; fail ()); - (* Apply the pre-passes *) - let m = Aeneas.PrePasses.apply_passes m in + (try + (* Apply the pre-passes *) + let m = Aeneas.PrePasses.apply_passes m in - (* Some options for the execution *) + (* Test the unit functions with the concrete interpreter *) + if !test_unit_functions then Test.test_unit_functions m; - (* Test the unit functions with the concrete interpreter *) - if !test_unit_functions then Test.test_unit_functions m; - - (* Translate the functions *) - Aeneas.Translate.translate_crate filename dest_dir m; + (* Translate the functions *) + Aeneas.Translate.translate_crate filename dest_dir m + with Errors.CFailure msg -> + (* In theory it shouldn't happen, but there may be uncaught errors - + note that we let the Failure errors go through *) + (* The error should have been saved *) + let meta = + match !Errors.error_list with + | (m, _) :: _ -> m + | _ -> (* Want to be safe here *) None + in + let msg = + match meta with + | None -> msg + | Some m -> Errors.format_error_message m msg + in + log#serror msg; + exit 1); (* Print total elapsed time *) log#linfo diff --git a/compiler/PrePasses.ml b/compiler/PrePasses.ml index 42857a88..8c346a8c 100644 --- a/compiler/PrePasses.ml +++ b/compiler/PrePasses.ml @@ -214,14 +214,17 @@ let remove_loop_breaks (crate : crate) (f : fun_decl) : fun_decl = object inherit [_] map_statement as super - method! visit_Loop entered_loop loop = - cassert (not entered_loop) st.meta - "Nested loops are not supported yet"; - super#visit_Loop true loop - - method! visit_Break _ i = - cassert (i = 0) st.meta "Breaks to outer loops are not supported yet"; - nst.content + method! visit_statement entered_loop st = + match st.content with + | Loop loop -> + cassert (not entered_loop) st.meta + "Nested loops are not supported yet"; + { st with content = super#visit_Loop true loop } + | Break i -> + cassert (i = 0) st.meta + "Breaks to outer loops are not supported yet"; + { st with content = nst.content } + | _ -> super#visit_statement entered_loop st end in obj#visit_statement false st |