Add: sols 4.35 -> 4.49

Author: codybartfast

src/ambeval.c

@@ -26,6 +26,8 @@ static obj evalstr(char *e, obj env)
 	return eceval(readp(openin_string(e)), env);
 }
 
+#include "output.h"
+
 static void init(obj execution_environment)
 {
 	ambenv = extend_environment(emptylst, emptylst, execution_environment,
@@ -267,10 +269,10 @@ obj ambeval2(obj exp, obj exenv)
 		make_procedure(list2(value, fail_s), list1(value), emptylst);
 	obj fail = make_procedure(
 		emptylst,
-		list2(list2(of_identifier("display"),
-			    of_string(
-				    "ERROR: (AMBEVAL) unexpected call to amb2's fail")),
-		      failed),
+		list1( // list2(of_identifier("display"),
+			//    of_string(
+			//	    "ERROR: (AMBEVAL) unexpected call to amb2's fail")),
+			list2(quote, amb_fail)),
 		emptylst);
 	return ambeval(exp, exenv, succeed, fail);
 }

src/custom.c

@@ -238,12 +238,19 @@ static obj add_extras(int ex, obj env)
 			"        ((eq? item (car x)) x)"
 			"        (else (memq item (cdr x)))))",
 			env);
+		evalstr("(define (member item x)"
+			"  (cond ((null? x) false)"
+			"        ((equal? item (car x)) x)"
+			"        (else (member item (cdr x)))))",
+			env);
 	}
 	if (ex >= 254) {
 		define_variable(of_identifier("equal?"),
 				of_function(is_equal_p), env);
 	}
 	if (ex >= 256) {
+		define_variable(of_identifier("integer?"),
+				of_function(is_integer_p), env);
 		define_variable(of_identifier("number?"),
 				of_function(is_number_p), env);
 		define_variable(of_identifier("symbol?"),
@@ -303,6 +310,15 @@ static obj add_extras(int ex, obj env)
 			env);
 		evalstr("(define driver-loop repl)", env);
 	}
+	if (ex >= 435) {
+		evalstr("(define (require p) (if (not p) (amb)))", env);
+		evalstr("(define (distinct? items)"
+			"  (cond ((null? items) true)"
+			"        ((null? (cdr items)) true)"
+			"        ((member (car items) (cdr items)) false)"
+			"        (else (distinct? (cdr items)))))",
+			env);
+	}
 	return unspecified;
 }
 

src/eval.c

@@ -6,12 +6,12 @@
 
 obj (*eval)(obj, obj) = eceval;
 
-void use_ambeval(void)
+void use_aneval(void)
 {
-	eval = ambeval2;
+	eval = aneval;
 }
 
-void use_aneval(void)
+void use_ambeval(void)
 {
-	eval = aneval;
+	eval = ambeval2;
 }

src/obj.c

@@ -239,6 +239,7 @@ 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");
@@ -250,7 +251,6 @@ const obj cons_stream = SYMBOL("cons-stream");
 SYMBOL_VAR(define)
 SYMBOL_VAR(delay)
 const obj else_s = SYMBOL("else");
-SYMBOL_VAR(failed)
 const obj if_s = SYMBOL("if");
 SYMBOL_VAR(let)
 SYMBOL_VAR(letrec)

src/obj.h

@@ -120,6 +120,7 @@ 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;

src/primproc.c

@@ -697,6 +697,30 @@ obj is_equal_p(const obj args)
 	return is_equal(car(args), cadr(args)) ? true_o : false_o;
 }
 
+obj is_integer_p(obj args)
+{
+	obj chk;
+	Floating f;
+	Integer i;
+
+	if (is_err(chk = chkarity("integer?", 1, args)))
+		return chk;
+	obj n = car(args);
+	if (!is_number(n))
+		return false_o;
+	switch (subtype(n)) {
+	case NUMBER_INTEGER:
+		return true_o;
+	case NUMBER_FLOATING:
+		f = to_floating(n);
+		i = (Integer)f;
+		return (f == i) ? true_o : false_o;
+	default:
+		return error_internal(AREA, "Unknown number type: %d",
+				      subtype(n));
+	}
+}
+
 obj is_number_p(obj args)
 {
 	obj chk;

src/primproc.h

@@ -52,6 +52,7 @@ obj is_eq_p(const obj);
 bool is_equal(const obj, const obj);
 obj is_equal_p(const obj);
 
+obj is_integer_p(obj);
 obj is_number_p(obj);
 obj is_string_p(obj);
 obj is_symbol_p(obj);

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

@@ -0,0 +1,14 @@
+(%ambeval)
+
+(define (a-pythagorean-triple-between low high)
+  (let ((i (an-integer-between low high)))
+    (let ((j (an-integer-between i high)))
+      (let ((k (an-integer-between j high)))
+        (require (= (+ (* i i) (* j j)) (* k k)))
+        (list i j k)))))
+
+(define (an-integer-between low high)
+  (require (<= low high))
+  (amb low (an-integer-between (+ low 1) high)))
+
+(a-pythagorean-triple-between 1 50)

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

@@ -0,0 +1,17 @@
+(%ambeval)
+
+(define (a-pythagorean-triple)
+  (let ((k (an-integer-starting-from 1)))
+    (let ((j (an-integer-between 1 k)))
+      (let ((i (an-integer-between 1 j)))
+        (require (= (+ (* i i) (* j j)) (* k k)))
+        (list i j k)))))
+
+(define (an-integer-starting-from start)
+  (amb start (an-integer-starting-from (+ start 1))))
+
+(define (an-integer-between low high)
+  (require (<= low high))
+  (amb low (an-integer-between (+ low 1) high)))
+
+(a-pythagorean-triple)

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

@@ -0,0 +1,17 @@
+(%ambeval)
+
+(define (a-pythagorean-triple-between low high)
+  (let ((i (an-integer-between low high))
+        (hsq (* high high)))
+    (let ((j (an-integer-between i high)))
+      (let ((ksq (+ (* i i) (* j j))))
+        (require (>= hsq ksq))
+        (let ((k (sqrt ksq)))
+          (require (integer? k))
+          (list i j k))))))
+
+(define (an-integer-between low high)
+  (require (<= low high))
+  (amb low (an-integer-between (+ low 1) high)))
+
+(a-pythagorean-triple-between 1 50)