;; Some examples of BlooP and FlooP programs
;;
;; To run this code, first open interpreter.scm in DrRacket and type (start),
;; then type (load-quietly "floop-defs.txt") at the interpreter prompt (==>).
;; Or type (load "floop-defs.txt") to see the code for each function.
;;
;;---------------------------------------------------------------------------

;; the shortest possible program
(define procedure "a" (b)
  (block 0 begin))

(define procedure "square" (n)
  (block 0 begin
	 (output <= (n * n))))

(define procedure "cube" (n)
  (block 0 begin
	 (output <= (n * n))
	 (output <= (output * n))))  ;; or (output <= (n * (n * n)))

(define procedure "right-triangle?" (a b c)
  (block 0 begin
  	 (if (((a * a) + (b * b)) = (c * c)) then
	     (output <= yes))))

;; alternative definition using square:
(define procedure "right-triangle?" (a b c)
  (block 0 begin
  	 (if (((square a) + (square b)) = (square c)) then
	     (output <= yes))))

(define procedure "two-to-the-three-to-the" (n)
  (block 0 begin
	 ((cell 0) <= 1)
	 (loop n times
	       (block 1 begin
		      ((cell 0) <= (3 * (cell 0)))))
	 ((cell 1) <= 1)
	 (loop (cell 0) times
	       (block 2 begin
		      ((cell 1) <= (2 * (cell 1)))))
	 (output <= (cell 1))))

;; alternative definition using power:
(define procedure "two-to-the-three-to-the" (n)
  (block 0 begin
	 (output <= (power 2 (power 3 n)))))

(define procedure "addup-odds" (n)
  (block 0 begin
  	 ((cell 0) <= 1)
	 (loop n times
	       (block 1 begin
		      (output <= (output + (cell 0)))
		      ((cell 0) <= ((cell 0) + 2))))))

(define procedure "factorial" (n)
  (block 0 begin
	 (output <= 1)
	 ((cell 0) <= 1)
	 (loop n times
	       (block 1 begin
		      (output <= (output * (cell 0)))
		      ((cell 0) <= ((cell 0) + 1))))))

;;---------------------------------------------------------------------------
;; built-ins: these functions run natively in Racket for speed

;(define procedure "power" (m n)
;  (block 0 begin
;	 (if (n = 0) then
;	     (block 1 begin
;		    (output <= 1)
;		    (quit block 0)))
;	 (output <= 1)
;	 (loop n times
;	       (block 2 begin
;		      (output <= (output * m))))))

;(define procedure "minus" (m n)
;  (block 0 begin
;	 (if (m < n) then
;	     (quit block 0))
;	 (loop at most (m + 1) times
;	       (block 1 begin
;		      (if ((output + n) = m) then
;			  (abort loop 1))
;		      (output <= (output + 1))))))

;(define procedure "remainder" (m n)
;  (block 0 begin
;	 (if (n = 0) then
;	     (quit block 0))
;	 (output <= m)
;	 (loop at most m times
;	       (block 1 begin
;		      (if (output < n) then
;			  (quit block 0))
;		      (output <= (minus output n))))))

;(define procedure "quotient" (m n)
;  (block 0 begin
;         (if (n = 0) then
;             (quit block 0))
;         ((cell 0) <= m)
;	 (output <= 0)
;         (loop at most m times
;               (block 1 begin
;                      (if ((cell 0) < n) then
;                          (quit block 0))
;                      ((cell 0) <= (minus (cell 0) n))
;                      (output <= (output + 1))))))

;;---------------------------------------------------------------------------

(define procedure "even?" (n)
  (block 0 begin
	 (if ((remainder n 2) = 0) then
	     (output <= yes))))

(define procedure "odd?" (n)
  (block 0 begin
	 (if ((remainder n 2) = 1) then
	     (output <= yes))))

;; alternative definition
(define procedure "odd?" (n)
  (block 0 begin
	 (if ((remainder n 2) = 0) then
	     (quit block 0))
	 (output <= yes)))

;; alternative definition
(define procedure "odd?" (n)
  (block 0 begin
	 (if ((even? n) = no) then
	     (output <= yes))))

;; alternative definition
(define procedure "odd?" (n)
  (block 0 begin
	 (if (not (even? n)) then
	     (output <= yes))))

;; alternative definition
(define procedure "odd?" (n)
  (block 0 begin
	 (output <= (not (even? n)))))

(define procedure "prime?" (n)
  (block 0 begin
	 (if (n < 2) then     ;; BUG: should be (n < 2)
	     (quit block 0))
	 ((cell 0) <= 2)
	 (loop at most (minus n 2) times
	       (block 1 begin
                      (if ((remainder n (cell 0)) = 0) then
			  (quit block 0))
		      ((cell 0) <= ((cell 0) + 1))))
	 (output <= yes)))

(define procedure "goldbach?" (n)
  (block 0 begin
  	 (if (not (even? n)) then   ;; added
	     (quit block 0))
	 ((cell 0) <= 2)
	 (loop at most n times
	       (block 1 begin
	       	      (print "testing" (cell 0) "and" (minus n (cell 0)))
		      (if ((prime? (cell 0)) and
			   (prime? (minus n (cell 0)))) then
			  (block 2 begin
				 (output <= yes)
				 (quit block 0)))
		      ((cell 0) <= ((cell 0) + 1))))))

(define procedure "power-of-ten?" (b)
  (block 0 begin
	 ((cell 0) <= 1)
	 (loop at most b times  ;; not a tight bound
	       (block 1 begin
		      (if ((cell 0) > b) then
			  (quit block 0))
		      (if ((cell 0) = b) then
			  (block 2 begin
				 (output <= yes)
				 (quit block 0)))
		      ((cell 0) <= ((cell 0) * 10))))))

(define procedure "count-digits" (n)
  (block 0 begin
	 ((cell 0) <= n)
	 (output <= 1)
	 (loop at most n times  ;; not a tight bound
	       (block 1 begin
		      (if ((cell 0) < 10) then
			  (quit block 0))
		      ((cell 0) <= (quotient (cell 0) 10))
		      (output <= (output + 1))))))

;;---------------------------------------------------------------------------
;; free loops (MU-LOOP)

(define procedure "count-forever" (n)  ;; n is ignored
  (block 0 begin
	 (output <= 1)
	 (mu-loop
	   (block 1 begin
		  (print output)
		  (output <= (output + 1))))))

(define procedure "count-up-to" (n)
  (block 0 begin
	 (output <= 1)
	 (mu-loop
	   (block 1 begin
		  (print output)
		  (output <= (output + 1))
		  (if (output = n) then
		      (abort loop 1))))))

(define procedure "wondrous?" (n)
  (block 0 begin
         (if (n = 0) then
             (quit block 0))
	 ((cell 0) <= 0)
         (mu-loop
          (block 1 begin
                 (print n)
                 (if (n = 1) then
                     (block 2 begin
                            (output <= yes)
			    (print "took" (cell 0) "steps")
                            (quit block 0)))
		 ((cell 0) <= ((cell 0) + 1))
                 (if (even? n) then
                     (block 3 begin
                            (n <= (quotient n 2))
                            (quit block 1)))
                 (n <= ((3 * n) + 1))))))

;; checks if the specified program contains the characters "MU-LOOP:"
(define procedure "has-free-loop?" (program-number)
  (block 0 begin
	 ((cell 0) <= program-number)
	 ((cell 1) <= 1000000000000000000000000)
	 ;; upper bound:
	 (loop at most (count-digits program-number) times
	 ;; tight bound:
	 ;;(loop at most ((quotient (count-digits program-number) 3) + 1) times
	       (block 1 begin
		      (if ((cell 0) = 0) then
			  (quit block 0))
		      (if ((remainder (cell 0) (cell 1)) = 913921949912915915916952) then
			  (block 2 begin
				 (output <= yes)
				 (quit block 0)))
		      ((cell 0) <= (quotient (cell 0) 1000))))))

;; examples:
;; (has-free-loop? (godel-number wondrous?)) => YES
;; (has-free-loop? (godel-number count-digits)) => NO
;; (has-free-loop? (godel-number has-free-loop?)) => NO

;;---------------------------------------------------------------------------
;; the Halting Problem

(define procedure "halts-on?" (program-number input)
  (block 0 begin
	 (print "determining whether program" program-number)
	 (print "halts when run on input" input)
	 (print "answer is:")
	 (print "...")
	 ; ... much more code would go here ...
	 (output <= yes)))

(define procedure "program-a" (n)
  (block 0 begin
	 (mu-loop
	   (block 1 begin
		  (quit block 0)))))

(define procedure "program-b" (n)
  (block 0 begin
	 (if (n > 1) then
	     (quit block 0))
	 (mu-loop
	  (block 1 begin))))

(define procedure "program-c" (n)
  (block 0 begin
	 (mu-loop
	  (block 1 begin))))

;; some examples of using halts-on?:
;; (halts-on? (godel-number program-a) 1) would return YES
;; (halts-on? (godel-number program-b) 1) would return NO
;; (halts-on? (godel-number program-b) 2) would return YES
;; (halts-on? (godel-number program-c) 1) would return NO
;; (halts-on? (godel-number wondrous?) 27) would return YES

(define procedure "wondrous-tester?" (n)
  (block 0 begin
	 ((cell 0) <= (godel-number wondrous?))
	 (if (halts-on? (cell 0) n) then
	     (output <= yes))))

(define procedure "paradox" (program-number)
  (block 0 begin
	 (if (not (halts-on? program-number program-number)) then
	     (quit block 0))
	 (mu-loop
	  (block 1 begin))))

;; (paradox (godel-number paradox)) would return ???

;;---------------------------------------------------------------------------