wip

loam.asd

@@ -18,6 +18,7 @@
                  (:file "lattice")
                  (:file "datalog")
                  (:file "allocation")
+                 (:file "evaluation")
                  (:file "data")
                  )))
 

loam/datalog.lisp

@@ -729,6 +729,7 @@ and a list of free variables in FORM."
       (let :rule-binding)
       (when :restriction)
       (case :case)
+      (cond :cond)
       (if :if)
       (t :predicate)))
 
@@ -743,6 +744,19 @@ and a list of free variables in FORM."
 	(nconc (aux if-branch `(when ,condition))
                (aux else-branch `(when (not ,condition)))))))
 
+  ;; Synthesizes a segment that starts with a case statement.
+  ;; Errors if the first segment is not a case segment.
+  (defun synthesize-cond-segment (case-segment curr-rhs end-handle)
+    (destructuring-bind (head &rest branches)
+	case-segment
+      (assert (eql head 'cond))
+      (loop for (test branch-segments) in branches
+	    for test-segment = `(when ,test)
+	    for curr-rhs-tail = (append curr-rhs (list test-segment))
+	    append (synthesize-segments branch-segments (copy-list curr-rhs-tail) end-handle)
+	      into output-rules
+	    finally (return output-rules))))
+
   ;; Synthesizes a segment that starts with a case statement.
   ;; Errors if the first segment is not a case segment.
   (defun synthesize-case-segment (case-segment curr-rhs end-handle)
@@ -776,6 +790,11 @@ and a list of free variables in FORM."
 	    do (assert (eql rest nil))
 	    and append (synthesize-case-segment segment (copy-list curr-rhs-tail) end-handle) into output-rules
 	    and do (return output-rules)
+	  when (eql kind :cond)
+	    ;; Ditto the above for if statements.
+	    do (assert (eql rest nil))
+	    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.
 	    do (assert (eql rest nil))