we are kinda back

loam/data.lisp

@@ -7,7 +7,7 @@
 (def-suite* data-suite :in loam:master-suite)
 
 ;; '(:nil :cons :sym :fun :num :str :char :comm :u64 :key :env :err :thunk :builtin :bignum)
-; (deflexical +tags+ (allocation-tag-names (make-instance 'lurk-allocation)))
+(deflexical +tags+ (allocation-tag-names (make-instance 'lurk-allocation)))
 
 (let ((builtin-package (find-package :lurk.builtin)))
   (defun* lurk-builtin-p ((s symbol))
@@ -138,7 +138,7 @@
     (character :char)
     (comm :comm)
     (thunk :thunk)
-    (env :cons)
+    (env :cons) ; TODO: Revert back to :env
     (fun :fun)))
 
 ;; size is number of elements, bits is bits per 'element'
@@ -190,7 +190,7 @@
     (make-wide :elements (le-elements<- x :size 8)))
   (:method ((tag (eql :bignum)) x)
     (make-wide :elements (le-elements<- x :size 8 :bits +element-bits+)))
-  (:method ((tag (eql :env)) x)
+  (:method ((tag (eql :cons)) (x env))
     (let ((env-key (intern-wide-ptr (env-key x)))
 	  (env-value (intern-wide-ptr (env-value x))))
       (hash (wide-ptr-tag env-key)
@@ -373,8 +373,8 @@
 				   3542027988 2162033960 208146369 2711802215))
               (intern-wide-ptr (thunk '(we want the thunk) env2)))))
     (is (== (make-wide-ptr (tag-value :fun)
-                           (wide 2457271655 1361316774 3992440303 3109589054
-				 3087846088 326130256 771752173 918216196))
+                           (wide 1760390733 1018055170 656655793 351132428
+				 2417246066 1703544600 286035412 916394790))
             (intern-wide-ptr (fun '(a b c) '(+ a (* b c)) nil))))))
 
 (test expr<-wide-ptr
@@ -390,6 +390,7 @@
       (test-roundtrip '(1 2 (3 4)))
       (test-roundtrip 'a)
       (test-roundtrip :mango)
+      ;; TODO: Revert back after restoring :env changes
       #+nil(let* ((env1 (env 'a 123 nil))
              (env2 (env 'b "xxx" env1)))
         (test-roundtrip env1)

loam/datalog.lisp

@@ -11,6 +11,10 @@
   `(when *trace*
      (format *trace* ,@args)))
 
+(defmacro trace-success-log (&rest args)
+  `(when (or *trace* *trace-success-only*)
+     (format (or *trace* *trace-success-only*) ,@args)))
+
 ;; Use explicit vars instead of symbols if symbols are allowable values.
 ;; For now, don't, since it keeps things simpler.
 ;; (defstruct (var (:constructor var (name)) :predicate)
@@ -333,9 +337,10 @@
           (process-with-bindings (plan-segments plan) ()))
 
         (when matching-bindings
-          (trace-log "SUCCESS with ~d new bindings" (length matching-bindings))
-          (trace-log "~%~a~%" matching-bindings)
-          (trace-log ".~%")
+	  (trace-success-log "~a~%" (rule-src rule))
+          (trace-success-log "SUCCESS with ~d new bindings" (length matching-bindings))
+          (trace-success-log "~%~a~%" matching-bindings)
+          (trace-success-log "~%~%~%~%")
           )
 
         matching-bindings))))
@@ -771,19 +776,17 @@ and a list of free variables in FORM."
 	    finally (return output-rules))))
 
   (defun synthesize-segments (segments curr-rhs end-handle)
-    (display 'synthesize-segments segments curr-rhs end-handle)
     (loop with first = t
 	  for (segment . rest) on segments
 	  for kind = (segment-kind segment)
 	  for (lhs-signal . rhs-handle) = (handle-signal *prototype* segment)
 	  when first
 	    append curr-rhs into curr-rhs-tail and do (setq first nil)
 	  when (eql kind :predicate)
-	    collect (make-rule (display `(,lhs-signal <-- ,@(copy-list curr-rhs-tail)))) into output-rules
+	    collect (make-rule `(,lhs-signal <-- ,@(copy-list curr-rhs-tail))) into output-rules
 	    and collect rhs-handle into curr-rhs-tail
 	  when (typep kind '(member :rule-binding :restriction))
 	    collect segment into curr-rhs-tail
-	    and do (display curr-rhs-tail)
 	  when (eql kind :case)
 	    ;; Case statements must be the last segment, because they split the execution into branches.
 	    ;; When synthesizing the case, the final rule must be handled differently for each branch,
@@ -799,14 +802,14 @@ and a list of free variables in FORM."
 	    and append (synthesize-cond-segment segment (copy-list curr-rhs-tail) end-handle) into output-rules
 	    and do (return output-rules)
 	  when (eql kind :if)
-	    ;; Ditto the above for if statements.
+	    ;; Ditto the above for cond statements.
 	    do (assert (eql rest nil))
 	    and append (synthesize-if-segment segment (copy-list curr-rhs-tail) end-handle) into output-rules
 	    and do (return output-rules)
 	  finally
 	     ;; If we don't hit a case statement, then after we process all segments,
 	     ;; we must finish with an final rule.
-	     (let ((final-rule (make-rule (display `(,end-handle <-- ,@curr-rhs-tail)))))
+	     (let ((final-rule (make-rule `(,end-handle <-- ,@curr-rhs-tail))))
 	       (return `(,@output-rules ,final-rule)))))
 
   ;; This function takes a unsynthesized rule and synthesizes it.
@@ -1072,10 +1075,11 @@ and a list of free variables in FORM."
     (loop for i from 0
           collect (process-rules program)
           do (trace-log "~%------------------------------------------------------------~%")
-          do (trace-log "running iteration: ~a~%" i)
+          do (trace-success-log "running iteration: ~a~%" i)
              ;; prevent runaways
           ;do (when (and (> i 0) (zerop (mod i 100))) (break))
-          while (update program))))
+          while (update program)
+	  )))
 
 (defun find-prototype (name)
   (get name '%prototype))