From f8923416fee10225a2475897508744013c0b4497 Mon Sep 17 00:00:00 2001
From: Masaya Tojo <masaya@tojo.tokyo>
Date: Wed, 15 Sep 2021 18:00:25 +0900
Subject: Return (system-check system) when evaluate define-system.

---
 configure.ac |  2 +-
 guix.scm     |  2 +-
 vikalpa.scm  | 26 ++++++++++++++------------
 3 files changed, 16 insertions(+), 14 deletions(-)

diff --git a/configure.ac b/configure.ac
index b2e8cda..b9ba959 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,4 +1,4 @@
-AC_INIT([vikalpa], [0.2.0])
+AC_INIT([vikalpa], [0.2.1])
 AC_CONFIG_SRCDIR([vikalpa.scm])
 AC_CONFIG_AUX_DIR([build-aux])
 AM_INIT_AUTOMAKE([-Wall -Werror foreign])
diff --git a/guix.scm b/guix.scm
index 7ec417c..9270da1 100644
--- a/guix.scm
+++ b/guix.scm
@@ -29,7 +29,7 @@
 (define guile-vikalpa
   (package
     (name "guile-vikalpa")
-    (version "0.2.0")
+    (version "0.2.1")
     (source (string-append (getcwd) "/vikalpa-" version ".tar.gz"))
     (build-system gnu-build-system)
     (native-inputs
diff --git a/vikalpa.scm b/vikalpa.scm
index 3bc3374..8f6b02a 100644
--- a/vikalpa.scm
+++ b/vikalpa.scm
@@ -1166,18 +1166,20 @@
 (define-syntax define-system
   (syntax-rules ()
     ((_ name (system) expr ...)
-     (define (name)
-       (when (equal? 'name 'system)
-         (raise-exception
-          (make-exception
-           (make-exception-with-origin 'name)
-           (make-exception-with-message "recursive system")
-           (make-exception-with-irritants 'system))))
-       (parameterize
-           ((current-system (system)))
-         expr
-         ...
-         (current-system))))))
+     (begin
+       (define (name)
+         (when (equal? 'name 'system)
+           (raise-exception
+            (make-exception
+             (make-exception-with-origin 'name)
+             (make-exception-with-message "recursive system")
+             (make-exception-with-irritants 'system))))
+         (parameterize
+             ((current-system (system)))
+           expr
+           ...
+           (current-system)))
+       (system-check (name))))))
 
 (define (validate-function-name desc name)
   (define (err)
-- 
cgit v1.2.3