Skip to content

Commit

Permalink
Merge pull request #105 from JohanWiltink/main
Browse files Browse the repository at this point in the history 
negabinary-scott test updates
  • Loading branch information
@JohanWiltink
JohanWiltink authored Feb 1, 2024
2 parents 9bc1db1 + 67121e8 commit 3c0f6e1
Show file tree
Hide file tree
Showing 2 changed files with 21 additions and 50 deletions.
29 changes: 3 additions & 26 deletions tests/negabinary-scott/solution.lc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)
Expand Down
42 changes: 18 additions & 24 deletions tests/negabinary-scott/test.js
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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") ;
Expand All @@ -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 }` );
});
});

0 comments on commit 3c0f6e1

Please sign in to comment.