;;;  Primitive Functions Test
;;;
;;;  File:		test-primitives.in
;;;  Author:		course
;;;  Version:		1

; Turn off gc
;
(set-gc-limit 10000000)

;; FIXNUMS

(+)		; Should be 0

(+ 13)		; Should be 13

(+ 9 5)		; Should be 14

(+ 1 2 3 4 5)	; Should be 15

(- 16)		; Should be -16

(- 25 9)	; Should be 16

(- 15 5 4 3 2 1)	; Should be 0

(*)		; Should be 1

(* 44)		; Should be 44

(* 9 6)		; Should be 54

(* 2 2 2 2 4)	; Should be 64

(floor 11 4)	; Should be 2

(floor 12 4)	; Should be 3

(floor 13 4)	; Should be 3

(floor -11 4)	; Should be -3

(floor -12 4)	; Should be -3

(floor -13 4)	; Should be -4

(mod 11 4)	; Should be 3

(mod 12 4)	; Should be 0

(mod 13 4)	; Should be 1

(mod -11 4)	; Should be 1

(mod -12 4)	; Should be 0

(mod -13 4)	; Should be 3

(expt 2 3)	; Should be 8

(expt 3 2)	; Should be 9

(expt 2 10)	; Should be 1024

(expt -2 10)	; Should be 1024

(expt -2 11)	; Should be -2048

(fixnump 1)	; Should be T

(fixnump 'X)	; Should be NIL

(fixnump '(X . Y))	; Should be NIL

(fixnump (symbol-function '+))	;Should be NIL

(< 3 4)		; Should be T

(< 4 4)		; Should be NIL

(< 5 4)		; Should be NIL

(= 3 4)		; Should be NIL

(= 4 4)		; Should be T

(= 5 4)		; Should be NIL

;; SYMBOLS

(symbolp 'x)	; Should be T

(symbolp 9)	; Should be NIL

(symbolp '(x . y))	; Should be NIL

(symbolp (symbol-function '+))	; Should be NIL

'x		; Should be X

(boundp 'x)	; Should be NIL

(symbol-value 'x)	; Should be unbound error

(set 'x 5)	; Should be 5

(boundp 'x)	; Should be T

x		; Should be 5

(symbol-value 'x)	; Should be 5

(setq x 9)	; Should be 9

x		; Should be 9

(symbol-value 'x)	; Should be 9

(symbol-function 'x)	; Should be unbound error

			; Should be
(symbol-function '+)	; #<primitive function>

(x 1 2 3)	; Should be unbound function error

(set-symbol-function 'x (symbol-function '+))

(x 1 2 3)	; Should be 6

(symbol-plist 'x)	; Should be NIL

(set-symbol-plist 'x '(b 99))	; Should be (B 99)

(symbol-plist 'x)	; Should be (B 99)

;; CONSES

(consp 'x)	; Should be NIL

(consp 9)	; Should be NIL

(consp '(x . y))	; Should be T

(consp (symbol-function '+))	; Should be NIL

(cons 'x 'y)	; Should be (X . Y)

(car (cons 'x 'y))	; Should be X

(cdr (cons 'x 'y))	; Should be Y

(setq x (cons '1 2))	; Should be (1 . 2)

(rplaca x 'b)		; Should be (B . 2)

x			; Should be (B . 2)

(rplacd x 'c)		; Should be (B . C)

x			; Should be (B . C)

;; PRIMITIVE FUNCTIONS

(primitive-functionp 'x)	; Should be NIL

(primitive-functionp 9)		; Should be NIL

(primitive-functionp '(x . y))	; Should be NIL

				; Should be T
(primitive-functionp (symbol-function '+))

				; Should be NIL
(special-primitivep (symbol-function '+))

				; Should be T
(special-primitivep (symbol-function 'cond))

;; CONDITIONALS

(eql 100000000 100000000)	; Should be T

(eql -1 (- 1))	; Should be T

(eql 1 'x)	; Should be NIL

(eql 1 '(1 . 1))	; Should be NIL

(eql 1 (symbol-function '+))	; Should be NIL

(eql 'x 'x)	; Should be T

(eql 'x 'y)	; Should be NIL

(eql 'x '(x . x))	; Should be NIL

(eql 'x (symbol-function '+))	; Should be NIL

(eql (cons 1 2) (cons 1 2) )	; Should be NIL

(setq x (cons 1 2))

(eql x x)	; Should be T

(eql
  (symbol-function '+)
  (symbol-function '+))	; Should be T

(eql
  (symbol-function '+)
  (symbol-function '-))	; Should be NIL

(cond (nil 1) (t 2))	; Should be 2

(cond (t 1) (nil 2))	; Should be 1

(cond (t 1) (t 2))	; Should be 1

(cond ((= 2 5) 1) (t 2))	; Should be 2

(cond ((= 2 02) 1) (nil 2))	; Should be 1

(cond ((= 02 2) 1) (t 2))	; Should be 1


;; OUTPUT

		; Should print 5 blank lines
(cond (t (terpri) (terpri) (terpri) (terpri) (terpri)))

		; Should print XXX on one line
(cond (t (princ 'x) (princ 'x) (princ 'x) (terpri)))

		; Should print xx on one line
(cond (t (princ '|x|) (princ '|x|) (terpri)))

(error '|This is a TEST, and ONLY a test!|)


;; EVALUATORS


(eval '(+ 1 2 3 4 5))	; Should be 15

		    ; Should be #<primitive function>
(eval (cons 'quote (cons (symbol-function '+) nil)))


#'+		; Should be #<primitive function>

(funcall #'+)	; Should be 0

(funcall #'+ 1 2 3 4 5)	; Should be 15

(apply #'+ nil)	; Should be 0

(apply #'+ '(1 2 3 4 5))	; Should be 15

(apply #'+ 1 2 '(3 4 5))	; Should be 15

(apply #'+ 1 2 3 4 5 nil)	; Should be 15

(funcall #'(lambda (x) (* x x)) 5)	; Should be 25

(set-symbol-function 'square
  #'(lambda (n) (* n n)))

(square 3)		; Should be 9

(square 5)		; Should be 25

(set-symbol-function 'integers-from
  #'(lambda (n)
     (cons n #'(lambda ()
	        (integers-from (+ n 1))))))

(setq nat (integers-from 0))	; Should be (0 ...)

(setq nat (funcall (cdr nat)))	; Should be (1 ...)

(setq nat (funcall (cdr nat)))	; Should be (2 ...)

(set-symbol-function 'random-sum
  #'(lambda (n)
	    (cond
	     ((= n 0) 0)
	     (t (+ (random 2) (random-sum (- n 1)))))))

(random-sum 400)    ; Should be between 120 and 280

			; Should be (1 2 3 4 5)
(funcall #'(lambda (&rest x) x) 1 2 3 4 5)

			; Should be (3 4 5)
(funcall #'(lambda (x y &rest z) z) 1 2 3 4 5)

;; MACROS

(set-symbol-function 'foo
  '(macro (x) (cons 'bar
		    (cons (cons '+
				(cons x
				      (cons 1 nil)))
			  nil))))

(set-symbol-function 'bar
  '(macro (x) (cons 'foo
		    (cons (cons '-
				(cons x
				      (cons 1 nil)))
			  nil))))

(setq e '(foo 9))

(setq e (macroexpand-1 e))	; Should be (BAR ...)

(setq e (macroexpand-1 e))	; Should be (FOO ...)

(setq e (macroexpand-1 e))	; Should be (BAR ...)

(setq e (macroexpand-1 e))	; Should be (FOO ...)

'DONE