fix ground? tests work now

donaldsonjw · Oct 24, 2014 · 1b9df04 · 1b9df04
1 parent a35f46f
commit 1b9df04
Show file tree

Hide file tree

Showing 2 changed files with 16 additions and 8 deletions.
diff --git a/src/Llib/mk-ext.scm b/src/Llib/mk-ext.scm
@@ -16,7 +16,7 @@
 	   eq-caro
 	   memo
 	   rembero
-	   appendo
+	   appendᵒ
 	   unwrapo
 	   swappendo
 	   flatteno
@@ -123,13 +123,13 @@
 			     (conso a res out)))))))
 
 
-(define appendo (lambda (l s out)
+(define appendᵒ (lambda (l s out)
 		   (conde ((nullo l) (== s out))
 		      (else
 		       (fresh (a d res)
 			  (conso a d l)
 			  (conso a res out)
-			  (appendo d s res))))))
+			  (appendᵒ d s res))))))
 
 
 (define swappendo (lambda (l s out)
@@ -155,7 +155,7 @@
 	  (conso a d s)
 	  (flatteno a res-a)
 	  (flatteno d res-d)
-	  (appendo res-a res-d out)))
+	  (appendᵒ res-a res-d out)))
       (else
        (conso s '() out)))))
 
@@ -166,7 +166,7 @@
 			   (fresh (a d res-a res-d)
 			      (flattenrevo a res-a)
 			      (flattenrevo d res-d)
-			      (appendo res-a res-d out))))))
+			      (appendᵒ res-a res-d out))))))
 
 (define anyo (lambda (g)
 		(conde (g succeed)

diff --git a/src/Llib/mk.scm b/src/Llib/mk.scm
@@ -288,9 +288,17 @@
            (anyvar? (cdr u) r)))
       (else (var? (walk u r))))))
 
-(define (ground? u)
-  (lambda (S)
-    (not (anyvar? u S))))
+; (define (ground? u)
+;   (lambda (S)
+;     (not (anyvar? u S))))
+
+(define ground?
+  (lambda (v)
+    (cond
+      ((var? v) #f)
+      ((pair? v)
+       (and (ground? (car v)) (ground? (cdr v))))
+      (else #t))))
 
 (define anyeigen? 
   (lambda (u r)