Merge pull request #53 from JohanWiltink/main

add message to syntax error

Author: Kacarott

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 ; } ;

tests/multiply/initialSolution.txt

@@ -1 +1 @@
-multiply = \ m n . n (m s ) z
+multiply = \ m n . n (m s) z

tests/multiply/solution.txt

@@ -1 +1 @@
-multiply = \ m n s . n ( m s )
+multiply = \ m n s z . n (m s) z

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,47 +116,57 @@ 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
 
 # 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,96 +175,78 @@ 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)
 
 # 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))

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` );
     }
   });
 });