blob: 45ae2ea40f6c066d79c05ee1db3b59445e4fb76e (
plain)
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
|
(load "ghelper")
(load "discovery")
(define inverse
(make-generic-operator 1 #f 'inverse))
(define plus
(make-generic-operator 2 #f 'plus))
(define minus
(make-generic-operator 2 #f 'minus))
(assign-operation inverse
(lambda (x) (/ 1 x))
(lambda (x) (and (number? x)
(not (integer? x)))))
; actually a transpose, but meh
(assign-operation inverse
(lambda (x) (apply zip x))
(lambda (x)
(and (list? x)
(for-all? x list?))))
(define any? (lambda (x) #t))
(assign-operation minus - any? any?)
(assign-operation plus + any? any?)
(plus 1 2)
; 3
;(minus 3)
; ERROR
(inverse 6.5)
;Value: .15384615384615385
(discover:opers-for 6.5)
;Value 57: (#[compound-procedure 38 operator] thingaling)
(discover:named-opers-for 6.5)
;Value 58: (thingaling)
(discover:named-opers-for 1 2)
;Value 81: (plus minus)
;;; this stuff is just play crap
(car (hash-table->alist *generic-operator-table*))
(caadr (hash-table/get *generic-operator-table* inverse #f))
(environment-bound-names (the-environment))
(environment-lookup (the-environment) 'inverse)
(inverse '( (1 2 3)
(0 1 2)
(0 0 1)))
(hash-table/get *generic-operator-table* inverse #f)
(hash-table/get *generic-operator-table* minus #f)
(hash-table-size *generic-operator-table*)
;Value: 92 ;this is for mechanics
;this prints all keys line by line
(for-each
(lambda (x) (newline)
(display x))
(hash-table/key-list *generic-operator-table*))
(define add1 (make-generic-operator 1 #f 'add1))
(define sub1 (make-generic-operator 1 #f 'sub1))
(define double (make-generic-operator 1 #f 'double))
(define square (make-generic-operator 1 #f 'square))
(define inverse (make-generic-operator 1 #f 'inverse))
(defhandler add1 (lambda (x) (+ x 1)) number?)
(defhandler sub1 (lambda (x) (- x 1)) number?)
(defhandler double (lambda (x) (* 2 x)) number?)
(defhandler square (lambda (x) (* x x)) number?)
(defhandler inverse (lambda (x) (/ 1 x)) (lambda (n)
(and (number? n)
(not (zero? n)))))
(add1 4)
;(sub1 'b)
(discover:apply-all 3)
(discover:satisfy (lambda (x) (eq? x 9)) (/ 1 2))
(discover:satisfy-sequence (lambda (x) (eq? x 9)) (/ 1 2))
(discover:satisfy-sequence (lambda (x) (eq? x 49)) (/ 5 6))
(square (sqrt 2))
(sqrt 2)
(square 3)
|
