From e0ca5b6fd7381323cb9737f0ca6bfec9ede3eb7d Mon Sep 17 00:00:00 2001
From: Tim Vaughan <tgvaughan@gmail.com>
Date: Sat, 5 Nov 2016 12:51:46 +1300
Subject: [PATCH] Added (error)

---
 scheme-primitives.4th | 16 ++++++++++++++++
 scheme.4th            | 10 +++-------
 2 files changed, 19 insertions(+), 7 deletions(-)

diff --git a/scheme-primitives.4th b/scheme-primitives.4th
index b71b98d..fdb28d3 100644
--- a/scheme-primitives.4th
+++ b/scheme-primitives.4th
@@ -440,3 +440,19 @@ defer display
     
     apply
 ; make-primitive apply 
+
+( ==== Error System ==== )
+
+:noname ( args -- result )
+    bold fg red
+
+    nil? if
+        ." Error."
+    else
+        ." Error: " car display
+    then
+
+    reset-term
+
+    recoverable-exception throw
+; make-primitive error
diff --git a/scheme.4th b/scheme.4th
index f2d7375..bacd8e0 100644
--- a/scheme.4th
+++ b/scheme.4th
@@ -52,7 +52,7 @@ variable nextexception
 make-exception recoverable-exception
 make-exception unrecoverable-exception
 
-: display-warning ( addr count -- )
+: display-exception-msg ( addr count -- )
     bold fg red
     ." Exception: "
     type
@@ -65,7 +65,7 @@ make-exception unrecoverable-exception
 
     [compile] if
         ['] -rot ,
-        ['] display-warning ,
+        ['] display-exception-msg ,
     [compile] then
 
     ['] throw ,
@@ -1709,11 +1709,7 @@ variable gc-stack-depth
             recoverable-exception of false endof
             unrecoverable-exception of true endof
 
-            \ Rethrow anything else:
-            throw
-
-            \ If we're still here, loop again
-            false
+            throw false
         endcase
     until
 ;
-- 
2.20.1