shen-ruby 0.10.0 → 0.11.0
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +4 -4
- data/.rspec +1 -0
- data/.travis.yml +9 -3
- data/Gemfile +1 -4
- data/HISTORY.md +16 -0
- data/MIT_LICENSE.txt +1 -1
- data/README.md +25 -26
- data/Rakefile +3 -11
- data/bin/shen_test_suite.rb +15 -3
- data/bin/srrepl +6 -8
- data/lib/shen_ruby.rb +6 -1
- data/lib/shen_ruby/converters.rb +23 -0
- data/lib/shen_ruby/version.rb +1 -1
- data/shen-ruby.gemspec +4 -1
- data/shen/lib/shen_ruby/shen.rb +49 -33
- data/shen/release/benchmarks/N_queens.shen +45 -45
- data/shen/release/benchmarks/README.shen +14 -14
- data/shen/release/benchmarks/benchmarks.shen +52 -52
- data/shen/release/benchmarks/einstein.shen +32 -32
- data/shen/release/benchmarks/interpreter.shen +219 -219
- data/shen/release/benchmarks/jnk.shen +193 -193
- data/shen/release/benchmarks/powerset.shen +10 -10
- data/shen/release/benchmarks/prime.shen +10 -10
- data/shen/release/benchmarks/short.shen +129 -129
- data/shen/release/k_lambda/core.kl +181 -181
- data/shen/release/k_lambda/declarations.kl +131 -131
- data/shen/release/k_lambda/load.kl +84 -84
- data/shen/release/k_lambda/macros.kl +112 -112
- data/shen/release/k_lambda/prolog.kl +252 -252
- data/shen/release/k_lambda/reader.kl +222 -222
- data/shen/release/k_lambda/sequent.kl +166 -166
- data/shen/release/k_lambda/sys.kl +271 -271
- data/shen/release/k_lambda/t-star.kl +139 -139
- data/shen/release/k_lambda/toplevel.kl +135 -135
- data/shen/release/k_lambda/track.kl +103 -103
- data/shen/release/k_lambda/types.kl +324 -324
- data/shen/release/k_lambda/writer.kl +105 -105
- data/shen/release/k_lambda/yacc.kl +113 -113
- data/shen/release/test_programs/Chap13/problems.txt +26 -26
- data/shen/release/test_programs/README.shen +52 -52
- data/shen/release/test_programs/TinyLispFunctions.txt +15 -15
- data/shen/release/test_programs/TinyTypes.shen +55 -55
- data/shen/release/test_programs/binary.shen +24 -24
- data/shen/release/test_programs/bubble_version_1.shen +28 -28
- data/shen/release/test_programs/bubble_version_2.shen +22 -22
- data/shen/release/test_programs/calculator.shen +21 -21
- data/shen/release/test_programs/cartprod.shen +23 -23
- data/shen/release/test_programs/change.shen +25 -25
- data/shen/release/test_programs/classes-defaults.shen +94 -94
- data/shen/release/test_programs/classes-inheritance.shen +100 -100
- data/shen/release/test_programs/classes-typed.shen +74 -74
- data/shen/release/test_programs/classes-untyped.shen +46 -46
- data/shen/release/test_programs/depth_.shen +14 -14
- data/shen/release/test_programs/einstein.shen +34 -34
- data/shen/release/test_programs/fruit_machine.shen +46 -46
- data/shen/release/test_programs/interpreter.shen +217 -217
- data/shen/release/test_programs/metaprog.shen +85 -85
- data/shen/release/test_programs/minim.shen +192 -192
- data/shen/release/test_programs/mutual.shen +11 -11
- data/shen/release/test_programs/n_queens.shen +45 -45
- data/shen/release/test_programs/newton_version_1.shen +33 -33
- data/shen/release/test_programs/newton_version_2.shen +24 -24
- data/shen/release/test_programs/parse.prl +14 -14
- data/shen/release/test_programs/parser.shen +51 -51
- data/shen/release/test_programs/powerset.shen +10 -10
- data/shen/release/test_programs/prime.shen +10 -10
- data/shen/release/test_programs/prolog.shen +78 -78
- data/shen/release/test_programs/proof_assistant.shen +80 -80
- data/shen/release/test_programs/proplog_version_1.shen +25 -25
- data/shen/release/test_programs/proplog_version_2.shen +27 -27
- data/shen/release/test_programs/qmachine.shen +66 -66
- data/shen/release/test_programs/red-black.shen +54 -54
- data/shen/release/test_programs/search.shen +55 -55
- data/shen/release/test_programs/semantic_net.shen +44 -44
- data/shen/release/test_programs/spreadsheet.shen +34 -34
- data/shen/release/test_programs/stack.shen +27 -27
- data/shen/release/test_programs/streams.shen +20 -20
- data/shen/release/test_programs/strings.shen +57 -57
- data/shen/release/test_programs/structures-typed.shen +71 -71
- data/shen/release/test_programs/structures-untyped.shen +41 -41
- data/shen/release/test_programs/tests.shen +232 -232
- data/shen/release/test_programs/types.shen +11 -11
- data/shen/release/test_programs/whist.shen +239 -239
- data/shen/release/test_programs/yacc.shen +132 -132
- data/spec/shen_ruby/converters_spec.rb +48 -0
- data/spec/spec_helper.rb +1 -2
- metadata +55 -60
- data/k_lambda_spec/atom_spec.rb +0 -85
- data/k_lambda_spec/primitives/arithmetic_spec.rb +0 -175
- data/k_lambda_spec/primitives/assignments_spec.rb +0 -44
- data/k_lambda_spec/primitives/boolean_operations_spec.rb +0 -136
- data/k_lambda_spec/primitives/generic_functions_spec.rb +0 -120
- data/k_lambda_spec/primitives/lists_spec.rb +0 -40
- data/k_lambda_spec/primitives/strings_spec.rb +0 -77
- data/k_lambda_spec/primitives/symbols_spec.rb +0 -24
- data/k_lambda_spec/primitives/vectors_spec.rb +0 -92
- data/k_lambda_spec/spec_helper.rb +0 -29
- data/k_lambda_spec/support/shared_examples.rb +0 -124
- data/k_lambda_spec/tail_recursion_spec.rb +0 -30
- data/lib/kl.rb +0 -7
- data/lib/kl/absvector.rb +0 -12
- data/lib/kl/compiler.rb +0 -360
- data/lib/kl/cons.rb +0 -51
- data/lib/kl/empty_list.rb +0 -12
- data/lib/kl/environment.rb +0 -163
- data/lib/kl/error.rb +0 -4
- data/lib/kl/internal_error.rb +0 -7
- data/lib/kl/lexer.rb +0 -186
- data/lib/kl/primitives/arithmetic.rb +0 -60
- data/lib/kl/primitives/assignments.rb +0 -15
- data/lib/kl/primitives/booleans.rb +0 -21
- data/lib/kl/primitives/error_handling.rb +0 -13
- data/lib/kl/primitives/extensions.rb +0 -12
- data/lib/kl/primitives/generic_functions.rb +0 -29
- data/lib/kl/primitives/lists.rb +0 -23
- data/lib/kl/primitives/streams.rb +0 -28
- data/lib/kl/primitives/strings.rb +0 -63
- data/lib/kl/primitives/symbols.rb +0 -18
- data/lib/kl/primitives/time.rb +0 -17
- data/lib/kl/primitives/vectors.rb +0 -36
- data/lib/kl/reader.rb +0 -46
- data/spec/kl/cons_spec.rb +0 -12
- data/spec/kl/environment_spec.rb +0 -282
- data/spec/kl/interop_spec.rb +0 -68
- data/spec/kl/lexer_spec.rb +0 -149
- data/spec/kl/primitives/generic_functions_spec.rb +0 -29
- data/spec/kl/primitives/symbols_spec.rb +0 -21
- data/spec/kl/reader_spec.rb +0 -42
@@ -1,81 +1,81 @@
|
|
1
|
-
(synonyms
|
2
|
-
|
3
|
-
proof (list step)
|
4
|
-
step ((list sequent) * tactic)
|
5
|
-
tactic ((list sequent) --> (list sequent))
|
6
|
-
sequent ((list wff) * wff))
|
7
|
-
|
8
|
-
(datatype globals
|
9
|
-
|
10
|
-
_______________________
|
11
|
-
(value *proof*) : proof;)
|
12
|
-
|
13
|
-
(define proof-assistant
|
14
|
-
{A --> symbol}
|
15
|
-
_ -> (let Assumptions (input-assumptions 1)
|
16
|
-
Conclusion (input-conclusion _)
|
17
|
-
Sequents [(@p Assumptions Conclusion)]
|
18
|
-
Proof (time (proof-loop Sequents []))
|
19
|
-
(do (nl) proved)))
|
20
|
-
|
21
|
-
(define input-assumptions
|
22
|
-
{number --> (list wff)}
|
23
|
-
N -> (let More? (y-or-n? "~%Input assumptions? ")
|
24
|
-
(if More?
|
25
|
-
(do (output "~%~A. " N)
|
26
|
-
[(input+ wff) | (input-assumptions (+ N 1))])
|
27
|
-
[ ])))
|
28
|
-
|
29
|
-
(define input-conclusion
|
30
|
-
{A --> wff}
|
31
|
-
_ -> (do (output "~%Enter conclusion: ") (input+ wff)))
|
32
|
-
|
33
|
-
(define proof-loop
|
34
|
-
{(list sequent) --> proof --> proof}
|
35
|
-
[ ] Proof -> (set *proof* (reverse Proof))
|
36
|
-
S Proof -> (let Show (show-sequent S (+ 1 (length Proof)))
|
37
|
-
D (user-directive _)
|
38
|
-
Step (@p S D)
|
39
|
-
(if (= D back)
|
40
|
-
(proof-loop (go-back Proof) (tail Proof))
|
41
|
-
(proof-loop (D S) [Step | Proof]))))
|
42
|
-
|
43
|
-
(define show-proof
|
44
|
-
{string --> symbol}
|
45
|
-
S -> (show-proof-help (value *proof*) 1))
|
46
|
-
|
47
|
-
(define show-proof-help
|
48
|
-
{proof --> number --> symbol}
|
49
|
-
[ ] _ -> proved
|
50
|
-
[(@p Sequents Tactic) | Proof] N -> (do (show-sequent Sequents N)
|
51
|
-
(output "~%Tactic: ~A~%" Tactic)
|
52
|
-
(show-proof-help Proof (+ N 1))))
|
53
|
-
|
54
|
-
(define show-sequent
|
55
|
-
{(list sequent) --> number --> symbol}
|
56
|
-
Sequents N -> (let Unsolved (length Sequents)
|
57
|
-
Sequent (head Sequents)
|
58
|
-
Wffs (fst Sequent)
|
59
|
-
Wff (snd Sequent)
|
60
|
-
(do (output "==============================~%")
|
61
|
-
(output "Step ~A unsolved ~A~%~%"
|
62
|
-
N Unsolved)
|
63
|
-
(output "?- ~S~%~%" Wff)
|
64
|
-
(enumerate Wffs 1))))
|
65
|
-
|
66
|
-
(define enumerate
|
67
|
-
{(list A) --> number --> symbol}
|
68
|
-
[] _ -> _
|
69
|
-
[X | Y] N -> (do (output "~A. ~S~%" N X) (enumerate Y (+ N 1))))
|
70
|
-
|
71
|
-
(define user-directive
|
72
|
-
{A --> tactic}
|
73
|
-
_ -> (do (output "~%Tactic: ") (input+ tactic)))
|
74
|
-
|
75
|
-
(define back
|
76
|
-
{(list sequent) --> (list sequent)}
|
77
|
-
S -> S)
|
78
|
-
|
79
|
-
(define go-back
|
80
|
-
{proof --> (list sequent)}
|
1
|
+
(synonyms
|
2
|
+
|
3
|
+
proof (list step)
|
4
|
+
step ((list sequent) * tactic)
|
5
|
+
tactic ((list sequent) --> (list sequent))
|
6
|
+
sequent ((list wff) * wff))
|
7
|
+
|
8
|
+
(datatype globals
|
9
|
+
|
10
|
+
_______________________
|
11
|
+
(value *proof*) : proof;)
|
12
|
+
|
13
|
+
(define proof-assistant
|
14
|
+
{A --> symbol}
|
15
|
+
_ -> (let Assumptions (input-assumptions 1)
|
16
|
+
Conclusion (input-conclusion _)
|
17
|
+
Sequents [(@p Assumptions Conclusion)]
|
18
|
+
Proof (time (proof-loop Sequents []))
|
19
|
+
(do (nl) proved)))
|
20
|
+
|
21
|
+
(define input-assumptions
|
22
|
+
{number --> (list wff)}
|
23
|
+
N -> (let More? (y-or-n? "~%Input assumptions? ")
|
24
|
+
(if More?
|
25
|
+
(do (output "~%~A. " N)
|
26
|
+
[(input+ wff) | (input-assumptions (+ N 1))])
|
27
|
+
[ ])))
|
28
|
+
|
29
|
+
(define input-conclusion
|
30
|
+
{A --> wff}
|
31
|
+
_ -> (do (output "~%Enter conclusion: ") (input+ wff)))
|
32
|
+
|
33
|
+
(define proof-loop
|
34
|
+
{(list sequent) --> proof --> proof}
|
35
|
+
[ ] Proof -> (set *proof* (reverse Proof))
|
36
|
+
S Proof -> (let Show (show-sequent S (+ 1 (length Proof)))
|
37
|
+
D (user-directive _)
|
38
|
+
Step (@p S D)
|
39
|
+
(if (= D back)
|
40
|
+
(proof-loop (go-back Proof) (tail Proof))
|
41
|
+
(proof-loop (D S) [Step | Proof]))))
|
42
|
+
|
43
|
+
(define show-proof
|
44
|
+
{string --> symbol}
|
45
|
+
S -> (show-proof-help (value *proof*) 1))
|
46
|
+
|
47
|
+
(define show-proof-help
|
48
|
+
{proof --> number --> symbol}
|
49
|
+
[ ] _ -> proved
|
50
|
+
[(@p Sequents Tactic) | Proof] N -> (do (show-sequent Sequents N)
|
51
|
+
(output "~%Tactic: ~A~%" Tactic)
|
52
|
+
(show-proof-help Proof (+ N 1))))
|
53
|
+
|
54
|
+
(define show-sequent
|
55
|
+
{(list sequent) --> number --> symbol}
|
56
|
+
Sequents N -> (let Unsolved (length Sequents)
|
57
|
+
Sequent (head Sequents)
|
58
|
+
Wffs (fst Sequent)
|
59
|
+
Wff (snd Sequent)
|
60
|
+
(do (output "==============================~%")
|
61
|
+
(output "Step ~A unsolved ~A~%~%"
|
62
|
+
N Unsolved)
|
63
|
+
(output "?- ~S~%~%" Wff)
|
64
|
+
(enumerate Wffs 1))))
|
65
|
+
|
66
|
+
(define enumerate
|
67
|
+
{(list A) --> number --> symbol}
|
68
|
+
[] _ -> _
|
69
|
+
[X | Y] N -> (do (output "~A. ~S~%" N X) (enumerate Y (+ N 1))))
|
70
|
+
|
71
|
+
(define user-directive
|
72
|
+
{A --> tactic}
|
73
|
+
_ -> (do (output "~%Tactic: ") (input+ tactic)))
|
74
|
+
|
75
|
+
(define back
|
76
|
+
{(list sequent) --> (list sequent)}
|
77
|
+
S -> S)
|
78
|
+
|
79
|
+
(define go-back
|
80
|
+
{proof --> (list sequent)}
|
81
81
|
[(@p S _) | _] -> S)
|
@@ -1,25 +1,25 @@
|
|
1
|
-
(define backchain
|
2
|
-
Conc Assumptions -> (backchain* [Conc] Assumptions Assumptions))
|
3
|
-
|
4
|
-
(define backchain*
|
5
|
-
[] _ _ -> proved
|
6
|
-
[[P & Q] | Goals] _ Assumptions
|
7
|
-
-> (backchain* [P Q | Goals] Assumptions Assumptions)
|
8
|
-
[P | Goals] [[P <= | Subgoal] | _] Assumptions
|
9
|
-
<- (backchain* (append Subgoal Goals) Assumptions Assumptions)
|
10
|
-
Goals [_ | Rest] Assumptions -> (backchain* Goals Rest Assumptions)
|
11
|
-
_ _ _ -> (fail))
|
12
|
-
|
13
|
-
|
14
|
-
|
15
|
-
|
16
|
-
|
17
|
-
|
18
|
-
|
19
|
-
|
20
|
-
|
21
|
-
|
22
|
-
|
23
|
-
|
24
|
-
|
25
|
-
|
1
|
+
(define backchain
|
2
|
+
Conc Assumptions -> (backchain* [Conc] Assumptions Assumptions))
|
3
|
+
|
4
|
+
(define backchain*
|
5
|
+
[] _ _ -> proved
|
6
|
+
[[P & Q] | Goals] _ Assumptions
|
7
|
+
-> (backchain* [P Q | Goals] Assumptions Assumptions)
|
8
|
+
[P | Goals] [[P <= | Subgoal] | _] Assumptions
|
9
|
+
<- (backchain* (append Subgoal Goals) Assumptions Assumptions)
|
10
|
+
Goals [_ | Rest] Assumptions -> (backchain* Goals Rest Assumptions)
|
11
|
+
_ _ _ -> (fail))
|
12
|
+
|
13
|
+
|
14
|
+
|
15
|
+
|
16
|
+
|
17
|
+
|
18
|
+
|
19
|
+
|
20
|
+
|
21
|
+
|
22
|
+
|
23
|
+
|
24
|
+
|
25
|
+
|
@@ -1,27 +1,27 @@
|
|
1
|
-
(define backchain
|
2
|
-
Conc Assumptions -> (backchain* Conc Assumptions Assumptions))
|
3
|
-
|
4
|
-
(define backchain*
|
5
|
-
P [P | _] _ -> true
|
6
|
-
[P & Q] _ Assumptions
|
7
|
-
-> (and (backchain* P Assumptions Assumptions)
|
8
|
-
(backchain* Q Assumptions Assumptions))
|
9
|
-
P [[P <= Q] | _] Assumptions
|
10
|
-
<- (fail-if (/. X (= X false)) (backchain* Q Assumptions Assumptions))
|
11
|
-
P [_ | Rest] Assumptions -> (backchain* P Rest Assumptions)
|
12
|
-
_ _ _ -> false)
|
13
|
-
|
14
|
-
|
15
|
-
|
16
|
-
|
17
|
-
|
18
|
-
|
19
|
-
|
20
|
-
|
21
|
-
|
22
|
-
|
23
|
-
|
24
|
-
|
25
|
-
|
26
|
-
|
27
|
-
|
1
|
+
(define backchain
|
2
|
+
Conc Assumptions -> (backchain* Conc Assumptions Assumptions))
|
3
|
+
|
4
|
+
(define backchain*
|
5
|
+
P [P | _] _ -> true
|
6
|
+
[P & Q] _ Assumptions
|
7
|
+
-> (and (backchain* P Assumptions Assumptions)
|
8
|
+
(backchain* Q Assumptions Assumptions))
|
9
|
+
P [[P <= Q] | _] Assumptions
|
10
|
+
<- (fail-if (/. X (= X false)) (backchain* Q Assumptions Assumptions))
|
11
|
+
P [_ | Rest] Assumptions -> (backchain* P Rest Assumptions)
|
12
|
+
_ _ _ -> false)
|
13
|
+
|
14
|
+
|
15
|
+
|
16
|
+
|
17
|
+
|
18
|
+
|
19
|
+
|
20
|
+
|
21
|
+
|
22
|
+
|
23
|
+
|
24
|
+
|
25
|
+
|
26
|
+
|
27
|
+
|
@@ -1,67 +1,67 @@
|
|
1
|
-
(datatype progression
|
2
|
-
|
3
|
-
X : A; S : (A --> A); E : (A --> boolean);
|
4
|
-
==========================================
|
5
|
-
[X S E] : (progression A);)
|
6
|
-
|
7
|
-
(define force
|
8
|
-
{(progression A) --> A}
|
9
|
-
[X S E] -> X)
|
10
|
-
|
11
|
-
(define delay
|
12
|
-
{(progression A) --> (progression A)}
|
13
|
-
[X S E] -> [(S X) S E])
|
14
|
-
|
15
|
-
(define end?
|
16
|
-
{(progression A) --> boolean}
|
17
|
-
[X S E] -> (E X))
|
18
|
-
|
19
|
-
(define push
|
20
|
-
{A --> (progression A) --> (progression A)}
|
21
|
-
X [Y S E] -> [X (/. Z (if (= Z X) Y (S Z))) E])
|
22
|
-
|
23
|
-
(define forall
|
24
|
-
{(progression A) --> (A --> boolean) --> boolean}
|
25
|
-
[X S E] P -> (if (E X) true (and (P X) (forall [(S X) S E] P))))
|
26
|
-
|
27
|
-
(define exists
|
28
|
-
{(progression A) --> (A --> boolean) --> boolean}
|
29
|
-
[X S E] P -> (if (E X) false (or (P X) (exists [(S X) S E] P))))
|
30
|
-
|
31
|
-
(define super
|
32
|
-
{(progression A) --> (A --> B) --> (B --> C --> C) --> C --> C}
|
33
|
-
[X S E] P F Y -> (if (E X) Y (F (P X) (super [(S X) S E] P F Y))))
|
34
|
-
|
35
|
-
(define forall
|
36
|
-
{(progression A) --> (A --> boolean) --> boolean}
|
37
|
-
Progression P -> (super Progression P (function and) true))
|
38
|
-
|
39
|
-
(define exists
|
40
|
-
{(progression A) --> (A --> boolean) --> boolean}
|
41
|
-
Progression P -> (super Progression P (function or) false))
|
42
|
-
|
43
|
-
(define for
|
44
|
-
{(progression A) --> (A --> B) --> number}
|
45
|
-
Progression P -> (super Progression P (function progn) 0))
|
46
|
-
|
47
|
-
(define progn
|
48
|
-
{A --> B --> B}
|
49
|
-
X Y -> Y)
|
50
|
-
|
51
|
-
(define filter
|
52
|
-
{(progression A) --> (A --> boolean) --> (list A)}
|
53
|
-
Progression P -> (super Progression (/. X (if (P X) [X] [])) append []))
|
54
|
-
|
55
|
-
(define next-prime
|
56
|
-
{number --> number}
|
57
|
-
N -> (if (prime? (+ N 1)) (+ N 1) (next-prime (+ N 1))))
|
58
|
-
|
59
|
-
(define prime?
|
60
|
-
{number --> boolean}
|
61
|
-
X -> (prime-help X (/ X 2) 2))
|
62
|
-
|
63
|
-
(define prime-help
|
64
|
-
{number --> number --> number --> boolean}
|
65
|
-
X Max Div -> false where (integer? (/ X Div))
|
66
|
-
X Max Div -> true where (> Div Max)
|
1
|
+
(datatype progression
|
2
|
+
|
3
|
+
X : A; S : (A --> A); E : (A --> boolean);
|
4
|
+
==========================================
|
5
|
+
[X S E] : (progression A);)
|
6
|
+
|
7
|
+
(define force
|
8
|
+
{(progression A) --> A}
|
9
|
+
[X S E] -> X)
|
10
|
+
|
11
|
+
(define delay
|
12
|
+
{(progression A) --> (progression A)}
|
13
|
+
[X S E] -> [(S X) S E])
|
14
|
+
|
15
|
+
(define end?
|
16
|
+
{(progression A) --> boolean}
|
17
|
+
[X S E] -> (E X))
|
18
|
+
|
19
|
+
(define push
|
20
|
+
{A --> (progression A) --> (progression A)}
|
21
|
+
X [Y S E] -> [X (/. Z (if (= Z X) Y (S Z))) E])
|
22
|
+
|
23
|
+
(define forall
|
24
|
+
{(progression A) --> (A --> boolean) --> boolean}
|
25
|
+
[X S E] P -> (if (E X) true (and (P X) (forall [(S X) S E] P))))
|
26
|
+
|
27
|
+
(define exists
|
28
|
+
{(progression A) --> (A --> boolean) --> boolean}
|
29
|
+
[X S E] P -> (if (E X) false (or (P X) (exists [(S X) S E] P))))
|
30
|
+
|
31
|
+
(define super
|
32
|
+
{(progression A) --> (A --> B) --> (B --> C --> C) --> C --> C}
|
33
|
+
[X S E] P F Y -> (if (E X) Y (F (P X) (super [(S X) S E] P F Y))))
|
34
|
+
|
35
|
+
(define forall
|
36
|
+
{(progression A) --> (A --> boolean) --> boolean}
|
37
|
+
Progression P -> (super Progression P (function and) true))
|
38
|
+
|
39
|
+
(define exists
|
40
|
+
{(progression A) --> (A --> boolean) --> boolean}
|
41
|
+
Progression P -> (super Progression P (function or) false))
|
42
|
+
|
43
|
+
(define for
|
44
|
+
{(progression A) --> (A --> B) --> number}
|
45
|
+
Progression P -> (super Progression P (function progn) 0))
|
46
|
+
|
47
|
+
(define progn
|
48
|
+
{A --> B --> B}
|
49
|
+
X Y -> Y)
|
50
|
+
|
51
|
+
(define filter
|
52
|
+
{(progression A) --> (A --> boolean) --> (list A)}
|
53
|
+
Progression P -> (super Progression (/. X (if (P X) [X] [])) append []))
|
54
|
+
|
55
|
+
(define next-prime
|
56
|
+
{number --> number}
|
57
|
+
N -> (if (prime? (+ N 1)) (+ N 1) (next-prime (+ N 1))))
|
58
|
+
|
59
|
+
(define prime?
|
60
|
+
{number --> boolean}
|
61
|
+
X -> (prime-help X (/ X 2) 2))
|
62
|
+
|
63
|
+
(define prime-help
|
64
|
+
{number --> number --> number --> boolean}
|
65
|
+
X Max Div -> false where (integer? (/ X Div))
|
66
|
+
X Max Div -> true where (> Div Max)
|
67
67
|
X Max Div -> (prime-help X Max (+ 1 Div)))
|
@@ -1,55 +1,55 @@
|
|
1
|
-
\**\ \* Copyright (c) 2011, Justin Grant <justin at imagine27 dot com> *\ \* All rights reserved. *\ \**\ \* Redistribution and use in source and binary forms, with or without modification, *\ \* are permitted provided that the following conditions are met: *\ \**\ \* Redistributions of source code must retain the above copyright notice, this list *\ \* of conditions and the following disclaimer. *\ \* Redistributions in binary form must reproduce the above copyright notice, this *\ \* list of conditions and the following disclaimer in the documentation and/or *\ \* other materials provided with the distribution. *\ \* Neither the name of the <ORGANIZATION> nor the names of its contributors may be *\ \* used to endorse or promote products derived from this software without specific *\ \* prior written permission. *\ \**\ \* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND *\ \* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED *\ \* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE *\ \* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR *\ \* ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES *\ \* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; *\ \* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *\ \* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING *\ \* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, *\ \* EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *\ \**\ (datatype tree-node
|
2
|
-
|
3
|
-
Key : number; Val : B;
|
4
|
-
======================
|
5
|
-
[Key Val] : tree-node;)
|
6
|
-
|
7
|
-
(datatype color
|
8
|
-
|
9
|
-
if (element? Color [red black])
|
10
|
-
_______________________________
|
11
|
-
Color : color;)
|
12
|
-
|
13
|
-
(datatype tree
|
14
|
-
|
15
|
-
if (empty? Tree)
|
16
|
-
________________
|
17
|
-
Tree : tree;
|
18
|
-
|
19
|
-
Color : color; LTree : tree; TreeNode : tree-node; RTree : tree;
|
20
|
-
================================================================
|
21
|
-
[Color LTree TreeNode RTree] : tree;)
|
22
|
-
|
23
|
-
(define node-key
|
24
|
-
{tree-node --> number}
|
25
|
-
[Key Val] -> Key)
|
26
|
-
|
27
|
-
(define make-tree-black
|
28
|
-
{tree --> tree}
|
29
|
-
[Color A X B] -> [black A X B])
|
30
|
-
|
31
|
-
(define member
|
32
|
-
{tree-node --> tree --> boolean}
|
33
|
-
X [] -> false
|
34
|
-
X [Color A Y B] -> (cases (< (node-key X) (node-key Y)) (member X A)
|
35
|
-
(< (node-key Y) (node-key X)) (member X B)
|
36
|
-
true true))
|
37
|
-
|
38
|
-
(define balance
|
39
|
-
{tree --> tree}
|
40
|
-
[black [red [red A X B] Y C] Z D] -> [red [black A X B] Y [black C Z D]]
|
41
|
-
[black [red A X [red B Y C]] Z D] -> [red [black A X B] Y [black C Z D]]
|
42
|
-
[black A X [red [red B Y C] Z D]] -> [red [black A X B] Y [black C Z D]]
|
43
|
-
[black A X [red B Y [red C Z D]]] -> [red [black A X B] Y [black C Z D]]
|
44
|
-
S -> S)
|
45
|
-
|
46
|
-
(define insert-
|
47
|
-
{tree-node --> tree --> tree}
|
48
|
-
X [] -> [red [] X []]
|
49
|
-
X [Color A Y B] -> (cases (< (node-key X) (node-key Y)) (balance [Color (insert- X A) Y B])
|
50
|
-
(< (node-key Y) (node-key X)) (balance [Color A Y (insert- X B)])
|
51
|
-
true [Color A Y B]))
|
52
|
-
|
53
|
-
(define insert
|
54
|
-
{tree-node --> tree --> tree}
|
1
|
+
\**\ \* Copyright (c) 2011, Justin Grant <justin at imagine27 dot com> *\ \* All rights reserved. *\ \**\ \* Redistribution and use in source and binary forms, with or without modification, *\ \* are permitted provided that the following conditions are met: *\ \**\ \* Redistributions of source code must retain the above copyright notice, this list *\ \* of conditions and the following disclaimer. *\ \* Redistributions in binary form must reproduce the above copyright notice, this *\ \* list of conditions and the following disclaimer in the documentation and/or *\ \* other materials provided with the distribution. *\ \* Neither the name of the <ORGANIZATION> nor the names of its contributors may be *\ \* used to endorse or promote products derived from this software without specific *\ \* prior written permission. *\ \**\ \* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND *\ \* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED *\ \* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE *\ \* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR *\ \* ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES *\ \* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; *\ \* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *\ \* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING *\ \* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, *\ \* EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *\ \**\ (datatype tree-node
|
2
|
+
|
3
|
+
Key : number; Val : B;
|
4
|
+
======================
|
5
|
+
[Key Val] : tree-node;)
|
6
|
+
|
7
|
+
(datatype color
|
8
|
+
|
9
|
+
if (element? Color [red black])
|
10
|
+
_______________________________
|
11
|
+
Color : color;)
|
12
|
+
|
13
|
+
(datatype tree
|
14
|
+
|
15
|
+
if (empty? Tree)
|
16
|
+
________________
|
17
|
+
Tree : tree;
|
18
|
+
|
19
|
+
Color : color; LTree : tree; TreeNode : tree-node; RTree : tree;
|
20
|
+
================================================================
|
21
|
+
[Color LTree TreeNode RTree] : tree;)
|
22
|
+
|
23
|
+
(define node-key
|
24
|
+
{tree-node --> number}
|
25
|
+
[Key Val] -> Key)
|
26
|
+
|
27
|
+
(define make-tree-black
|
28
|
+
{tree --> tree}
|
29
|
+
[Color A X B] -> [black A X B])
|
30
|
+
|
31
|
+
(define member
|
32
|
+
{tree-node --> tree --> boolean}
|
33
|
+
X [] -> false
|
34
|
+
X [Color A Y B] -> (cases (< (node-key X) (node-key Y)) (member X A)
|
35
|
+
(< (node-key Y) (node-key X)) (member X B)
|
36
|
+
true true))
|
37
|
+
|
38
|
+
(define balance
|
39
|
+
{tree --> tree}
|
40
|
+
[black [red [red A X B] Y C] Z D] -> [red [black A X B] Y [black C Z D]]
|
41
|
+
[black [red A X [red B Y C]] Z D] -> [red [black A X B] Y [black C Z D]]
|
42
|
+
[black A X [red [red B Y C] Z D]] -> [red [black A X B] Y [black C Z D]]
|
43
|
+
[black A X [red B Y [red C Z D]]] -> [red [black A X B] Y [black C Z D]]
|
44
|
+
S -> S)
|
45
|
+
|
46
|
+
(define insert-
|
47
|
+
{tree-node --> tree --> tree}
|
48
|
+
X [] -> [red [] X []]
|
49
|
+
X [Color A Y B] -> (cases (< (node-key X) (node-key Y)) (balance [Color (insert- X A) Y B])
|
50
|
+
(< (node-key Y) (node-key X)) (balance [Color A Y (insert- X B)])
|
51
|
+
true [Color A Y B]))
|
52
|
+
|
53
|
+
(define insert
|
54
|
+
{tree-node --> tree --> tree}
|
55
55
|
X S -> (make-tree-black (insert- X S)))
|