Minimal syntactic exception support.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sat, 17 Dec 2016 21:21:46 +0000 (22:21 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sat, 17 Dec 2016 21:21:46 +0000 (22:21 +0100)
* module/mes/catch.mes: New file.
* tests/catch.test: New file.
* GNUmakefile (TEST): Add it.

GNUmakefile
module/mes/catch.mes [new file with mode: 0644]
tests/catch.test [new file with mode: 0755]

index 82459a8c0430166838ccbc9469a1c735c38a39f4..6ef195b36bfa227c4708be15a679f3eb984730b4 100644 (file)
@@ -61,6 +61,7 @@ TESTS:=\
  tests/cwv.test\
  tests/optargs.test\
  tests/fluids.test\
+ tests/catch.test\
  tests/psyntax.test\
  tests/let-syntax.test\
  tests/record.test\
diff --git a/module/mes/catch.mes b/module/mes/catch.mes
new file mode 100644 (file)
index 0000000..6ec9d41
--- /dev/null
@@ -0,0 +1,43 @@
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+(mes-use-module (mes let))
+
+(define (make-exception key . args)
+  (cons* '*exception* key args))
+
+(define (exception? o)
+  (and (pair? o) (eq? (car o) '*exception*)))
+
+(define (exception-key o)
+  (if (exception? o) (cadr o)))
+
+(define (exception-args o)
+  (if (exception? o) (cddr o)))
+
+(define (catch key thunk handler)
+  (let ((result (thunk)))
+    (if (and (exception? result)
+             (or (eq? key (exception-key result))
+                 (eq? key #t)))
+        (handler (exception-key result) (exception-args result))
+        result)))
+
+(define throw make-exception)
diff --git a/tests/catch.test b/tests/catch.test
new file mode 100755 (executable)
index 0000000..ae3f078
--- /dev/null
@@ -0,0 +1,47 @@
+#! /bin/sh
+# -*-scheme-*-
+echo ' ()' | cat $(dirname $0)/../module/mes/base-0.mes $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@"
+#paredit:||
+exit $?
+!#
+
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+(mes-use-module (mes catch))
+(mes-use-module (mes test))
+
+(pass-if "first dummy" #t)
+(pass-if-not "second dummy" #f)
+
+(when (not guile?)
+  (pass-if "throw"
+    (exception? (make-exception #t))))
+(pass-if "catch"
+  (catch #t
+    (lambda ()
+      (throw #t)
+      ;;#f
+      )
+    (lambda (key . args)
+      #t)))
+
+(result 'report)
+