Merge pull request #105 from JohanWiltink/main

negabinary-scott test updates

Author: JohanWiltink

tests/negabinary-scott/solution.lc

@@ -23,14 +23,6 @@ snd = \ xy . xy \ _x y . y
 bimap = \ fn xy . xy \ x y . Pair (fn x) (fn y)
 Y2 = B Y (C (B bimap T))
 
-#import scott-triple.lc
-Triple = \ x y z f . f x y z
-fst3 = \ xyz . xyz \ x _y _z . x
-snd3 = \ xyz . xyz \ _x y _z . y
-thd3 = \ xyz . xyz \ _x _y z . z
-trimap = \ fn xyz . xyz \ x y z . Triple (fn x) (fn y) (fn z)
-Y3 = B Y (C (B trimap T))
-
 #import scott-quad.lc
 Quad = \ w x y z f . f w x y z
 fst4 = \ wxyz . wxyz \ w _x _y _z . w
@@ -55,24 +47,9 @@ Enum = Y2 (Pair (T \ succ pred . \ m . m  1 Bit1 (B nega-dbl pred)) # succ
 succ = fst Enum
 pred = snd Enum
 
-Num = Y3 (Triple (T \ add adc adb .
-                    \ m n . m n        # add
-                              ( \ zm . n m ( \ zn . nega-dbl (add zm zn) ) ( \ zn . Bit1 (add zm zn) ) )
-                              ( \ zm . n m ( \ zn . Bit1 (add zm zn) ) ( \ zn . nega-dbl (adb zm zn) ) )
-                 )
-                 (T \ add adc adb .
-                    \ m n . m (succ n) # add-with-carry
-                              ( \ zm . n (succ m) ( \ zn . Bit1 (add zm zn) ) ( \ zn . nega-dbl (adb zm zn) ) )
-                              ( \ zm . n (succ m) ( \ zn . nega-dbl (adb zm zn) ) ( \ zn . Bit1 (adb zm zn) ) )
-                 )
-                 (T \ add adc adb .
-                    \ m n . m (pred n) # add-with-borrow
-                              ( \ zm . n (pred m) ( \ zn . Bit1 (adc zm zn) ) ( \ zn . nega-dbl (add zm zn) ) )
-                              ( \ zm . n (pred m) ( \ zn . nega-dbl (add zm zn) ) ( \ zn . Bit1 (add zm zn) ) )
-         )       )
-add = fst3 Num
-adc = snd3 Num
-adb = thd3 Num
+add = \ m n . m n
+                ( \ zm . n m ( \ zn . nega-dbl (add zm zn) ) ( \ zn . Bit1 (add zm zn) ) )
+                ( \ zm . n m ( \ zn . Bit1 (add zm zn) ) ( \ zn . nega-dbl (pred (add zm zn)) ) )
 
 negate = \ n . add n (nega-dbl n)
 sub = \ m n . add m (negate n)

tests/negabinary-scott/test.js

@@ -20,7 +20,6 @@ LC.configure({ purity: "LetRec", numEncoding: { fromInt, toInt } });
 const solutionText = readFileSync(new URL("./solution.lc", import.meta.url), {encoding: "utf8"});
 const solution = LC.compile(solutionText);
 const { succ,pred, add,negate,sub, zero, lt0,le0,ge0,gt0,compare } = solution;
-const { True,False, LT,EQ,GT } = solution;
 
 const toBoolean = p => p (true) (false) ;
 const toOrdering = cmp => cmp ("LT") ("EQ") ("GT") ;
@@ -33,46 +32,41 @@ describe("NegaBinaryScott", () => {
   });
   it("succ", () => {
     for ( let n=-10; n<=10; n++ )
-      assert.strictEqual( toInt(succ(fromInt(n))), n+1, `succ ${ n }` );
-      // assert.strictEqual( toInt(pred(fromInt(n))), n-1, `pred ${ n }` );
+      assert.strictEqual( toInt(succ(n)), n+1, `succ ${ n }` );
   });
   it("pred", () => {
     for ( let n=-10; n<=10; n++ )
-      // assert.strictEqual( toInt(succ(fromInt(n))), n+1, `succ ${ n }` ),
-      assert.strictEqual( toInt(pred(fromInt(n))), n-1, `pred ${ n }` );
+      assert.strictEqual( toInt(pred(n)), n-1, `pred ${ n }` );
   });
   it("add", () => {
     for ( let m=-10; m<=10; m++ )
-      for ( let n=-10; n<=10; n++ ) {
-        const actual = toInt(add(fromInt(m))(fromInt(n)));
-        assert.strictEqual(actual,m+n,`add ${ m } ${ n }`);
-      }
+      for ( let n=-10; n<=10; n++ )
+        assert.strictEqual( toInt(add(m)(n)), m+n, `add ${ m } ${ n }` );
   });
   it("negate", () => {
     for ( let n=-10; n<=10; n++ )
-      assert.strictEqual( toInt(negate(fromInt(n))), -n, `negate ${ n }` );
+      assert.strictEqual( toInt(negate(n)), -n, `negate ${ n }` );
+  });
+  it("negate . negate", () => {
+    for ( let n=-10; n<=10; n++ )
+      assert.strictEqual( toInt(negate(negate(n))), n, `negate (negate ${ n })` );
   });
   it("sub", () => {
     for ( let m=-10; m<=10; m++ )
-      for ( let n=-10; n<=10; n++ ) {
-        const actual = toInt(sub(fromInt(m))(fromInt(n)));
-        assert.strictEqual(actual,m-n,`sub ${ m } ${ n }`);
-      }
+      for ( let n=-10; n<=10; n++ )
+        assert.strictEqual( toInt(sub(m)(n)), m-n, `sub ${ m } ${ n }` );
   });
   it("eq, uneq", () => {
     for ( let n=-10; n<=10; n++ )
-      assert.equal(toBoolean(zero(fromInt(n))),n===0,`zero ${ n }`),
-      assert.equal(toBoolean(lt0(fromInt(n))),n<0,`lt0 ${ n }`),
-      assert.equal(toBoolean(le0(fromInt(n))),n<=0,`le0 ${ n }`),
-      assert.equal(toBoolean(ge0(fromInt(n))),n>=0,`ge0 ${ n }`),
-      assert.equal(toBoolean(gt0(fromInt(n))),n>0,`gt0 ${ n }`);
+      assert.strictEqual(toBoolean(zero(n)),n===0,`zero ${ n }`),
+      assert.strictEqual(toBoolean(lt0(n)),n<0,`lt0 ${ n }`),
+      assert.strictEqual(toBoolean(le0(n)),n<=0,`le0 ${ n }`),
+      assert.strictEqual(toBoolean(ge0(n)),n>=0,`ge0 ${ n }`),
+      assert.strictEqual(toBoolean(gt0(n)),n>0,`gt0 ${ n }`);
   });
   it("compare", () => {
     for ( let m=-10; m<=10; m++ )
-      for ( let n=-10; n<=10; n++ ) {
-        const actual = toOrdering(compare(fromInt(m))(fromInt(n)));
-        const expected = m > n ? "GT" : m < n ? "LT" : "EQ" ;
-        assert.equal(actual,expected,`compare ${ m } ${ n }`);
-      }
+      for ( let n=-10; n<=10; n++ )
+        assert.strictEqual( toOrdering(compare(m)(n)), m > n ? "GT" : m < n ? "LT" : "EQ" , `compare ${ m } ${ n }` );
   });
 });