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))
@@ -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

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,
@@ -806,7 +809,7 @@ and a list of free variables in FORM."
 	  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))