mirror of
https://github.com/kanaka/mal.git
synced 2024-09-21 02:27:10 +03:00
8a19f60386
- Reorder README to have implementation list after "learning tool" bullet. - This also moves tests/ and libs/ into impls. It would be preferrable to have these directories at the top level. However, this causes difficulties with the wasm implementations which need pre-open directories and have trouble with paths starting with "../../". So in lieu of that, symlink those directories to the top-level. - Move the run_argv_test.sh script into the tests directory for general hygiene.
68 lines
1.9 KiB
Ada
68 lines
1.9 KiB
Ada
with Ada.Characters.Latin_1;
|
|
|
|
with Printer;
|
|
with Types.Strings;
|
|
|
|
package body Err is
|
|
|
|
use Ada.Strings.Unbounded;
|
|
|
|
----------------------------------------------------------------------
|
|
|
|
procedure Add_Trace_Line (Action : in String;
|
|
Ast : in Types.T)
|
|
is
|
|
begin
|
|
Append (Trace, " in ");
|
|
Append (Trace, Action);
|
|
Append (Trace, ": ");
|
|
Printer.Pr_Str (Trace, Ast);
|
|
Append (Trace, Ada.Characters.Latin_1.LF);
|
|
end Add_Trace_Line;
|
|
|
|
procedure Check (Condition : in Boolean;
|
|
Message : in String)
|
|
is
|
|
begin
|
|
if not Condition then
|
|
Raise_With (Message);
|
|
end if;
|
|
end Check;
|
|
|
|
procedure Raise_In_Mal (E : in Ada.Exceptions.Exception_Occurrence) is
|
|
Message : String renames Ada.Exceptions.Exception_Information (E);
|
|
procedure Process (S : in String);
|
|
procedure Process (S : in String) is
|
|
begin
|
|
Append (Trace, S);
|
|
end Process;
|
|
begin
|
|
Data := (Types.Kind_String, Types.Strings.Alloc (Message));
|
|
Set_Unbounded_String (Trace, "Uncaught exception: ");
|
|
Data.Str.all.Query_Element (Process'Access);
|
|
raise Error;
|
|
end Raise_In_Mal;
|
|
|
|
procedure Raise_With (Message : in String) is
|
|
begin
|
|
Data := (Types.Kind_String, Types.Strings.Alloc (Message));
|
|
Set_Unbounded_String (Trace, "Uncaught exception: ");
|
|
Append (Trace, Message);
|
|
Append (Trace, Ada.Characters.Latin_1.LF);
|
|
raise Error;
|
|
end Raise_With;
|
|
|
|
function Throw (Args : in Types.T_Array) return Types.T is
|
|
begin
|
|
Check (Args'Length = 1, "expected 1 parameter");
|
|
Data := Args (Args'First);
|
|
Set_Unbounded_String (Trace, "Uncaught exception: ");
|
|
Printer.Pr_Str (Trace, Data);
|
|
Append (Trace, Ada.Characters.Latin_1.LF);
|
|
-- A raise value is equivalent to a raise statement, but
|
|
-- silents a compiler warning.
|
|
return raise Error;
|
|
end Throw;
|
|
|
|
end Err;
|