diff --git a/src/interpret.ml b/src/interpret.ml index f4d35669aea..4bafb9875b9 100644 --- a/src/interpret.ml +++ b/src/interpret.ml @@ -699,16 +699,25 @@ and interpret_func env name pat f v (k : V.value V.cont) = (* Programs *) -let interpret_prog scope p : V.value option * scope = - let env = env_of_scope scope in - trace_depth := 0; - let vo = ref None in - let ve = ref V.Env.empty in - Scheduler.queue (fun () -> - interpret_block env p.it (Some ve) (fun v -> vo := Some v) - ); - Scheduler.run (); - !vo, { val_env = !ve; lib_env = scope.lib_env } +let interpret_prog scope p : (V.value * scope) option = + try + let env = env_of_scope scope in + trace_depth := 0; + let vo = ref None in + let ve = ref V.Env.empty in + Scheduler.queue (fun () -> + interpret_block env p.it (Some ve) (fun v -> vo := Some v) + ); + Scheduler.run (); + let scope = { val_env = !ve; lib_env = scope.lib_env } in + match !vo with + | Some v -> Some (v, scope) + | None -> None + with exn -> + (* For debugging, should never happen. *) + print_exn exn; + None + let interpret_library scope (filename, p) : scope = let env = env_of_scope scope in diff --git a/src/interpret.mli b/src/interpret.mli index e7352bbe5ef..6f18c5d3859 100644 --- a/src/interpret.mli +++ b/src/interpret.mli @@ -11,7 +11,5 @@ val adjoin_scope : scope -> scope -> scope exception Trap of Source.region * string -val interpret_prog : scope -> Syntax.prog -> V.value option * scope +val interpret_prog : scope -> Syntax.prog -> (V.value * scope) option val interpret_library : scope -> Syntax.library -> scope - -val print_exn : exn -> unit diff --git a/src/interpret_ir.ml b/src/interpret_ir.ml index 95e4dfa4774..85f2d7b860a 100644 --- a/src/interpret_ir.ml +++ b/src/interpret_ir.ml @@ -653,8 +653,11 @@ let interpret_prog scope ((ds, exp), _flavor) : scope = let env = env_of_scope scope in trace_depth := 0; let ve = ref V.Env.empty in - Scheduler.queue (fun () -> - interpret_block env (Some ve) ds exp (fun v -> ()) - ); - Scheduler.run (); - !ve + try + Scheduler.queue (fun () -> + interpret_block env (Some ve) ds exp (fun v -> ()) + ); + Scheduler.run (); + !ve + with exn -> print_exn exn; !ve + diff --git a/src/interpret_ir.mli b/src/interpret_ir.mli index e9d969d65b8..4dea591faaa 100644 --- a/src/interpret_ir.mli +++ b/src/interpret_ir.mli @@ -9,5 +9,3 @@ val adjoin_scope : scope -> scope -> scope exception Trap of Source.region * string val interpret_prog : scope -> Ir.prog -> scope - -val print_exn : exn -> unit diff --git a/src/main.ml b/src/main.ml index 66ac27479b8..b5ae9b634da 100644 --- a/src/main.ml +++ b/src/main.ml @@ -105,9 +105,6 @@ let () = (useful for debugging infinite loops) *) Printexc.record_backtrace true; - try - Arg.parse argspec add_arg usage; - if !mode = Default then mode := (if !args = [] then Interact else Compile); - process_files !args - with exn -> - Interpret.print_exn exn + Arg.parse argspec add_arg usage; + if !mode = Default then mode := (if !args = [] then Interact else Compile); + process_files !args diff --git a/src/pipeline.ml b/src/pipeline.ml index 41bafd3e44d..bda5cdb204d 100644 --- a/src/pipeline.ml +++ b/src/pipeline.ml @@ -224,15 +224,8 @@ let load_decl parse_one senv : load_decl_result = (* Interpretation (Source) *) let interpret_prog denv prog : (Value.value * Interpret.scope) option = - try - phase "Interpreting" prog.Source.note; - match Interpret.interpret_prog denv prog with - | None, _ -> None - | Some v, scope -> Some (v, scope) - with exn -> - (* For debugging, should never happen. *) - Interpret.print_exn exn; - None + phase "Interpreting" prog.Source.note; + Interpret.interpret_prog denv prog let rec interpret_libraries denv libraries : Interpret.scope = match libraries with diff --git a/test/fail/ok/ast81-clash.tc.ok b/test/fail/ok/ast81-clash.tc.ok index a44cd01d45f..d24e7265597 100644 --- a/test/fail/ok/ast81-clash.tc.ok +++ b/test/fail/ok/ast81-clash.tc.ok @@ -1,63 +1 @@ -prelude:189.1-214.2: internal error, Env.Make(X).Clash("x") - -Last environment: -@new_async = func -@text_of_Bool = func -@text_of_Int = func -@text_of_Nat = func -@text_of_Text = func -@text_of_array = func -@text_of_array_mut = func -@text_of_option = func -@text_of_variant = func -Array_init = func -Array_tabulate = func -abs = func -btstWord16 = func -btstWord32 = func -btstWord64 = func -btstWord8 = func -charToText = func -charToWord32 = func -clzWord16 = func -clzWord32 = func -clzWord64 = func -clzWord8 = func -ctzWord16 = func -ctzWord32 = func -ctzWord64 = func -ctzWord8 = func -decodeUTF8 = func -hashInt = func -ignore = func -intToWord16 = func -intToWord32 = func -intToWord64 = func -intToWord8 = func -natToWord16 = func -natToWord32 = func -natToWord64 = func -natToWord8 = func -popcntWord16 = func -popcntWord32 = func -popcntWord64 = func -popcntWord8 = func -print = func -printChar = func -printInt = func -range = func -revrange = func -shrsWord16 = func -shrsWord32 = func -shrsWord64 = func -shrsWord8 = func -word16ToInt = func -word16ToNat = func -word32ToChar = func -word32ToInt = func -word32ToNat = func -word64ToInt = func -word64ToNat = func -word8ToInt = func -word8ToNat = func - +Fatal error: exception Env.Make(X).Clash("x")