klisp-rust/guess at main · kathe/klisp-rust · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
; Animal guessing game
; To save the database, write
; it to an image file, e.g
; (suspend 'animals)

(setq db
  '((does it live in the water)
    ((is it a mammal)
     (dolphin)
     ((is it a beast of prey)
      (octopus)
      (starfish)))
    ((can it fly)
     ((is it an insect)
      ((does it have a stinger)
       (bee)
       (butterfly))
      ((does it live in a swarm)
       (crow)
       (dove)))
     ((is it a pet animal)
      ((does it chase balls of wool)
       (cat)
       ((does it bark)
        (dog)
        (goldfish)))
      (cow)))))

(setq terpri
  (lambda ()
    (print '/ )))

(setq readln
  (lambda ()
    (loop n ((a nil)
             (w (read)))
      (if (eq w 'q)
          (nrever a)
          (n (cons w a) (read))))))

(setq prins
  (lambda (s)
    (cond ((null s))
          ((null (cdr s))
            (prin1 (car s)))
          (else
            (prin (car s))
            (prins (cdr s))))))

(setq prints
  (lambda (s)
    (prins s)
    (terpri)))

(setq yesno
  (lambda ()
    (let ((a (memb (read) '(y yes))))
      (terpri)
      a)))

(setq giveup
  (lambda (db)
    (prints '(ok i give up/! what is it/? /(only one word/!/)))
    (let ((b (read)))
      (terpri)
      (prins '(enter a question that distinguishes a/ ))
      (prin b)
      (prins '(from a/ ))
      (print (car db))
      (prints '(end input with a Q on a blank line))
      (let ((q (readln)))
        (terpri)
        (prins '(what is the answer for a/ ))
        (prin1 b)
        (print '/?)
        (if (yesno)
            (setcdr db (list (list b) (list (car db))))
            (setcdr db (list (list (car db)) (list b))))
        (setcar db q)))))

(setq gotit
  (lambda (db)
    (prins '(is it a/ ))
    (prin1 (car db))
    (print '/?)
    (if (yesno)
        (print 'cool/!)
        (giveup db))))

(setq choose
  (lambda (db)
    (prins (car db))
    (print '/?)
    (if (yesno)
        (cadr db)
        (caddr db))))

(setq try
  (lambda (db)
    (if (atom (car db))
        (gotit db)
        (try (choose db)))))

(setq guess
  (lambda ()
    (prints '(make sure verbose gc is off/!))
    (prints '(enter only letters and blanks/!))
    (terpri)
    (loop new ()
      (prints '(think of an animal/!))
      (try db)
      (prints '(one more time/?))
      (cond ((yesno)
              (new))
            (else
              (prints '(do not forget to save the database/!))
              (print 'goodbye/!)
              t)))))

(setq animals
  (lambda (db)
    (prin1 '/(/ )
    (loop next ((db db))
      (cond ((atom (car db))
              (prin (car db)))
            (else
              (next (cadr db))
              (next (caddr db)))))
   (print '/))
   t))