Test Cachylus module

System settings


In [1]:
(import hy sys)
(print "Hy version: " hy.__version__)
(print "Python" sys.version)


Hy version:  0.13.0
Python 3.6.2 | packaged by conda-forge | (default, Jul 23 2017, 22:58:45) [MSC v.1900 64 bit (AMD64)]

Import library


In [2]:
(require (calchylus.lambdas [*]))

Initializers


In [3]:
(with-alpha-conversion-nor-macros L ,)
(assert (= (L x , x 1) 1))

(with-alpha-conversion L ,)
(assert (= (L x , x 1) 1))

(with-macros L ,)
(assert (= (IDENT 1) 1))

(with-alpha-conversion-and-macros L ,)
(assert (= (IDENT (L x , x 1)) 1))


Out[3]:
<function <lambda> at 0x00000152DD81C2F0>

Basic lambda macros


In [4]:
(with-alpha-conversion-nor-macros L ,)
; not lambda expression
(assert (= (, 'x) (, 'x)))
; no body lambda expression
(assert (= (L ,) None))
; constant
(assert (= (L , c) 'c))
; identity, without argument
(assert (= (L x , x) "(L x , x)"))
; identity, with argument
(assert (= (L x , x y) 'y))
; select first, without arguments
(assert (= (L x y , x) "(L x , (L y , x))"))
; select second, without arguments
(assert (= (L x y , y) "(L x , (L y , y))"))
; select first, with arguments
(assert (= (L x y , x 1 0) 1))
; select second, with arguments
(assert (= (L x y , y 1 0) 0))
; multiary function without arguments
(assert (= (L x y z , (x y z)) "(L x , (L y , (L z , (x y z))))"))
; nested functions and arguments
(assert (= (L x , (L y , (L z , (z x y) l) k) j) "(l j k)"))
; nested functions, flatten arguments
(assert (= (L x , (L y , (L z , (z x y))) j k l) "(l j k)"))
; multiary function with arguments
(assert (= (L x y z , (z x y) j k l) "(l j k)"))
; application without arguments
(assert (= (L , ((L x y z , (x y z)))) "(L x , (L y , (L z , (x y z))))"))
; application with arguments
(assert (= (L , ((L x y z , (x y z)) a b c)) "(a b c)"))
; any free arguments should be returned on the final result
(assert (= (L x , x y z) "(y z)"))
; nested free arguments
(assert (= (L , ((L x y z , (x y z) l m n) a b c) 1 2 3) "((l m n) a b c 1 2 3)"))
; head normal form reduction
(assert (= (L x , (L y , (L z , z 1))) "(L x , (L y , 1))"))
; nested constants
(assert (= (L , (L , (L , 1))) 1))
; higher-order function, abstration
(assert (= (L x , x (L y , y)) "(L y , y)"))
; higher-order function, abstration, serial
(assert (= (L x , x (L y , y) (L z , z)) "(L z , z)"))
; higher-order function, apply function to function
(assert (= (L x , (x (L y , y)) (L z , z)) "(L y , y)"))
; higher-order function, value
(assert (= (L x , x (L y , y) 1) 1))


Out[4]:
<function <lambda> at 0x00000152DDA3E950>

Different lambda char and separator


In [5]:
; unicode lambda letter and middle dot
(with-alpha-conversion-nor-macros 𝜆 ·)
; using application shapr -macro, starting with lambda expression
(assert (= #Ÿ(𝜆 x · x) "(𝜆 x · x)"))
; using application shapr macro, lambda expression in the middle
(assert (= #Ÿ(x (x (𝜆 x · x y))) "(x (x y))"))
; return whole abstraction
(assert (= (𝜆 x · (𝜆 y · (𝜆 z · (x y z)))) "(𝜆 x · (𝜆 y · (𝜆 z · (x y z))))"))
; evaluate first abstraction, return rest abstraction levels
(assert (= (𝜆 x · (𝜆 y · (𝜆 z · (x y z))) 1) "(𝜆 y · (𝜆 z · (1 y z)))"))
; evaluate first and second abstraction, return rest abstraction levels
(assert (= (𝜆 x · (𝜆 y · (𝜆 z · (x y z))) 1 2) "(𝜆 z · (1 2 z))"))
; evaluate first, second, and the third abstraction, return fully evaluated result
(assert (= (𝜆 x · (𝜆 y · (𝜆 z · (x y z))) 1 2 3) "(1 2 3)"))


Out[5]:
<function <lambda> at 0x00000152DD8818C8>

Alpha conversion


In [6]:
(with-alpha-conversion-nor-macros L ,)
; without variable renaming next result is given
; first substitute x with y, and then both y's with z, resulting (z z)
(assert (= (L x y , (x y) y z) "(z z)"))
; same should apply to deeper values too
(assert (= (L x y , (x y) (y (y z)) z) "((z (z z)) z)"))
(with-alpha-conversion L , )
; using variable renaming / alpha conversion to prevent name collision should give right result
; instead of first substituting x with y, and then both y's with z
; this test should give (y z) because y is bound to x only. latter y should not replace it
(assert (= (L x y , (x y) y z) "(y z)"))
; same should apply to deeper values too. note similarity with LET and LET* macro handler!
(assert (= (L x y , (x y) (y (y z)) z) "((y (y z)) z)"))


Out[6]:
<function <lambda> at 0x00000152DD8819D8>

Special macros for main lambda terms / forms

Application

Comparatible with shapr () -macro.


In [7]:
(with-macros L ,)
; using application shapr -macro, starting with lambda expression
(assert (= (APP (L x , x)) "(L x , x)"))
; using application shapr macro, lambda expression in the middle
(assert (= (APP (x (x (L x , x y)))) "(x (x y))"))


Out[7]:
<function <lambda> at 0x00000152DD81C268>

Constants


In [8]:
(with-macros L ,)
; constant without body
(assert (= (CONST x) None))
; constant with body
(assert (= (CONST x 1) "(L x , 1)"))
; constant with body and value
(assert (= (CONST x 1 2) 1))


Out[8]:
<function <lambda> at 0x00000152DD644B70>

Identity


In [9]:
; identity, without arguments
(assert (= (IDENT) "(L a , a)"))
; identity, with arguments
(assert (= (IDENT 1) 1))
; identity, nested
(assert (= (IDENT (IDENT 1)) 1))
; boolean macros

Booleans


In [10]:
(assert (= (, (TRUE) (TRUE 1 0) 
              (FALSE) (FALSE 1 0)) 
           (, "(L a , (L b , a))" 1 
              "(L a , (L b , b))" 0)))

2-tuples / pairs


In [11]:
; nil
(assert (= (NIL) "(L x , (L a , (L b , a)))"))
; empty, list end
(assert (= (EMPTY) "(L s , (s (L x , (L a b , a)) (L x , (L a b , a))))"))
; pair constructor
(assert (= (PAIR TRUE NIL) "(L s , (s (L a b , a) (L x , (L a b , a))))"))
; selector, true
(assert (= (PAIR T F TRUE) 'T))
; selector, false
(assert (= (PAIR T F FALSE) 'F))
; head and tail selectors
(assert (= (, (HEAD (PAIR TRUE NIL)) 
              (TAIL (PAIR TRUE NIL))) 
           (, "(L a b , a)" "(L x , (L a b , a))")))
; nested pairs and heads and tails
(assert (=
   (, (HEAD (PAIR TRUE (PAIR TRUE NIL))) 
      (HEAD (TAIL (PAIR TRUE (PAIR TRUE NIL))))
      (TAIL (TAIL (PAIR TRUE (PAIR TRUE NIL)))))
   (, "(L a b , a)" "(L a b , a)" "(L x , (L a b , a))")))
; simple condition
(assert (=
    (, (COND TRUE TRUE FALSE) 
       (COND FALSE TRUE FALSE))
    (, "(L a b , a)" "(L a b , b)")))

Nil checks


In [12]:
; nil? for nested pairs
(assert (=
  (, (NIL? (TAIL (TAIL (PAIR ONE (PAIR ONE NIL))))) 
     (NIL? (HEAD (TAIL (PAIR ONE (PAIR ONE NIL))))))
  (, "(L b , (L a b , a))" "(L a b , b)")))
; is nil, simple
(assert (= (, (NIL? NIL) (NIL? FALSE) (NIL? TRUE) (NIL? ONE))
           (, "(L b , (L a b , a))" "(L a b , a)" "(L a , (L a b , b))" "(L a b , b)")))
; is nil, head and tail
(assert (= (, (NIL? (HEAD (PAIR ONE NIL))) 
              (NIL? (TAIL (PAIR ONE NIL)))) 
           (, "(L a b , b)" "(L b , (L a b , a))")))
; number nil? conditions
(assert (=
    (, (COND (NIL? (NUM 0)) TRUE FALSE)
       (COND (NIL? (NUM 1)) TRUE FALSE)
       (COND (NIL? (NUM 10)) TRUE FALSE))
    (, "(L a b , a)" "(L a b , b)" "(L a b , b)")))
; nil tail/head pair condition
(assert (=
    (, (NIL? (TAIL (PAIR (NUM 1) NIL)))
       (NIL? (HEAD (PAIR (NUM 1) NIL))))
    (, "(L b , (L a b , a))" "(L a b , b)")))
; TODO: this requires some thinking, nil to lists should be done with
; empty? check?
(assert (= (, (NIL? (PAIR ONE TWO)) (NIL? (LIST ONE TWO)) (NIL? (LIST)))
           (, "(L a b , a)" "(L a b , a)" "(L a b , a)")))

Church numerals


In [13]:
; church numeral general generator, without arguments
(assert (= (NUM 3) "(L x , (L y , (x (x (x y)))))"))
; church numeral, general generator, with arguments
(assert (= (NUM 3 m n) "(m (m (m n)))"))
; church numeral, general generator, with arguments
(assert (= (, (ONE) (TWO x y) (THREE m n))
           (, "(L x , (L y , (x y)))" "(x (x y))" "(m (m (m n)))")))
; natural number sharp macro
(assert (= #ℕ2) (NUM 2))
; natural number sharp macro, with space
(assert (= # 2) TWO)

Zeros


In [14]:
; church numeral, zero
(assert (= (ZERO) "(L x , (L y , y))"))
; church numeral, zero with arguments
(assert (= (ZERO a b) 'b))
; if TRUE is given, then the third option is activated!
(assert (= (ZERO? TRUE a b c) 'c))

Lists


In [15]:
; empty has two nils as a pair
(assert (= (LIST) 
           "(L s , (s (L x , (L a b , a)) (L x , (L a b , a))))"))
; nil added to the first item of the list
(assert (= (LIST NIL) 
           "(L s , (s (L x , (L a b , a)) (L a b s , (s a b) (L x , (L a b , a)) (L x , (L a b , a)))))"))
; one item that is a number one
(assert (= (LIST ONE) 
           "(L s , (s (L x y , (x y)) (L a b s , (s a b) (L x , (L a b , a)) (L x , (L a b , a)))))"))
; two items
(assert (= (LIST ONE TWO) 
           "(L s , (s (L x y , (x y)) (L a b s , (s a b) (L x y , (x (x y))) (L a b s , (s a b) (L x , (L a b , a)) (L x , (L a b , a))))))"))
; first of three
(assert (= (FIRST (LIST ONE TWO THREE)) "(L x y , (x y))"))
; second of three
(assert (= (SECOND (LIST ONE TWO THREE)) "(L x y , (x (x y)))"))
; last of three
(assert (= (LAST (LIST ONE TWO THREE)) "(L x y , (x (x (x y))))"))
; append to the end of the list and see that the last is the one that was appended
(assert (= (LAST (APPEND FOUR (LIST ONE TWO THREE))) "(L x y , (x (x (x (x y)))))"))
; prepend to the beginning of the list and see that the first is the one that was prepended
(assert (= (FIRST (PREPEND ONE (LIST ONE))) "(L x y , (x y))"))
; append + prepend + list
(assert (= (APPEND THREE (PREPEND ONE (LIST TWO))) (LIST ONE TWO THREE)))
; is empty?
(assert (= (, (EMPTY? TRUE) (EMPTY? FALSE) 
              (EMPTY? ONE) (EMPTY? (LIST)) 
              (EMPTY? (LIST ONE))
              (EMPTY? (TAIL (LIST ONE)))
              (EMPTY? (HEAD (LIST ONE))))
           (, "(L a b , b)" "(L h t , (L a b , b))" "(L b , b)" "(L a b , a)" "(L a b , b)" "(L a b , a)" "(L b , b)")))
; empty? with three arguments and empty? in cond should give same answer
(assert (= (EMPTY? (LIST) T F) (COND (EMPTY? (LIST)) T F)))
; length of the list
(assert (= (, (LEN (LIST) x y) (LEN (LIST ONE) x y) (LEN (LIST ONE TWO) x y))
           (, "y" "(x y)" "(x (x y))")))

More lists


In [16]:
(assert (= (HEAD (REVERSE (LIST ONE TWO)) x y)
           (TWO x y)))
(assert (= (HEAD (MAP SUCC (LIST ONE TWO)) x y)
           (TWO x y)))
(assert (= (APPLY SUM (LIST ONE TWO) a b) 
           (THREE a b)))
(assert (= (, (HEAD (LIST* TWO ONE TWO) x y) (HEAD (TAIL (LIST* TWO ONE TWO)) x y))
           (, (ONE x y) (TWO x y))))
(assert (= (FOLD-LEFT SUM ZERO (LIST ONE TWO) x y) 
           (THREE x y)))
(assert (= (FOLD-RIGHT SUM ZERO (LIST ONE TWO) x y) 
           (THREE x y)))
(assert (= (, (HEAD (EXTEND (LIST ONE) (LIST TWO)) x y) (HEAD (TAIL (EXTEND (LIST ONE) (LIST TWO))) x y))
           (, (ONE x y) (TWO x y))))

Let and Let*


In [17]:
(assert (= (LET a 1 b 2 d 3 (a b c d)) "(1 2 c 3)"))
(assert (= (LET a 1 (a a (L a , a 2))) "(1 1 2)"))
(assert (= (LET a 1 b a (a b)) "(1 a)"))
(assert (= (LET a 1 c (a b) (LET b a c)) "(a 1)"))
(assert (= (LET* a 1 c (a b) (LET b a c)) "(1 1)"))
(assert (= (LET a 1 c (LET b a c) (a b)) "(1 b)"))
(assert (= (LET a 1 b (a b) b) "(a b)"))
(assert (= (LET a 1 (LET b a (a b))) "(1 1)"))
(assert (= (LET* a 1 b a (a b)) "(1 1)"))
(assert (= (LET x) "x"))
(assert (= (LET* x) "x"))
(assert (= (LET) None))
(assert (= (LET*) None))

Do structure with lets


In [18]:
; similar to let*
(assert (= (DO (LET a 1) (LET b 2) (LET c (a b)) (a b c d))  "(1 2 (1 2) d)"))
; all trues
(assert (L , (COND (DO (TRUE) (TRUE) (TRUE) (TRUE)) TRUE FALSE) "(L a b , a)"))
; all but one trues
(assert (L , (COND (DO (TRUE) (TRUE) (TRUE) (FALSE)) TRUE FALSE) "(L a b , b)"))

Boolean / connective tests


In [19]:
; not 
(assert (= (, (NOT TRUE T F) (NOT FALSE T F)) (, 'F 'T)))
; and 
(assert (=
  (, (AND TRUE TRUE T F) (AND TRUE FALSE T F)
     (AND FALSE TRUE T F) (AND FALSE FALSE T F))
  (, 'T 'F 'F 'F)))
; or 
(assert (=
  (, (OR TRUE TRUE T F) (OR TRUE FALSE T F)
     (OR FALSE TRUE T F) (OR FALSE FALSE T F))
  (, 'T 'T 'T 'F)))
; exlusive or 
(assert (= 
  (, (XOR TRUE TRUE T F) (XOR TRUE FALSE T F)
     (XOR FALSE TRUE T F) (XOR FALSE FALSE T F))
  (, 'F 'T 'T 'F)))
; implies
(assert (= 
  (, (IMP TRUE TRUE T F) (IMP TRUE FALSE T F)
     (IMP FALSE TRUE T F) (IMP FALSE FALSE T F))
  (, 'T 'F 'T 'T)))
; equivalence
(assert (= 
  (, (EQV TRUE TRUE T F) (EQV TRUE FALSE T F)
     (EQV FALSE TRUE T F) (EQV FALSE FALSE T F))
  (, 'T 'F 'F 'T)))
; logic condition
(assert (= (COND (AND (NOT (XOR FALSE FALSE)) (OR TRUE FALSE)) T F) 'T))
; eval read str
(assert (= (eval (read-str "(TRUE)")) "(L a , (L b , a))"))

Numeric equivalence tests


In [20]:
; lesser or equal
(assert (= (, (LEQ? ONE TWO T F) (LEQ? TWO ONE T F)  (LEQ? ONE ONE T F) )
           (, 'T 'F 'T)))
; greater or equal
(assert (= (, (GEQ? ONE TWO T F) (GEQ? TWO ONE T F)  (GEQ? ONE ONE T F) )
           (, 'F 'T 'T)))
; equals
(assert (= (, (EQ? ONE TWO T F) (EQ? TWO ONE T F)  (EQ? ONE ONE T F) )
           (, 'F 'F 'T)))
; lesser
(assert (= (, (LE? ONE TWO T F) (LE? TWO ONE T F)  (LE? ONE ONE T F) )
           (, 'T 'F 'F)))
; greater
(assert (= (, (GE? ONE TWO T F) (GE? TWO ONE T F)  (GE? ONE ONE T F) )
           (, 'F 'T 'F)))
; is number?
(assert (= (, (NUM? TRUE T F) (NUM? ZERO T F) (NUM? ONE T F) (NUM? (LIST) T F) (NUM? (LIST ONE) T F))
           (, "(L b , b)" 'T "(L b , F)" 'T "(L a b , b)")))

Math operations


In [21]:
; math operations
; next, inc, successive
(assert (= (SUCC ONE x y) "(x (x y))"))
; infix notation
(assert (= (ONE SUCC ONE SUCC ONE x y) "(x (x (x y)))"))
; previous, dec, predecessive
(assert (= (PRED THREE) "(L x , (L y , (L x y , (x (x (x y))) (L g h , (h (g x))) (L x , y) (L a , a))))"))
; previous, dec, predecessor, with arguments
(assert (= (PRED THREE a b) "(a (a b))"))
; sequenced predecessor
(assert (= (PRED PRED PRED FOUR x y) "(x y)"))
; nested predecessor
(assert (= (PRED (PRED (PRED FOUR)) x y) "(x y)"))
; previous + next is same
(assert (= (SUCC (PRED TWO) x y) "(x (x y))"))
; previous + next is same for zero
(assert (= (PRED (SUCC ZERO) x y) 'y))
; but previous + next is one for zero!
(assert (= (SUCC (PRED ZERO) x y) "(x y)"))
; sum two values
(assert (= (SUM TWO TWO x y) "(x (x (x (x y))))"))
; substract two x from y
(assert (= (, (SUB ONE TWO x y) (SUB ONE ONE x y) (SUB TWO ONE x y))
           (, "(x y)" 'y 'y)))
(assert (= (, (EXP TWO TWO x y) (EXP TEN ZERO x y) (EXP ZERO ZERO x y))
           (, "(x (x (x (x y))))" "(x y)" "(x y)")))
(assert (= (, (PROD ZERO ONE a b) (PROD ONE ONE a b) (PROD TWO TWO a b))
           (, 'b "(a b)" "(a (a (a (a b))))")))

Self application


In [22]:
; self application
(assert (= (SELF (L x , x) 1) 1))
; self application, fixed point
;count down to zero
(assert (= (SELF (L f n , (COND (ZERO? n) ZERO (f f (PRED n)))) THREE) "(L x y , y)"))
; count down to one with lesser or equal comparison
(assert (= (SELF (L f n , (COND (LEQ? n ONE) n (f f (PRED n)))) FOUR x y) "(x y)"))
; count down to one with equal comparison
(assert (= (SELF (L f n , (COND (EQ? n ONE) n (f f (PRED n)))) FOUR x y) "(x y)"))

Sample math functions


In [23]:
; summation sequence, with plain number
(assert (= (SUMMATION (L x y , (x (x (x y)))) x y) "(x (x (x (x (x (x y))))))"))
; summation sequence, with number macro form
(assert (= (SUMMATION THREE x y) "(x (x (x (x (x (x y))))))"))
; product sequence, with plain number
(assert (= (FACTORIAL (L x y , (x (x (x y)))) x y) "(x (x (x (x (x (x y))))))"))
; product sequence, with number macro form
(assert (= (FACTORIAL THREE x y) "(x (x (x (x (x (x y))))))"))
; fibonacci, with plain number
(assert (= (FIBONACCI (L x y , (x (x (x (x (x y)))))) x y) "(x (x (x (x (x y)))))"))
; fibonacci, with number macro form
(assert (= (FIBONACCI FIVE x y) "(x (x (x (x (x y)))))"))

Self application recursive loop


In [24]:
(setv result (L x , (x x) (L x , (x x))))
(assert (none? result))


Recursion error occured for lambda expression:  (x x)

In [25]:
(SUMMATION (NUM 8) x y)


Out[25]:
'(x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x y))))))))))))))))))))))))))))))))))))'

In [26]:
(FIBONACCI (NUM 7) x y)


Out[26]:
'(x (x (x (x (x (x (x (x (x (x (x (x (x y)))))))))))))'

In [27]:
; requires alpha conversion and macros, or will cause recursion error!
(with-alpha-conversion-and-macros L , )
(FACTORIAL (NUM 5) x y)


Out[27]:
'(x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x y))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))'

The MIT License

Copyright (c) 2017 Marko Manninen