From: visor <visor@users.sourceforge.jp>
Date: Tue, 27 Sep 2011 13:48:01 +0000 (+0900)
Subject: on-error parameter of progn function.
X-Git-Url: http://git.osdn.net/view?a=commitdiff_plain;h=e138faa00c96cc6e68ad499354a87dbdbafb2f3f;p=hmh%2Fhhml.git

on-error parameter of progn function.
---

diff --git a/modules/ml-struct.cc b/modules/ml-struct.cc
index b0eaa47..17b3e7e 100644
--- a/modules/ml-struct.cc
+++ b/modules/ml-struct.cc
@@ -149,8 +149,31 @@ MNode*  ml_cond (MNode* cell, MlEnv* mlenv) {
 MNode*  ml_progn (MNode* cell, MlEnv* mlenv) {
     MNode*  arg = cell->cdr ();
     MNodePtr  ans;
+    MNodePtr  errfn;
+    std::vector<MNode*>  keywords;
+    MNode*  rest;
+    static paramList  kwlist[] = {
+	{CharConst ("on-error"), false},
+	{NULL, 0, 0}
+    };
 
-    ans =  progn (arg, mlenv);
+    setParams (arg, 0, NULL, kwlist, &keywords, &rest);
+    if (keywords[0])
+	errfn = eval (keywords[0], mlenv);
+
+    try {
+	ans =  progn (rest, mlenv);
+    } catch (ustring& msg) {
+	if (errfn ()) {
+	    MNodePtr  v;
+	    MNodePtr  ag;
+	    ag = new MNode;
+	    ag ()->set_car (mlenv->currentCell ());
+	    v = execDefun (mlenv, errfn (), ag (), uEmpty);
+	} else {
+	    throw (msg);
+	}
+    }
     if (mlenv->breaksym ()
 	&& (mlenv->breaksym ()->isNil () || eq (mlenv->breaksym (), cell->car ()))) {
 	mlenv->setBreaksym (NULL);