Add: amb-fail

Author: codybartfast

src/ambeval.c

@@ -21,6 +21,12 @@ static obj amb_choices_p(obj args)
 	return cdar(args);
 }
 
+static obj amb_fail_p(obj args)
+{
+	(void)args;
+	return error_amb(AREA, "No more choices");
+}
+
 static obj evalstr(char *e, obj env)
 {
 	return eceval(readp(openin_string(e)), env);
@@ -263,16 +269,13 @@ static obj ambeval(obj exp, obj exenv, obj succeed, obj fail)
 
 obj ambeval2(obj exp, obj exenv)
 {
+	define_variable(of_identifier("amb-fail"), of_function(amb_fail_p),
+			exenv);
 	obj value = of_identifier("value");
 	obj fail_s = of_identifier("fail");
 	obj succeed =
 		make_procedure(list2(value, fail_s), list1(value), emptylst);
 	obj fail = make_procedure(
-		emptylst,
-		list1( // list2(of_identifier("display"),
-			//    of_string(
-			//	    "ERROR: (AMBEVAL) unexpected call to amb2's fail")),
-			list2(quote, amb_fail)),
-		emptylst);
+		emptylst, list1(list1(of_identifier("amb-fail"))), exenv);
 	return ambeval(exp, exenv, succeed, fail);
 }

src/error.c

@@ -16,7 +16,8 @@ enum errsbtyp {
 	ERROR_IO, // 6
 	ERROR_PARSER, // 7
 	ERROR_UNBOUND_VARIABLE, // 8
-	ERROR_USER // 9
+	ERROR_AMB, // 9
+	ERROR_USER // 10
 };
 
 const char *errstr(obj dat)
@@ -127,6 +128,14 @@ obj error_unbound_variable(const char *area, const char *message, ...)
 			      message, args);
 }
 
+obj error_amb(const char *area, const char *message, ...)
+{
+	va_list args;
+	va_start(args, message);
+	return print_make_err(ERROR_AMB, "Amb failed", area,
+			      message, args);
+}
+
 obj user_error(obj args)
 {
 	obj dat;

src/error.h

@@ -18,6 +18,8 @@ obj error_io(const char *area, const char *message, ...);
 obj error_parser(const char *area, const char *message, ...);
 obj error_syntax(const char *area, const char *message, ...);
 obj error_unbound_variable(const char *area, const char *message, ...);
+obj error_amb(const char *area, const char *message, ...);
 
 obj user_error(const obj args);
+
 #endif

src/obj.c

@@ -239,7 +239,6 @@ obj (*to_function(obj dat))(obj)
 // KEYWORDS
 
 SYMBOL_VAR(amb)
-const obj amb_fail = SYMBOL("amb-fail");
 const obj and_s = SYMBOL("and");
 SYMBOL_VAR(uapply)
 const obj __ppapply = SYMBOL("__%%apply");

src/obj.h

@@ -120,7 +120,6 @@ obj (*to_function(obj dat))(obj);
 // KEYWORDS
 
 extern const obj amb;
-extern const obj amb_fail;
 extern const obj and_s;
 extern const obj uapply;
 extern const obj __ppapply;

test/code/ch4/ex4.41/ex4.41-cbf.sicp

@@ -1,3 +1,5 @@
+(%ambeval)
+
 (define (multiple-dwelling)
 
   (define floors (list 1 2 3 4 5))
@@ -50,4 +52,4 @@
 
   (enum-fletchers floors))
 
-(time (multiple-dwelling))
+(time (multiple-dwelling))