;;TEST-SUBMODEL.SCM                     Nov. 1, 2000 (revised May 27 , 2003)


;(new-submodel)
;(resume-submodel)
(define sse show-submodel-environment)
(sse)

(define (dec n) (- n 1))
(define (inc n) (+ n 1))

(dec (dec 3))

(define lint
  (lambda (n)
    (cond
     ((< n 0) '())
     (else (cons n (lint (dec n)))))))

;(lint 2)
(lint 3)
;Final value after 63 steps:
;(list 3 2 1 0)
;which Scheme would print as:
;(3 2 1 0)

#|
(define (map f l)
  (if (null? l)
      '()
      (cons (f (car l)) (map f (cdr l)))))
|#

(define (make-state-machine state next-state-proc output-proc)
  (lambda (input)
    (let ((output (output-proc input state)))
      (begin
        (set! state (next-state-proc input state))
        output))))

(define (member x l)
  (cond ((null? l) #f)
        ((equal? x (car l)) l)
        (else (member x (cdr l)))))

(define learner
  (make-state-machine
   '() cons
   (lambda (input state)
     (if (member input state)
         "seen you before"
         "hello"))))

(learner 'a)

(learner '(a))

(map learner (list '() '() ((lambda () 'a))))

;learner with procedure as state

#|
The value of the combination  (REMEMBER INPUT INPUT-HISTORY-PRED)
will be a predicate which is the same as INPUT-HISTORY-PRED except
the predicate will also return #t when its argument has the same
value as INPUT:
|#

(define (remember input input-history-pred)
  (lambda (future-input)
    (or (eq? future-input input)
        (input-history-pred future-input))))

(define politician
  (make-state-machine
   (lambda(input) #f)                   ;initially return #f for any input
   remember                             ;update input-history-pred to "remember" the current input
   (lambda (voter input-history-pred)	
     (if (input-history-pred voter)
         (list 'nice 'ta 'see 'ya 'again voter)
         (list 'pleased 'ta 'meet 'ya voter)))))

(politician 'tom)
;Value: (pleased ta meet ya tom)

(politician 'tom)
;Value: (nice ta see ya again tom)

(politician 'dick)
;Value: (pleased ta meet ya dick)

(politician 'tom)
;Value: (nice ta see ya again tom)

(politician 'harry)
;Value: (pleased ta meet ya harry)

(politician 'dick)
;Value: (nice ta see ya again dick)



(define
  (y f)
  ((lambda (x) (f (lambda (z) ((x x) z))))
   (lambda (x) (f (lambda (z) ((x x) z))))))

(define (factdef fact)
  (lambda (n)
    (if (<= n 0)
        1
        (* n (fact (- n 1))))))

(define y-fact (y factdef))

;(y-fact 1)
;(y-fact 2)
;(y-fact 4)
;Final value after 87 steps:
;24

(define factorial
  ((lambda (y fact-improver) (y fact-improver))
   (lambda (f)
     ((lambda (x) (f (lambda (z) ((x x) z))))
      (lambda (x) (f (lambda (z) ((x x) z))))))
   (lambda (fact)
     (lambda (n)
       (if (<= n 0)
           1
           (* n (fact (- n 1))))))))


(define (Y2 f)
  ((lambda (x) (f (lambda(z1 z2) ((x x) z1 z2))))
   (lambda (x) (f (lambda(z1 z2) ((x x) z1 z2))))))

(define (y-iter-fact n)
  ((Y2 (lambda (iter)
         (lambda (n result)
           (if (<= n 0)
               result
               (iter (- n 1) (* n result))))))
   n 1))

;(y-iter-fact 3)
;Final value after 92 steps:
;6

(define (empty-set n) #f)

(define (put element set)
  (lambda (possible-element)
    (if (equal? possible-element element)
        #t
        (set possible-element))))

;((put 2 (put 4 (put 6 empty-set))) 4)
;Final value after 59 steps:
;#t
;((put 2 (put 4 (put 6 empty-set))) 1)
;Final value after 114 steps:
;#f

;((put 2 (put (lambda (y) y) empty-set)) (lambda (z) z))
;Final value after 53 steps:
;#f
;with NEW-SM.SCM:
;Final value after 43 steps:
;#t

(define pair cons)
;(define (pair l r) (lambda (p) (p l r)))

(define left car)
;(define left (lambda (p) (p (lambda (x y) x))))

(define right cdr)
;(define right (lambda (p) (p (lambda (x y) y))))

(define (leaf? tree) (or (number? tree) (symbol? tree) (boolean? tree)))

(define (map-tree f tree)
  (letrec ((t->ft
            (lambda (tree continue)
              (if (leaf? tree)
                  (continue (f tree))
                  (t->ft
                   (left tree)
                   (lambda (a)
                     (t->ft
                      (right tree)
                      (lambda (d) (continue (pair a d))))))))))
    (t->ft tree (lambda (x) x))))

(define (tree->list tree)
  (if (leaf? tree)
      tree
      (list (tree->list (left tree))
            (tree->list (right tree)))))

;(tree->list (pair 1 (pair 3 44)))
;Final value after 156 steps:
;(list 1 (list 3 44))
;which Scheme would print as:
;(1 (3 44))

;(pair (pair (pair 2 5) 9) (pair 3 44))
;(tree->list (map-tree dec (pair 1 (pair 3 44))))
;(map-tree dec (pair (pair (pair 2 5) 9) (pair 3 44)))

(apply
    (lambda (x1 x2 x3 x4 x5)
      (list
       (cons 'x1 x1)
       (cons 'x2 x2)
       (cons 'x3 x3)
       (cons 'x4 x4)
       (cons 'x5 x5)))
    (letrec ((map
              (lambda (f l)
                (if (null? l)
                    '()
                    (cons (f (car l)) (map f (cdr l)))))))
      (map
       (lambda (l) (cdr (cdr l)))
       '((a 0 1 2)
         (b 3 4)
         (will disappear)
         (end end end)
         (gone entirely)))))
;Final value after 123 steps:
;(list (list (quote x1) 1 2)
;      (list (quote x2) 4)
;      (list (quote x3))
;      (list (quote x4) (quote end))
;      (list (quote x5)))
;which Scheme would print as:
;((x1 1 2) (x2 4) (x3) (x4 end) (x5))


(list
 sin
 (lambda(z) (lambda (y) (y (inc z) w)))
 (lambda (z) z)
 (lambda(z)
   (cons ((lambda (a b) (let ((c 1)) (lambda () (cons c a b))))
          z
          'symb)
         (cons
          'b
          (lambda(z w)
            (letrec ((f (lambda (x) ((f z) (z x))))) (f (z w))))))))

(define (fib n)
      (if (< n 2)
          n
          (+ (fib (- n 1)) (fib (- n 2)))))
;(fib 3)

(define x 200)
(let ((x 0))
  (and (set! x 3) ((lambda () (begin (set! x (+ 4 x)) x)))))

(display 3)
(begin (display 3) (display "tqo") (newline) (display 'did-newline?))

(define a 'dummy)
(let ((c 5))
  (begin
    (if (if + #t #f) "albert" 'delay)
    (set! a (lambda () c))
    (display "the list is coming")
    (newline)
    (display (list a (a) "meyer"))
    (list a (a) "meyer")))
;Final value after 23 steps:
(list (lambda #f c_6) 5 "meyer")
;which Scheme would print as:
;(#[compound-procedure 15] 5 "meyer")
;The evaluation generated the display:
;the list is coming
;(list (lambda () c_6) 5 meyer)


(define (try expr alt)    ;expr = (lambda (fail) body)   alt = (lambda () alt-body)
  (call/cc
   (lambda (k)
     (expr (lambda () (k (alt)))))))

(define (try-test x y)
  (try (lambda (fail) (list x y (cond ((zero? y) (fail)) (else 'ok))))
       (lambda () 'caught-fail)))

(try-test 1 2)
;Final value after 20 steps:
;(list 1 2 (quote ok))
;which Scheme would print as:
;(1 2 ok)

(try-test 1 0)
;Final value after 29 steps:
;(quote caught-fail)
;which Scheme would print as:
;caught-fail

(define cons-a 'dummy)
(cons 'a (call/cc (lambda (k) (set! cons-a k))))

(cons-a '(b))

(cons-a (cons-a '(b)))

(pair? (lambda () 1))

(symbol? 'a)
(symbol? ''a)
(symbol? a)

(append `((1 2) ,(append '() `(3))) '(5 '()))
;Final value after 52 steps:
;(list (list 1 2) (list 3) 5 (list (quote quote) #f))
;which Scheme would print as:
;((1 2) (3) 5 (quote #f))

(define (show-graph-search node-info nodes pred?)
  (let ((num-node-visits 0)
        (num-done 0)
        (num-good 0))
    (letrec
        ((aux-show
          (lambda (to-do done good)
            (begin
              (newline)
              (display `(,num-node-visits ,num-done ,num-good))
              (newline)
              (if (nonempty? to-do)
                  (let ((node (select to-do)))
                    (begin
                      (set! num-node-visits (+ num-node-visits 1))
                      (if (element-of? node done)
                          (aux-show (delete node to-do) done good)
                          (let ((nhbrs&label (node-info node)))
                            (let ((neighbors (car nhbrs&label))
                                  (label (cdr nhbrs&label)))
                              (begin
                                (set! num-done (+ num-done 1))
                                (aux-show (adjoin-list neighbors (delete node to-do))
                                          (adjoin node done)
                                          (if (pred? label)
                                              (begin
                                                (set! num-good (+ num-good 1))
                                                (display (list 'GOODNODE: node))
                                                (newline)
                                                (adjoin node good))
                                              good))))))))
                  good)))))
      (begin
        (display '(number-of-node-visits number-of-distinct-nodes number-of-good))
        (newline)
        (set->list
         (aux-show
          (adjoin-list nodes (emptyset))
          (emptyset)
          (emptyset)))))))

                                ;;SETS AS LISTS

(define (adjoin element set)
  (if (member element set)
      set
      (cons element set)))
(define (adjoin-list ls set)
  (if (pair? ls)
      (adjoin-list (cdr ls) (adjoin (car ls) set))
      set))
(define (emptyset) '())
(define nonempty? pair?)
(define (element-of? el set) (and (member el set) #t))
(define (member x l)
  (cond ((null? l) #f)
        ((equal? x (car l)) l)
        (else (member x (cdr l)))))
(define select car)
(define (delete obj ls)      ;remove first occurrence, if any, of OBJ from LS
  (if (pair? ls)
      (if (equal? obj (car ls))
          (cdr ls)
          (cons (car ls) (delete obj (cdr ls))))
      ls))
(define (set->list set) set)

(define (node-info node) (cons (if (pair? node) node '()) node))

(show-graph-search node-info '(1) (lambda (x) #t))
(show-graph-search node-info '(1 2) (lambda (x) #t))

(delete 1 (adjoin-list '(2 1 0) (emptyset)))


(show-graph-search node-info '() (lambda (x) #t))
;Final value after 52 steps:
;#f
;The evaluation generated the display:
;(list (quote number-of-node-visits) (quote number-of-distinct-nodes) (quote number-of-good))

;(list (quote num-node-visits) (quote num-done) (quote num-good))


(show-graph-search node-info '(1 (2)) (lambda (x) #t))
;Final value after 1001 steps:
;(list 1 2 (list 2))
;which Scheme would print as:
;(1 2 (2))
;The evaluation generated the display:
;(list (quote number-of-node-visits) (quote number-of-distinct-nodes) (quote number-of-good))

;(list 0 0 0)
;(list (quote goodnode:) (list 2))

;(list 1 1 1)
;(list (quote goodnode:) 2)

;(list 2 2 2)
;(list (quote goodnode:) 1)

;(list 3 3 3)

(procedure? 1)
(procedure? '(lambda () 3))
(procedure? (lambda () 3))

(eq? 'a 2)
(eq? (lambda (x) x) (lambda (y) y))
(eq? (lambda (x) x) (lambda (x_0) x_0))
(eq? (lambda (x) (car (list x))) (lambda (x) x))
(exit)

(letrec ((d (lambda (x) (if (< x 1) x (e (e (dec x))))))
	 (e (lambda (x) (dec (d x)))))
  (d 2))
;Final value after 82 steps:
;-4

(letrec ((d (lambda (x)
	      (begin (display x)
		     (if (< x 1) x (dec (d  (dec (d (dec x)))))))))
	 (e (lambda (x) (dec (d x)))))
  (d 2))
;Final value after 86 steps:
;-4
;The evaluation generated the display:
;210-1-3

(letrec ((d (lambda (x)
	      (begin (display x)
		     (if (< x 1) x (dec (d  (dec (d (dec x))))))))))
  (d 4))
;Final value after 160 steps:
;-8
;The evaluation generated the display:
;43210-1-3-5-7

((lambda l l) 1 2 3)

(define map
  (letrec ((map1 (lambda (f l)
		   (if (null? l)
		       '()
		       (cons (f (car l)) (map1 f (cdr l)))))))
    map1))

(define map2
  (letrec ((map1
	    (lambda (f l)
	      (if (null? l)
		  '()
		  (cons (f (car l)) (map1 f (cdr l)))))))
    (lambda args
      (if (pair? args)
	  (let ((l (cdr args)))
	    (if (pair? l)
		(let ((f (car args))
		      (l1 (car l))
		      (ls (cdr l)))
		  (if (null? ls)
		      (map1 f l1)
		      (cons (apply f (map2 car l))
			    (apply map (cons f (map2 cdr l))))))
		(apply error (cons "MAP--no list arg: " args))))
	  (error "MAP--no args ")))))

(map2 list)

;CNVG?
(and (cnvg? (+ 1 2) (- 3 4))
     (cnvg? ((lambda (x) (x x)) (lambda (y) (y y)))
            (cnvg? (+ 1 (+ 1 1)) (+ 0 10000))))

(cnvg? (cnvg?)
       dummy2
       ((lambda (x) (x x)) (lambda (y) (y y)))
       (cnvg? (cons)
	      (letrec ((spin (lambda () (spin)))) (spin))
	      (cnvg? dummy)))