diff --git a/GNUmakefile b/GNUmakefile index 82459a8c..6ef195b3 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -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 index 00000000..6ec9d414 --- /dev/null +++ b/module/mes/catch.mes @@ -0,0 +1,43 @@ +;;; -*-scheme-*- + +;;; Mes --- Maxwell Equations of Software +;;; Copyright © 2016 Jan Nieuwenhuizen +;;; +;;; 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 . + +(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 index 00000000..ae3f0780 --- /dev/null +++ b/tests/catch.test @@ -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 +;;; +;;; 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 . + +(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) +