diff --git a/src/lambda-calculus.js b/src/lambda-calculus.js index 8b9247c..401ff30 100644 --- a/src/lambda-calculus.js +++ b/src/lambda-calculus.js @@ -1,6 +1,7 @@ /* Lambda Calculus evaluator supporting: - unlimited recursion + - call by need - fast (ish?) evaluation - shortform syntax @@ -179,7 +180,10 @@ function parseWith(cfg={}) { return tm; } else { if ( verbosity >= "Concise" ) console.error(`parse: while defining ${ name } = ${ term }`); - throw new ReferenceError(`undefined free variable ${ nm }`); + if ( nm === name ) + throw new ReferenceError(`undefined free variable ${ nm }: direct recursive calls are not supported in Let mode`); + else + throw new ReferenceError(`undefined free variable ${ nm }`); } } , new Tuple( term, new Env ) ); else if ( purity==="LetRec" ) @@ -212,7 +216,7 @@ function parseWith(cfg={}) { console.error(code); console.error(' '.repeat(i) + '^'); console.error(msg + " at position " + i); - throw new SyntaxError; + throw new SyntaxError(msg); } function sp(i) { while ( whitespace.test( code[i] || "" ) ) i++; return i; } const expect = c => function(i) { return code[i]===c ? sp(i+1) : 0 ; } ; diff --git a/tests/multiply/initialSolution.txt b/tests/multiply/initialSolution.txt index b5242b8..c6fbc81 100644 --- a/tests/multiply/initialSolution.txt +++ b/tests/multiply/initialSolution.txt @@ -1 +1 @@ -multiply = \ m n . n (m s ) z +multiply = \ m n . n (m s) z diff --git a/tests/multiply/solution.txt b/tests/multiply/solution.txt index fe6d16b..02e94e2 100644 --- a/tests/multiply/solution.txt +++ b/tests/multiply/solution.txt @@ -1 +1 @@ -multiply = \ m n s . n ( m s ) +multiply = \ m n s z . n (m s) z diff --git a/tests/scott-lists/solution.txt b/tests/scott-lists/solution.txt index da3b019..6593e7d 100644 --- a/tests/scott-lists/solution.txt +++ b/tests/scott-lists/solution.txt @@ -1,4 +1,4 @@ -# scott-lists.lc +# scott-list.lc #import combinators.lc B = \ f g x . f (g x) @@ -18,7 +18,7 @@ Y = \ f . ( \ x . f (x x) ) ( \ x . f (x x) ) #import scott-booleans.ls False = K True = KI -not = \ p . p True False +not = C and = M or = W C #import scott-ordering.lc @@ -58,7 +58,7 @@ is-none = \ x . x True (K False) # = is-zero is-some = \ x . x False (K True) from-option = \ z x . x z I from-some = \ x . x () I -# additional definitions depend on nil and cons +# additional definitions depend on nil, cons, singleton # data List a = Nil | Cons a (List a) @@ -71,32 +71,43 @@ cons = \ x xs . \ _nil cons . cons x xs # singleton :: a -> List a singleton = \ x . cons x nil -# these scott-options definitions depend on nil, cons, singleton +# these scott-option definitions depend on nil, cons, singleton list-to-option = \ xs . xs None \ x _xs . Some x option-to-list = \ x . x nil singleton map-option = \ fn xs . xs nil \ x xs . fn x (map-option fn xs) (C cons (map-option fn xs)) cat-options = map-option I -# continuing scott-lists.lc +# continuing scott-list.lc # foldr :: (a -> z -> z) -> z -> List a -> z -foldr = \ fn z xs . xs z ( \ x xs . fn x (foldr fn z xs) ) +foldr = \ fn z xs . xs z \ x xs . fn x (foldr fn z xs) -# null :: List a -> Boolean -null = \ xs . xs True (KK False) +# foldl :: (z -> a -> z) -> z -> List a -> z +foldl = \ fn z xs . xs z (B (foldl fn) (fn z)) + +# scanr :: (a -> z -> z) -> z -> List a -> List z +scanr = \ fn z xs . xs (singleton z) \ x xs . ( \ zs . zs () \ z _zs . cons (fn x z) zs ) (scanr fn z xs) + +# scanl :: (z -> a -> z) -> z -> List a -> List z +scanl = \ fn z xs . cons z (xs nil (B (scanl fn) (fn z))) # take :: Number -> List a -> List a take = \ n xs . is-zero n (xs nil \ x xs . cons x (take (pred n) xs)) nil +# drop :: Number -> List a -> List a +drop = \ n xs . is-zero n (xs nil (K (drop (pred n)))) xs + # append :: List a -> List a -> List a append = C (foldr cons) # concat :: List (List a) -> List a -concat = \ xss . foldr xss append nil +concat = foldr append nil -# sum,product :: List Number -> Number -sum = foldr add zero -product = foldr mul one +# snoc :: List a -> a -> List a +snoc = C (B (foldr cons) singleton) + +# uncons :: List a -> Option (Pair a (List a)) +uncons = \ xs . xs None (BB Some Pair) # iterate :: (a -> a) -> a -> List a iterate = \ fn x . cons x (iterate fn (fn x)) @@ -105,22 +116,29 @@ iterate = \ fn x . cons x (iterate fn (fn x)) repeat = \ x . cons x (repeat x) # repeat = Y (S cons) # cycle :: List a -> List a -cycle = \ xs . null xs (concat (repeat xs)) () +cycle = \ xs . xs () (concat (repeat xs)) # replicate :: Number -> a -> List a replicate = \ n . B (take n) repeat +# unfold :: (a -> Option (Pair z a)) -> a -> List z +unfold = \ fn x . fn x nil (T \ z x . cons z (unfold fn x)) + # head :: List a -> a head = \ xs . xs () K # tail :: List a -> List a tail = \ xs . xs () KI +# null :: List a -> Boolean +null = \ xs . xs True (KK False) + # length :: List a -> Number length = foldr (K succ) zero -# snoc :: List a -> a -> List a -snoc = C (B (foldr cons) singleton) +# sum,product :: List Number -> Number +sum = foldr add zero +product = foldr mul one # map :: (a -> b) -> List a -> List b map = \ fn . foldr (B cons fn) nil @@ -128,24 +146,27 @@ map = \ fn . foldr (B cons fn) nil # concat-map :: (a -> List b) -> List a -> List b concat-map = BB concat map -# filter :: () -> List a -> List a +# filter :: (a -> Boolean) -> List a -> List a filter = \ p . foldr ( \ x z . p x z (cons x z) ) nil -filter = \ p . foldr ( \ x . S (p x) (cons x) ) nil -filter = \ p . foldr (S (B S p) cons) nil -# drop :: Number -> List a -> List a -drop = \ n xs . is-zero n ( \ _x xs . drop (pred n) xs ) xs -drop = \ n . is-zero n (K (drop (pred n))) +# take-while :: (a -> Boolean) -> List a -> List a +take-while = \ p xs . xs nil \ x xs . p x nil (cons x (take-while p xs)) + +# drop-while :: (a -> Boolean) -> List a -> List a +drop-while = \ p xs . xs nil \ x xs . p x xs (drop-while p xs) + +# drop-while-end :: (a -> Boolean) -> List a -> List a +drop-while-end = \ p . foldr ( \ x z . and (null z) (p x) (cons x z) nil ) nil # split-at :: Number -> List a -> Pair (List a) (List a) split-at = \ i xs . is-zero i (xs (Pair nil nil) \ x xs . first (cons x) (split-at (pred i) xs)) (Pair nil xs) # get :: Number -> List a -> a -get = \ i xs . is-zero i ( \ x xs . xs () (get (pred i) xs) ) (head xs) +get = \ i xs . is-zero i (xs () (K (get (pred i)))) (head xs) # set :: Number -> a -> List a -> List a set = \ i x xs . uncurry append (second (B (cons x) tail) (split-at i xs)) -set = \ i x xs . is-zero i (xs nil \ y ys . cons y (set (pred i) x ys)) (xs nil (K (cons x))) +set = \ i x xs . is-zero i (xs nil \ y . cons y (set (pred i) x)) (xs nil (K (cons x))) # any :: (a -> Boolean) -> List a -> Boolean any = \ p . foldr (B or p) False @@ -154,13 +175,13 @@ any = \ p . foldr (B or p) False all = \ p . foldr (B and p) True # find :: (a -> Boolean) -> List a -> Option a -find = \ p . foldr ( \ x z . p x z (Some x) ) None +find = BB list-to-option filter # find-indices :: (a -> Boolean) -> List a -> List Number find-indices = \ p . foldr ( \ x k i . p x I (cons i) (k (succ i)) ) (K nil) zero # find-index :: (a -> Boolean) -> List a -> Option Number -find-index = \ p . B list-to-option (find-indices p) +find-index = BB list-to-option find-indices # partition :: (a -> Boolean) -> List a -> Pair (List a) (List a) partition = \ p . foldr ( \ x . p x second first (cons x) ) (Pair nil nil) @@ -168,82 +189,64 @@ partition = \ p . foldr ( \ x . p x second first (cons x) ) (Pair nil nil) # span :: (a -> Boolean) -> List a -> Pair (List a) (List a) span = \ p xs . xs (Pair nil nil) \ y ys . p y (Pair nil xs) (first (cons y) (span p ys)) -# minimum-by :: (a -> a -> Boolean) -> List a -> a # cmp ~ le -minimum-by = \ cmp xs . xs () (foldr \ x z . cmp x z z x) - -# maximum-by :: (a -> a -> Boolean) -> List a -> a # cmp ~ le -maximum-by = \ cmp xs . xs () (foldr \ x z . cmp x z x z) +# minimum-by :: (a -> a -> Boolean) -> List a -> a +minimum-by = \ le xs . xs () (foldl \ z x . le z x x z) -# insert-by :: (a-> a -> Boolean) -> a -> List a -> List a # cmp ~ le -insert-by = \ cmp x xs . uncurry append (second (cons x) (span (C cmp x) xs)) +# maximum-by :: (a -> a -> Boolean) -> List a -> a +maximum-by = \ le xs . xs () (foldl \ z x . le z x z x) -# sort-by :: (a -> a -> Boolean) -> List a -> List a # cmp ~ le -sort-by = \ cmp . foldr (insert-by cmp) nil - -# foldl :: (z -> a -> z) -> z -> List a -> z -foldl = \ fn z xs . xs z (B (foldl fn) (fn z)) - -# scanl :: (z -> a -> z) -> z -> List a -> List z -scanl = \ fn z xs . cons z (xs nil (B (scanl fn) (fn z))) +# insert-by :: (a -> a -> Boolean) -> a -> List a -> List a +insert-by = \ le x xs . uncurry append (second (cons x) (span (C le x) xs)) -# scanr :: (a -> z -> z) -> z -> List a -> List z -scanr = \ fn z xs . xs (singleton z) \ x xs . ( \ zs . zs \ z _zs . cons (fn x z) zs ) (scanr fn z xs) +# sort-by :: (a -> a -> Boolean) -> List a -> List a +sort-by = \ le . foldr (insert-by le) nil +# has all sorts of bad implementation details, but it's simple # reverse :: List a -> List a reverse = foldl (C cons) nil -# unzip :: List (Pair a b) -> Pair (List a) (List b) -unzip = foldr ( \ xy xys . xy \ x y . bimap (cons x) (cons y) xys ) (Pair nil nil) -unzip = foldr (CB \ x y . bimap (cons x) (cons y)) (Pair nil nil) - # zip-with :: (a -> b -> z) -> List a -> List b -> List z zip-with = \ fn xs ys . xs nil \ x xs . ys nil \ y ys . cons (fn x y) (zip-with fn xs ys) # zip :: List a -> List b -> List (Pair a b) zip = zip-with Pair -# init :: List a -> List a -init = \ xs . xs () (S (zip-with K) tail xs) - -# last :: List a -> a -last = foldl KI () - -# slice :: Number -> Number -> List a -> List a -slice = \ i j xs . gt j i nil (take (sub j i) (drop i xs)) - -# uncons :: List a -> Option (Pair (a) (List a)) -uncons = \ xs . xs None (B Some Pair) +# unzip :: List (Pair a b) -> Pair (List a) (List b) +unzip = foldr ( \ xy xys . xy \ x y . bimap (cons x) (cons y) xys ) (Pair nil nil) +unzip = foldr (CB \ x y . bimap (cons x) (cons y)) (Pair nil nil) -# transpose :: List (List a) -> List (List a) -transpose = \ xss . xss nil - \ ys yss . ys (transpose yss) - (unzip (map-option uncons xss) \ xs xxs . cons xs (transpose xss)) +# group-by :: (a -> a -> Bool) -> List a -> List (List a) +group-by = \ eq xs . xs nil \ x xs . span (eq x) xs \ left right . cons (cons x left) (group-by eq right) -# unfold :: (a -> Option (Pair z a)) -> a -> List z -unfold = \ fn x . fn x nil (T \ z x . cons z (unfold fn x)) +# lookup-by :: (a -> Boolean) -> List (Pair a b) -> Option b +lookup-by = \ p xys . xys None \ xy xys . xy \ x y . p x (lookup-by p xys) (Some y) -# take-while :: (a -> Boolean) -> List a -> List a -take-while = \ p xs . xs nil \ x xs . p x nil (cons x (take-while p xs)) +# nub-by :: (a -> a -> Boolean) -> List a -> List a +go = \ z eq xs . xs z \ x xs . go (is-none (find (eq x) z) z (cons x z)) eq xs +nub-by = go nil -# drop-while :: (a -> Boolean) -> List a -> List a -drop-while = \ p xs . xs nil \ x xs . p x xs (drop-while p xs) +# delete-by :: (a -> a -> Boolean) -> a -> List a -> List a +delete-by = \ eq x xs . xs nil \ y ys . eq x y (cons y (delete-by eq x ys)) ys -# drop-while-end :: (a -> Boolean) -> List a -> List a -drop-while-end = \ p . foldr ( \ x z . and (null z) (p x) (cons x z) nil ) nil +# delete-firsts-by :: (a -> a -> Boolean) -> List a -> List a -> List a +delete-firsts-by = \ eq . foldl (C (delete-by eq)) -# group-by :: (a -> a -> Bool) -> List a -> List (List a) -group-by = \ eq xs . xs nil \ x xs . span (eq x) xs \ left right . cons (cons x left) (group-by eq right) -group-by = \ eq xs . xs nil \ x xs . uncurry cons (bimap (cons x) (group-by eq) (span (eq x) xs)) +# init :: List a -> List a +init = \ xs . xs () (S (zip-with K) tail xs) -# inits +# last :: List a -> a +last = foldl KI () # tails :: List a -> List (List a) tails = \ xs . cons xs (xs nil (K tails)) -# lookup-by :: (a -> Boolean) -> List (Pair a b) -> Option b -lookup-by = \ eq xys . xys None \ xy xys . xy \ x y . eq x (lookup-by eq xys) (Some y) +# inits :: List a -> List (List a) +inits = \ xs . xs (singleton nil) \ x xs . cons nil (map (cons x) (inits xs)) -# nub-by -# delete-by -# delete-firsts-by -# sort-on +# slice :: Number -> Number -> List a -> List a +slice = \ i j xs . le i j nil (take (sub j i) (drop i xs)) + +# transpose :: List (List a) -> List (List a) +transpose = \ xss . xss nil + \ ys yss . ys (transpose yss) + (unzip (map-option uncons xss) \ xs xss . cons xs (transpose xss)) diff --git a/tests/scott-lists/test.js b/tests/scott-lists/test.js index 5125aad..18bc911 100644 --- a/tests/scott-lists/test.js +++ b/tests/scott-lists/test.js @@ -9,32 +9,51 @@ LC.config.verbosity = "Concise"; const solutionText = readFileSync(new URL("./solution.txt", import.meta.url), {encoding: "utf8"}); const solution = LC.compile(solutionText); -const fromInt = LC.fromIntWith(LC.config); -const toInt = LC.toIntWith(LC.config); const {nil,cons,singleton} = solution; -const {foldr,head,tail,take} = solution; -const {iterate,repeat,cycle,replicate} = solution; -const {foldl,reverse} = solution; +const {foldr,foldl,scanr,scanl} = solution; +const {take,drop} = solution; +const {append,concat,snoc,uncons} = solution; +const {iterate,repeat,cycle,replicate,unfold} = solution; +const {head,tail,"null":isNil,length,sum,product} = solution; +const {map,"concat-map":concatMap,filter} = solution; +const {"take-while":takeWhile,"drop-while":dropWhile,"drop-while-end":dropWhileEnd} = solution; +const {"split-at":splitAt,get,set} = solution; +const {any,all,find,"find-indices":findIndices,"find-index":findIndex} = solution; +const {partition,span,"minimum-by":minimumBy,"maximum-by":maximumBy} = solution; +const {"insret-by":insertBy,"sort-by":sortBy,reverse} = solution; +const {"zip-with":zipWith,zip,unzip} = solution; +const {"group-by":groupBy,"nub-by":nubBy,"delete-by":deleteBy,"delete-firsts-by":deleteFirstsBy} = solution; +const {init,last,tails,inits,slice,transpose} = solution; +const {add,zero} = solution; + +const fromInt = LC.fromIntWith(LC.config); +const toInt = LC.toIntWith(LC.config); +const fromArray = xs => xs.reduceRight( (z,x) => cons(x)(z) , nil ) ; +const toArray = foldl ( z => x => [...z,x] ) ([]) ; -const fromList = foldl ( z => x => [...z,x] ) ([]) ; +const rnd = (m,n=0) => Math.random() * (n-m) + m | 0 ; +const elements = xs => xs[ rnd(xs.length) ] ; +const rndArray = size => Array.from( { length: rnd(size) }, () => rnd(size) ) ; const refReplicate = length => x => Array.from( { length }, () => x ) ; describe("Scott Lists",function(){ - it("example tests",()=>{ - assert.deepEqual( fromList( nil ), [] ); - assert.deepEqual( fromList( singleton ("0") ), ["0"] ); - assert.deepEqual( fromList( cons ("0") (singleton ("1")) ), ["0","1"] ); - assert.deepEqual( fromList( replicate (fromInt(0)) ("0") ), [] ); - assert.deepEqual( fromList( replicate (fromInt(1)) ("0") ), ["0"] ); - assert.deepEqual( fromList( replicate (fromInt(2)) ("0") ), ["0","0"] ); + it("nil,cons,singleton",()=>{ + assert.deepEqual( toArray( nil ), [] ); + for ( let i=1; i<=10; i++ ) { + const x = rnd(i), xs = rndArray(i); + assert.deepEqual( toArray( cons (fromInt(x)) (fromArray(xs.map(fromInt))) ).map(toInt), [x,...xs], `after ${ i } tests` ); + assert.deepEqual( toArray( singleton (fromInt(x)) ).map(toInt), [x], `after ${ i } tests` ); + } }); - it("random tests",()=>{ - const rnd = (m,n=0) => Math.random() * (n-m) + m | 0 ; - for ( let i=1; i<=100; i++ ) { - const m = rnd(i), n = rnd(i); - assert.deepEqual( fromList( replicate (fromInt(m)) (String(n)) ), refReplicate(m)(String(n)), `after ${ i } tests` ); + it("foldr,foldl,scanr,scanl",()=>{ + for ( let i=1; i<=10; i++ ) { + const xs = rndArray(i); + assert.deepEqual( toInt( foldr (add) (zero) (fromArray(xs.map(fromInt))) ), xs.reduce((x,y)=>x+y,0), `after ${ i } tests` ); + assert.deepEqual( toInt( foldl (add) (zero) (fromArray(xs.map(fromInt))) ), xs.reduce((x,y)=>x+y,0), `after ${ i } tests` ); + assert.deepEqual( toArray( scanr (add) (zero) (fromArray(xs.map(fromInt))) ).map(toInt), xs.reduceRight( (z,x) => [ z[0]+x, ...z ], [0] ), `after ${ i } tests` ); + assert.deepEqual( toArray( scanl (add) (zero) (fromArray(xs.map(fromInt))) ).map(toInt), xs.reduce( (z,x) => [ ...z, z[z.length-1]+x ] , [0] ), `after ${ i } tests` ); } }); });