# HG changeset patch
# User Leonard Ritter <contact@leonard-ritter.com>
# Date 1660667162 -7200
#      Tue Aug 16 18:26:02 2022 +0200
# Node ID be318e37013f5d4ab4b659e31a5b9ce410928b16
# Parent  34204081dba4d267478eed4b576609d5f17dac43
* BDD: small improvement

diff --git a/testing/BDD.sc b/testing/BDD.sc
--- a/testing/BDD.sc
+++ b/testing/BDD.sc
@@ -32,6 +32,42 @@
                 returning bool
                 self as Ternary == other as Ternary
 
+    @@ memo
+    inline __< (cls T)
+        static-if (cls == T)
+            fn (self other)
+                returning bool
+                dispatch self
+                case Zero ()
+                    dispatch other
+                    case Zero () false
+                    default true
+                case One ()
+                    dispatch other
+                    case Zero () false
+                    case One () false
+                    default true
+                case Var (name)
+                    dispatch other
+                    case Zero () false
+                    case One () false
+                    case Var (name2) (name as string < name2 as string)
+                    default true
+                case Term (x y z)
+                    dispatch other
+                    case Zero () false
+                    case One () false
+                    case Var (name2) false
+                    case Term (u v w)
+                        if (x == u)
+                            if (y == v)
+                                if (z == w) false
+                                else (z < w)
+                            else (y < v)
+                        else (x < u)
+                    default true
+                default false
+
     fn make-term
 
     fn sub (self key value)
@@ -205,6 +241,16 @@
                         this-function b
                         (default-styler 'style-operator ")")
             default;
+            if (c == (~ b))
+                return
+                    ..
+                        (default-styler 'style-operator "(")
+                        this-function a
+                        " "
+                        (default-styler 'style-operator "^")
+                        " "
+                        this-function b
+                        (default-styler 'style-operator ")")
             return
                 ..
                     (default-styler 'style-operator "(?")
@@ -216,7 +262,7 @@
                     this-function b
                     (default-styler 'style-operator ")")
         default
-            "???"
+            str"???"
 
 
     fn __repr (self)
@@ -231,7 +277,7 @@
                 \ (repr a) " " (repr b) " " (repr c)
                 (default-styler 'style-operator ")")
         default
-            "?"
+            str"?"
 
 type+ T
     inline... substitute (self keys...)
@@ -352,6 +398,14 @@
             #rev& b0 b1 b2 n3
             #rev& b0 b1 b2 b3
 
+do
+    let a b c d = (T 'a) (T 'b) (T 'c) (T 'd)
+    let ~a ~b ~c ~d = (~ a) (~ b) (~ c) (~ d)
+    print
+        T.bool-repr
+            ~a & b & ~c & d | a & b & ~c & ~d | ~a & b & c & ~d | ~a & ~b & ~c & d
+        #~a & b & ~c & d | a & b & ~c & ~d | ~a & b & c & ~d | ~a & ~b & ~c & d
+        #| (& ~a b ~c d) (& a b ~c ~d) (& ~a b c ~d) (& ~a ~b ~c d)
 
 #
     if a
diff --git a/testing/tukdag.sc b/testing/tukdag.sc
--- a/testing/tukdag.sc
+++ b/testing/tukdag.sc
@@ -254,8 +254,8 @@
                         ftou (fmul v (utof TS))
                     fetch cube_texture (uvec2 u v)
                 let tex =
-                    #hardcube u v
-                    softcube u v
+                    hardcube u v
+                    #softcube u v
                 inline tform (x)
                     fmul (fadd (fmul x (fconst 0.5)) (fconst 0.5)) tex
                 let r = (tform r)