Better error handling

This commit is contained in:
Denis Merigoux 2020-08-07 15:29:52 +02:00
parent 1b0da2404e
commit 03a7827dda
9 changed files with 101 additions and 211 deletions

View File

@ -16,88 +16,87 @@
let driver (source_file : string) (debug : bool) (wrap_weaved_output : bool)
(pygmentize_loc : string option) (backend : string) (language : string option)
(ex_scope : string option) (output_file : string option) : int =
Cli.debug_flag := debug;
Cli.debug_print "Reading files...";
if Filename.extension source_file <> ".catala" then begin
Cli.error_print (Printf.sprintf "Source file %s must have the .catala extension!" source_file);
exit 1
end;
let language =
match language with
| Some l ->
if l = "fr" then `Fr
else if l = "en" then `En
else if l = "non-verbose" then `NonVerbose
else begin
Cli.error_print (Printf.sprintf "The selected language (%s) is not supported by Catala" l);
exit 1
end
| None -> `NonVerbose
in
let backend =
if backend = "Makefile" then Cli.Makefile
else if backend = "LaTeX" then Cli.Latex
else if backend = "HTML" then Cli.Html
else if backend = "run" then Cli.Run
else begin
Cli.error_print
(Printf.sprintf "The selected backend (%s) is not supported by Catala" backend);
exit 1
end
in
let program = Parser_driver.parse_source_files [ source_file ] language in
match backend with
| Cli.Makefile ->
let backend_extensions_list = [ ".tex" ] in
let output_file =
match output_file with Some f -> f | None -> Filename.remove_extension source_file ^ ".d"
in
let oc = open_out output_file in
Printf.fprintf oc "%s:\\\n%s\n%s:"
(String.concat "\\\n"
( output_file
:: List.map
(fun ext -> Filename.remove_extension source_file ^ ext)
backend_extensions_list ))
(String.concat "\\\n" program.program_source_files)
(String.concat "\\\n" program.program_source_files);
0
| Cli.Latex | Cli.Html ->
let language : Cli.backend_lang = Cli.to_backend_lang language in
Cli.debug_print
(Printf.sprintf "Weaving literate program into %s"
(match backend with Cli.Latex -> "LaTeX" | Cli.Html -> "HTML" | _ -> assert false));
let weaved_output =
match backend with
| Cli.Latex -> Latex.ast_to_latex program language
| Cli.Html -> Html.ast_to_html program pygmentize_loc language
| _ -> assert false
in
let output_file =
match output_file with
| Some f -> f
| None -> (
Filename.remove_extension source_file
^ match backend with Cli.Latex -> ".tex" | Cli.Html -> ".html" | _ -> assert false )
in
let weaved_output =
if wrap_weaved_output then
try
Cli.debug_flag := debug;
Cli.debug_print "Reading files...";
if Filename.extension source_file <> ".catala" then
Errors.raise_error
(Printf.sprintf "Source file %s must have the .catala extension!" source_file);
let language =
match language with
| Some l ->
if l = "fr" then `Fr
else if l = "en" then `En
else if l = "non-verbose" then `NonVerbose
else
Errors.raise_error
(Printf.sprintf "The selected language (%s) is not supported by Catala" l)
| None -> `NonVerbose
in
let backend =
if backend = "Makefile" then Cli.Makefile
else if backend = "LaTeX" then Cli.Latex
else if backend = "HTML" then Cli.Html
else if backend = "run" then Cli.Run
else
Errors.raise_error
(Printf.sprintf "The selected backend (%s) is not supported by Catala" backend)
in
let program = Parser_driver.parse_source_files [ source_file ] language in
match backend with
| Cli.Makefile ->
let backend_extensions_list = [ ".tex" ] in
let output_file =
match output_file with
| Some f -> f
| None -> Filename.remove_extension source_file ^ ".d"
in
let oc = open_out output_file in
Printf.fprintf oc "%s:\\\n%s\n%s:"
(String.concat "\\\n"
( output_file
:: List.map
(fun ext -> Filename.remove_extension source_file ^ ext)
backend_extensions_list ))
(String.concat "\\\n" program.program_source_files)
(String.concat "\\\n" program.program_source_files);
0
| Cli.Latex | Cli.Html ->
let language : Cli.backend_lang = Cli.to_backend_lang language in
Cli.debug_print
(Printf.sprintf "Weaving literate program into %s"
(match backend with Cli.Latex -> "LaTeX" | Cli.Html -> "HTML" | _ -> assert false));
let weaved_output =
match backend with
| Cli.Latex ->
Latex.wrap_latex weaved_output program.Ast.program_source_files pygmentize_loc
language
| Cli.Html ->
Html.wrap_html weaved_output program.Ast.program_source_files pygmentize_loc language
| Cli.Latex -> Latex.ast_to_latex program language
| Cli.Html -> Html.ast_to_html program pygmentize_loc language
| _ -> assert false
else weaved_output
in
Cli.debug_print (Printf.sprintf "Writing to %s" output_file);
let oc = open_out output_file in
Printf.fprintf oc "%s" weaved_output;
close_out oc;
0
| Cli.Run -> (
try
in
let output_file =
match output_file with
| Some f -> f
| None -> (
Filename.remove_extension source_file
^ match backend with Cli.Latex -> ".tex" | Cli.Html -> ".html" | _ -> assert false )
in
let weaved_output =
if wrap_weaved_output then
match backend with
| Cli.Latex ->
Latex.wrap_latex weaved_output program.Ast.program_source_files pygmentize_loc
language
| Cli.Html ->
Html.wrap_html weaved_output program.Ast.program_source_files pygmentize_loc
language
| _ -> assert false
else weaved_output
in
Cli.debug_print (Printf.sprintf "Writing to %s" output_file);
let oc = open_out output_file in
Printf.fprintf oc "%s" weaved_output;
close_out oc;
0
| Cli.Run ->
let ctxt = Context.form_context program in
let scope_uid =
match ex_scope with
@ -128,8 +127,8 @@ let driver (source_file : string) (debug : bool) (wrap_weaved_output : bool)
(Debug.print_term ((value, Uid.get_pos uid), TDummy))))
exec_ctxt;
0
with Errors.StructuredError (msg, pos) ->
Cli.error_print (Errors.print_structured_error msg pos);
exit (-1) )
with Errors.StructuredError (msg, pos) ->
Cli.error_print (Errors.print_structured_error msg pos);
exit (-1)
let main () = Cmdliner.Term.exit @@ Cmdliner.Term.eval (Cli.catala_t driver, Cli.info)

View File

@ -17,7 +17,8 @@
exception StructuredError of (string * (string option * Pos.t) list)
let print_structured_error (msg : string) (pos : (string option * Pos.t) list) : string =
Printf.sprintf "%s\n\n%s" msg
Printf.sprintf "%s%s%s" msg
(if List.length pos = 0 then "" else "\n\n")
(String.concat "\n\n"
(List.map
(fun (msg, pos) ->

View File

@ -265,11 +265,10 @@ let add_binding (ctxt : context) (scope_uid : Uid.t) (fun_uid : Uid.t)
match get_uid_sort ctxt fun_uid with
| IdScopeVar (Some arg_uid) -> arg_uid
| _ ->
Cli.error_print
(Printf.sprintf "Var %s is supposed to be a function but it isn't\n%s"
(Uid.get_ident fun_uid)
(Uid.get_pos fun_uid |> Pos.retrieve_loc_text));
assert false
Errors.raise_spanned_error
(Printf.sprintf "Var %s is supposed to be a function but it isn't"
(Uid.get_ident fun_uid))
(Uid.get_pos fun_uid)
in
let scope_ctxt =
{ scope_ctxt with var_id_to_uid = IdentMap.add name arg_uid scope_ctxt.var_id_to_uid }

View File

@ -35,7 +35,7 @@ let token_list : (string * token) list =
("of", OF);
("collection", COLLECTION);
("enumeration", ENUM);
("integer", INTEGER);
("int", INTEGER);
("amount", MONEY);
("text", TEXT);
("decimal", DECIMAL);

View File

@ -48,10 +48,9 @@ let rec eval_term (exec_ctxt : exec_context) (term : Lambda.term) : Lambda.term
match UidMap.find_opt uid exec_ctxt with
| Some t -> t
| None ->
Cli.error_print
(Printf.sprintf "Variable %s is not defined.\n%s" (Uid.get_ident uid)
(Pos.retrieve_loc_text pos));
assert false )
Errors.raise_spanned_error
(Printf.sprintf "Variable %s is not defined" (Uid.get_ident uid))
pos )
| EApp (f, args) -> (
(* First evaluate and match the function body *)
let f = f |> eval_term exec_ctxt |> Lambda.untype in
@ -252,30 +251,23 @@ let rec execute_scope ?(exec_context = empty_exec_ctxt) (ctxt : Context.context)
| Error (true_pos, false_pos) ->
raise_default_conflict (Uid.get_ident uid, Uid.get_pos uid) true_pos false_pos )
| None ->
Cli.error_print
(Printf.sprintf "Variable %s is undefined in scope %s\n\n%s\n\n%s"
(Uid.get_ident uid)
(Uid.get_ident scope_prgm.scope_uid)
(Pos.retrieve_loc_text (Uid.get_pos scope_prgm.scope_uid))
(Pos.retrieve_loc_text (Uid.get_pos uid)));
exit (-1) )
Errors.raise_multispanned_error
(Printf.sprintf "Variable %s is undefined in scope %s" (Uid.get_ident uid)
(Uid.get_ident scope_prgm.scope_uid))
[ (None, Uid.get_pos scope_prgm.scope_uid); (None, Uid.get_pos uid) ] )
| IdSubScope sub_scope_ref ->
(* Merge the new definitions *)
let sub_scope_prgm =
match UidMap.find_opt sub_scope_ref prgm with
| Some sub_scope -> sub_scope
| None ->
Cli.error_print
Errors.raise_multispanned_error
(Printf.sprintf
"The subscope %s of %s does not define aything, and therefore cannot be \
executed\n\n\
%s\n\n\
%s"
"The subscope %s of %s has no definition inside it, and therefore cannot be \
executed"
(Uid.get_ident scope_prgm.scope_uid)
(Uid.get_ident sub_scope_ref)
(Pos.retrieve_loc_text (Uid.get_pos scope_prgm.scope_uid))
(Pos.retrieve_loc_text (Uid.get_pos sub_scope_ref)));
exit (-1)
(Uid.get_ident sub_scope_ref))
[ (None, Uid.get_pos scope_prgm.scope_uid); (None, Uid.get_pos sub_scope_ref) ]
in
let redefs =
match UidMap.find_opt uid scope_prgm.scope_sub_defs with

View File

@ -1,4 +0,0 @@
CATALA_LANG=en
SRC=scopes.catala
include ../Makefile.common

View File

@ -1,89 +0,0 @@
/*
declaration structure Child :
data date_of_birth content date
data age content integer
declaration scope ChildWellFormed :
context child content Child
context rate_of_well_formedness content integer
scope ChildWellFormed :
definition child.age is assigned to years of (now - child.date_of_birth)
declaration scope ChildBenefit :
context child0 content Child
context child_well_formed scope ChildWellFormed
scope ChildBenefit :
definition child0 := child_well_formed.child
scope ChildBenefit :
definition child_well_formed.child := 12 an
#
#
# child
# ^
# |
# child_well_formed.rate_of_well_formedness child_well_formed.child.{age, date_of_birth}
# ^ ^
# | |
# child_well_formed.rate_of_well_formedness child_well_formed.child.{age, date_of_birth}
#
# -> [sous-graphe] ->
# -> [child0] -> ... -> [child n] ->
# This is a translation of line 20
child_well_formed.rate_of_well_formedness := 15%
# This is a translation of line 19
child := (ChildWellFormed(child_well_formed.child, child_well_formed.rate_of_well_formedness)).child
# To what is this translating to ?
# ChildWellFormed translates to
# (child.date_of_birth * child.age) -> (child.date_of_birth * child.age)
# So what will the implementation of ChildBenefit look like in the lambda calculus?
#
# let ChildBenefit (
# child.date_of_birth, child.age, child_well_formed.child.date_of_birth, child_well_formed.chuildage
# ) =
# #### LINE16
# let (child_well_formed.child.date_of_birth, child_well_formed.child.age) = child_well_formed (
# child_well_formed.child.date_of_birth, child_well_formed.child.age
# ) in
# let (child.date_of_birth, child.age) =
# (child_well_formed.date_of_birth, child_well_formed.age)
# in
# (child.date_of_birth, child.age)
# We can see that definitions in the caller scope can either :
# - set a parameter of the callee scope
# - retrieve a result of the caller scope
# In the caller scope, uses of callee scope variables should correspond
# to uses of the result of these variables after calling the scope, while
# callee scope variable definitions should correspond to callee scope parameter
# setting before the call.
# But setting a parameter of the callee scope can conflict with a definition of
# this parameter inside the callee scope.
scope ChildBenefit :
definition child_well_formed.age equals 12
# How do we resolve things now ? Do we have
# - child_well_formed.age = 12 or
# - child_well_formed.age = years of (now - child_well_formed.date_of_birth) ?
#
# Well the answer to this question lies in default logic! More precisely, we have
# to pick a precedence order between definitions of the caller scope and definitions
# of the caller scope. Because the law sometimes says things like :
#
# "compute this benefit like mentionned at article XXX but change the threshold
# Foo to $ZZZZZ."
#
# The meaningful semantics to give here is that caller scope definition should
# have higher precedence on callee scope definitions.
*/

View File

@ -1,4 +0,0 @@
CATALA_LANG=nv
SRC=test_bool.catala
include ../Makefile.common

View File

@ -1,4 +0,0 @@
CATALA_LANG=nv
SRC=scope.catala
include ../Makefile.common