Permalink
Browse files

Replaced the built-in "standard error" exception instance.

In a similar way that the function ref creates new ref instances, the built-in
function exception creates new exception instances. The only difference is that
an instance created with this function writes out a nicer runtime error when an
uncaught raise escapes to the toplevel.

Along the same lines, I created four exception instances to represent division
by zero, invalid arguments, assertion faults, and failure errors. Beforehand,
they were all triggered by the same instance, only with different arguments.
Now, they behave as usual exceptions and one does not need a special handler to
handle them.
  • Loading branch information...
1 parent 27f7b6f commit adad537c66b9ac47acad3a054ea54eb83c925b8f @matijapretnar matijapretnar committed Mar 18, 2012
View
@@ -18,29 +18,19 @@ end ;;
let raise e p = match (e#raise p) with ;;
-type runtime_error =
- | DivisionByZero
- | InvalidArgument of string
- | AssertionFault
- | FailWith of string ;;
+external exception : string -> 'a exception = "exception" ;;
-external err : runtime_error exception = "err" ;;
+let divisionByZero = exception "division by zero" ;;
-let runtime_error e = raise err e ;;
+let invalidArgument = exception "invalid argument" ;;
-let runtime_handle e v = handler
- | err#raise e' _ ->
- if e' = e then v else runtime_error e' ;;
+let failure = exception "failure" ;;
-let divisionByZero = runtime_handle DivisionByZero ;;
+let failwith msg = raise failure msg ;;
-let invalidArgument msg = runtime_handle (InvalidArgument msg) ;;
+let assertionFault = exception "assertion fault" ;;
-let failwith msg = runtime_error (FailWith msg) ;;
-
-let failWith msg = runtime_handle (FailWith msg) ;;
-
-let assert b = if b then () else runtime_error AssertionFault ;;
+let assert b = if b then () else raise assertionFault () ;;
external ( ~- ) : int -> int = "~-"
@@ -54,7 +44,7 @@ external ( - ) : int -> int -> int = "-"
external ( % ) : int -> int -> int = "%"
let (%) m n = match n with
- | 0 -> runtime_error DivisionByZero
+ | 0 -> raise divisionByZero ()
| n -> (%) m n
external ( ~-. ) : float -> float = "~-."
@@ -68,7 +58,7 @@ external ( -. ) : float -> float -> float = "-."
external ( /. ) : float -> float -> float = "/."
external ( / ) : int -> int -> int = "/"
let ( / ) m n = match n with
- | 0 -> runtime_error DivisionByZero
+ | 0 -> raise divisionByZero ()
| n -> (/) m n
external float : int -> float = "float"
@@ -171,7 +161,7 @@ let rec zip xs ys =
match (xs, ys) with
| ([], []) -> []
| (x :: xs, y :: ys) -> (x, y) :: (zip xs ys)
- | (_, _) -> runtime_error (InvalidArgument "zip: length mismatch")
+ | (_, _) -> raise invalidArgument "zip: length mismatch"
let reverse =
let rec reverse_acc acc = function
@@ -190,11 +180,11 @@ let rec length = function
| x :: xs -> length xs + 1
let head = function
- | [] -> runtime_error (InvalidArgument "head: empty list")
+ | [] -> raise invalidArgument "head: empty list"
| x :: _ -> x
let rec tail = function
- | [] -> runtime_error (InvalidArgument "tail: empty list")
+ | [] -> raise invalidArgument "tail: empty list"
| x :: xs -> xs
let abs x = if x < 0 then -x else x
View
@@ -54,10 +54,12 @@ let symbols = [
let str = read_line () in
(V.from_str str, s)));
])));
- ("err", V.fresh_instance (Some "standard error") (Some (ref V.from_unit, [
- ("raise", coop (fun v s ->
- let str = Print.to_string "%t" (Print.value v) in
- Error.exc "%s" str))])));
+
+ ("exception", V.from_fun (fun v ->
+ let desc = V.to_str v in V.Value (V.fresh_instance (Some desc) (Some (ref V.from_unit, [
+ ("raise", coop (fun v s ->
+ let str = Print.to_string "%s %t." desc (Print.value v) in
+ Error.exc "%s" str))])))));
("rnd", (Random.self_init () ;
V.fresh_instance (Some "random number generator") (Some (ref V.from_unit, [
@@ -1,5 +1,5 @@
val local_store : 'a ref -> 'a -> 'b => 'b = <fun>
val put : '_a list -> unit = <fun>
val get : unit -> '_a list = <fun>
-val s : '_a list ref = <instance #3>
+val s : '_a list ref = <instance #6>
Typing error (file "./errors/polymorphic_ref.eff", line 16, char 10): This expression has type string but it should have type int.
@@ -1,3 +1,3 @@
-val x : '_a ref = <instance #3>
+val x : '_a ref = <instance #6>
val h : unit => unit = <handler>
- : '_a ref
@@ -1,4 +1,4 @@
-val c : '_a cow = <instance #3>
+val c : '_a cow = <instance #6>
- : '_a cow
val milk : 'a => 'a = <handler>
- : '_a cow
View
@@ -1,4 +1,4 @@
-val x : int store = <instance #3>
+val x : int store = <instance #6>
val a : int = 5
- : unit = ()
val b : int = 17
View
@@ -1,4 +1,4 @@
-val x : int ref = <instance #3>
-val y : int ref = <instance #4>
-val z : int ref ref = <instance #5>
+val x : int ref = <instance #6>
+val y : int ref = <instance #7>
+val z : int ref ref = <instance #8>
- : int * int = (5, 39)
View
@@ -14,22 +14,22 @@ let whatis_std = std ;;
let whatis_raise = raise ;;
-let runtime_errors = [DivisionByZero; InvalidArgument "foo"; AssertionFault; FailWith "bar"] ;;
+let whatis_exception = exception ;;
-let whatis_err = err ;;
+let whatis_divisionByZero = divisionByZero ;;
+let whatis_invalidArgument = invalidArgument ;;
+let whatis_assertionFault = assertionFault ;;
+let whatis_failure = failure ;;
-let whatis_runtime_error = runtime_error ;;
-
-let what_is_runtime_handle = runtime_handle ;;
-
-let test_divisionByZero = with divisionByZero "foo" handle let x = 1 / 0 in "bar" ;;
+let test_divisionByZero =
+ handle let x = 1 / 0 in "bar" with divisionByZero#raise _ _ -> "foo"
let test_invalidArgument =
- with invalidArgument "foo" "No he was not" handle "invalidArgument was here" ;;
+ handle "invalidArgument was here" with invalidArgument#raise "foo" _ -> "No he was not" ;;
check (failwith "They say it's all about flirting.") ;;
-let test_failWith = with failWith "bar" 42 handle failwith "bar" ;;
+let test_failure = handle failwith "bar" with failure#raise "bar" _ -> 42 ;;
assert ("a" = "a") ;;
@@ -175,7 +175,7 @@ let test_snd = (snd ("foo", 4)) ;;
check (std#read ()) ;;
-check (err#raise (FailWith "The cows are home.")) ;;
+check (failwith "The cows are home.") ;;
check (rnd#int 42) ;;
@@ -5,18 +5,16 @@ val test_equal_number : bool = true
val test_equal_fun : bool = false
val whatis_std : channel = <standard I/O>
val whatis_raise : 'a exception -> 'a -> 'b = <fun>
-val runtime_errors : runtime_error list = [DivisionByZero;
- InvalidArgument "foo";
- AssertionFault; FailWith "bar"]
-val whatis_err : runtime_error exception = <standard error>
-val whatis_runtime_error : runtime_error -> 'a = <fun>
-val what_is_runtime_handle : runtime_error -> 'a -> 'a => 'a = <fun>
+val whatis_exception : string -> 'a exception = <fun>
+val whatis_divisionByZero : unit exception = <division by zero>
+val whatis_invalidArgument : string exception = <invalid argument>
+val whatis_assertionFault : unit exception = <assertion fault>
+val whatis_failure : '_a exception = <failure>
val test_divisionByZero : string = "foo"
val test_invalidArgument : string = "invalidArgument was here"
-Check (file "./test_pervasives.eff", line 30, char 1): Operation <standard error>.raise
-FailWith "They say it's all about flirting."
+Check (file "./test_pervasives.eff", line 30, char 1): Operation <failure>.raise "They say it's all about flirting."
- : unit = ()
-val test_failWith : int = 42
+val test_failure : int = 42
- : unit = ()
val tilda_minus : int = -1
val tilda_minus_dot2 : float = -3.14159
@@ -28,24 +26,24 @@ val test_minus : int = 19
val test_minus_tilda_minus : int = 65
val test_mod1 : int = 2
val test_mod2 : int = 0
-Check (file "./test_pervasives.eff", line 56, char 1): Operation <standard error>.raise
-DivisionByZero
+Check (file "./test_pervasives.eff", line 56, char 1): Operation <division by zero>.raise
+()
- : unit = ()
-Check (file "./test_pervasives.eff", line 58, char 1): Operation <standard error>.raise
-DivisionByZero
+Check (file "./test_pervasives.eff", line 58, char 1): Operation <division by zero>.raise
+()
- : unit = ()
val test_plus_dot : float = 5.84
val test_times_dot : float = 8.478
val test_minus_dot : float = 0.44
val test_div_dot : float = 1.16296296296
val test_div_dot_zero : float = inf
val test_div : int = 33
-Check (file "./test_pervasives.eff", line 72, char 1): Operation <standard error>.raise
-DivisionByZero
+Check (file "./test_pervasives.eff", line 72, char 1): Operation <division by zero>.raise
+()
- : unit = ()
val test_zero_div : int = 0
-Check (file "./test_pervasives.eff", line 76, char 1): Operation <standard error>.raise
-DivisionByZero
+Check (file "./test_pervasives.eff", line 76, char 1): Operation <division by zero>.raise
+()
- : unit = ()
val test_carron : string = "cherrypie"
val test_to_string1 : string = "13"
@@ -77,19 +75,16 @@ val test_filter : int list = [4; 5]
val test_complement : int list = [1; 3; 5; 6]
val test_intersection : int list = [2; 4]
val test_zip1 : (int * string) list = [(1, "a"); (2, "b"); (3, "c")]
-Check (file "./test_pervasives.eff", line 134, char 1): Operation <standard error>.raise
-InvalidArgument "zip: length mismatch"
+Check (file "./test_pervasives.eff", line 134, char 1): Operation <invalid argument>.raise "zip: length mismatch"
- : unit = ()
val test_reverse : int list = [5; 4; 3; 2; 1]
val test_at : int list = [1; 2; 3; 4; 5; 6]
val test_length : int = 5
val test_head : int = 1
-Check (file "./test_pervasives.eff", line 144, char 1): Operation <standard error>.raise
-InvalidArgument "head: empty list"
+Check (file "./test_pervasives.eff", line 144, char 1): Operation <invalid argument>.raise "head: empty list"
- : unit = ()
val test_tail : int list = [2; 3; 4]
-Check (file "./test_pervasives.eff", line 148, char 1): Operation <standard error>.raise
-InvalidArgument "tail: empty list"
+Check (file "./test_pervasives.eff", line 148, char 1): Operation <invalid argument>.raise "tail: empty list"
- : unit = ()
val test_abs : int * int * int = (5, 5, 5)
val test_min : int = 1
@@ -107,8 +102,7 @@ Does this work?- : unit = ()
Check (file "./test_pervasives.eff", line 176, char 1): Operation <standard I/O>.read
()
- : unit = ()
-Check (file "./test_pervasives.eff", line 178, char 1): Operation <standard error>.raise
-FailWith "The cows are home."
+Check (file "./test_pervasives.eff", line 178, char 1): Operation <failure>.raise "The cows are home."
- : unit = ()
Check (file "./test_pervasives.eff", line 180, char 1): Operation <random number generator>.int 42
- : unit = ()
View
@@ -14,7 +14,7 @@
- : '_a dog
- : int dog
- : '_a list dog
-val fifi : '_a dog = <instance #3>
+val fifi : '_a dog = <instance #6>
- : '_a -> string
- : string
- : string

0 comments on commit adad537

Please sign in to comment.