Add: amb

Author: codybartfast

src/ambeval.c

@@ -11,6 +11,16 @@
 #include "parser.h"
 #include "storage.h"
 
+static obj is_amb_p(obj args)
+{
+	return is_amb(car(args)) ? true_o : false_o;
+}
+
+static obj amb_choices_p(obj args)
+{
+	return cdar(args);
+}
+
 static obj evalstr(char *e, obj env)
 {
 	return eceval(readp(openin_string(e)), env);
@@ -23,6 +33,10 @@ static void init(obj execution_environment)
 
 	add_primprocs(ambenv);
 
+	define_variable(of_identifier("amb?"), of_function(is_amb_p), ambenv);
+	define_variable(of_identifier("amb-choices"),
+			of_function(amb_choices_p), ambenv);
+
 	evalstr("(define (map proc . arglists)"
 		"  (define (smap proc items)"
 		"    (define (iter items mapped)"
@@ -42,7 +56,6 @@ static void init(obj execution_environment)
 		ambenv);
 
 	evalstr("(define (analyze exp)"
-		// "  (newline)(display \"Exp:\")(display exp)(newline)"
 		"  (cond ((self-evaluating? exp) "
 		"         (analyze-self-evaluating exp))"
 		"        ((quoted? exp) (analyze-quoted exp))"
@@ -61,6 +74,7 @@ static void init(obj execution_environment)
 		"        ((delay? exp) (analyze (delay->lambda exp)))"
 		"        ((cons-stream? exp) (analyze (cons-stream->cons exp)))"
 		"        ((time? exp) (analyze-time exp))"
+		"        ((amb? exp) (analyze-amb exp))"
 		"        ((apply? exp) (analyze-apply exp))"
 		"        ((application? exp) (analyze-application exp))"
 		"        (else"
@@ -205,6 +219,18 @@ static void init(obj execution_environment)
 		"    (lambda (env succeed fail)"
 		"      (time (proc env succeed fail)))))",
 		ambenv);
+	evalstr("(define (analyze-amb exp)"
+		"  (let ((cprocs (map analyze (amb-choices exp))))"
+		"    (lambda (env succeed fail)"
+		"      (define (try-next choices)"
+		"        (if (null? choices)"
+		"            (fail)"
+		"            ((car choices) env"
+		"                           succeed"
+		"                           (lambda ()"
+		"                             (try-next (cdr choices))))))"
+		"      (try-next cprocs))))",
+		ambenv);
 }
 
 static obj ambeval(obj exp, obj exenv, obj succeed, obj fail)

src/bitmap.c

@@ -26,14 +26,6 @@
 
 #define AREA "BITMAP"
 
-#define OBJ_4(TYPE, STYPE, VTYPE, VALUE)                                       \
-	{                                                                      \
-		TYPE, STYPE,                                                   \
-		{                                                              \
-			.VTYPE = VALUE                                         \
-		}                                                              \
-	}
-
 extern unsigned char hamiltondata[];
 extern unsigned char patterndata[];
 extern unsigned char sussmandata[];

src/error.c

@@ -7,14 +7,6 @@
 
 #define AREA "ERROR"
 
-#define OBJ_4(TYPE, STYPE, VTYPE, VALUE)                                       \
-	{                                                                      \
-		TYPE, STYPE,                                                   \
-		{                                                              \
-			.VTYPE = VALUE                                         \
-		}                                                              \
-	}
-
 enum errsbtyp {
 	ERROR_MEMORY = 1,
 	ERROR_ARGUMENT_TYPE, // 2

src/eval.c

@@ -4,7 +4,7 @@
 #include "ambeval.h"
 #include "aneval.h"
 
-obj (*eval)(obj, obj) = ambeval2;
+obj (*eval)(obj, obj) = eceval;
 
 void use_ambeval(void)
 {

src/mceval.c

@@ -559,3 +559,8 @@ obj cons_stream_to_cons(obj exp)
 		     list2(memo_proc,
 			   delay_to_lambda(list2(delay, caddr(exp)))));
 }
+
+bool is_amb(obj exp)
+{
+	return is_tagged_list(exp, amb);
+}

src/mceval.h

@@ -65,4 +65,6 @@ obj delay_to_lambda(obj exp);
 bool is_cons_stream(obj exp);
 obj cons_stream_to_cons(obj exp);
 
+bool is_amb(obj exp);
+
 #endif

src/obj.c

@@ -5,14 +5,6 @@
 #include "error.h"
 #include "storage.h"
 
-#define OBJ_4(TYPE, STYPE, VTYPE, VALUE)                                       \
-	{                                                                      \
-		TYPE, STYPE,                                                   \
-		{                                                              \
-			.VTYPE = VALUE                                         \
-		}                                                              \
-	}
-
 #define OBJ_2(TYPE, STYPE)                                                     \
 	{                                                                      \
 		TYPE, STYPE,                                                   \
@@ -246,6 +238,7 @@ obj (*to_function(obj dat))(obj)
 
 // KEYWORDS
 
+SYMBOL_VAR(amb)
 const obj and_s = SYMBOL("and");
 SYMBOL_VAR(uapply)
 const obj __ppapply = SYMBOL("__%%apply");

src/obj.h

@@ -5,6 +5,14 @@
 #include <stdbool.h>
 #include <inttypes.h>
 
+#define OBJ_4(TYPE, STYPE, VTYPE, VALUE)                                       \
+	{                                                                      \
+		TYPE, STYPE,                                                   \
+		{                                                              \
+			.VTYPE = VALUE                                         \
+		}                                                              \
+	}
+
 enum type {
 	TYPE_NOT_SET = 0,
 	TYPE_SYMBOL, // 1
@@ -111,6 +119,7 @@ obj (*to_function(obj dat))(obj);
 
 // KEYWORDS
 
+extern const obj amb;
 extern const obj and_s;
 extern const obj uapply;
 extern const obj __ppapply;