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,56 +1,56 @@
|
|
1
|
-
(define breadth-first
|
2
|
-
{state --> (state --> (list state)) --> (state --> boolean) --> boolean}
|
3
|
-
Start F Test -> (b* F Test (F Start)))
|
4
|
-
|
5
|
-
(define b*
|
6
|
-
{(state --> (list state)) --> (state --> boolean) --> (list state) --> boolean}
|
7
|
-
F Test States -> true where (some Test States)
|
8
|
-
F Test States -> (let NewStates (mapcan F States)
|
9
|
-
(if (empty? NewStates)
|
10
|
-
false
|
11
|
-
(b* F Test NewStates))))
|
12
|
-
|
13
|
-
(define some
|
14
|
-
{(A --> boolean) --> (list A) --> boolean}
|
15
|
-
Test [] -> false
|
16
|
-
Test [X|Y] -> (or (Test X) (some Test Y)))
|
17
|
-
|
18
|
-
(define depth
|
19
|
-
{state --> (state --> (list state)) --> (state --> boolean) --> boolean}
|
20
|
-
Start _ Test -> true where (Test Start)
|
21
|
-
Start F Test -> (d* F Test (F Start)))
|
22
|
-
|
23
|
-
(define d*
|
24
|
-
{(state --> (list state)) --> (state --> boolean) --> (list state) --> boolean}
|
25
|
-
_ Test [State | _] -> true where (Test State)
|
26
|
-
F Test [State | States] <- (fail-if (= false) (d* F Test (F State)))
|
27
|
-
F Test [_ | States] -> (d* F Test States)
|
28
|
-
_ _ _ -> false)
|
29
|
-
|
30
|
-
(define hill
|
31
|
-
{(state --> number) --> state --> (state --> (list state)) --> (state --> boolean) --> boolean}
|
32
|
-
_ Start _ Test -> true where (Test Start)
|
33
|
-
E Start F Test -> (h* E F Test (order_states E (F Start))))
|
34
|
-
|
35
|
-
(define h*
|
36
|
-
{(state --> number) --> (state --> (list state)) --> (state --> boolean) --> (list state) --> boolean}
|
37
|
-
_ _ Test [State | _] -> true where (Test State)
|
38
|
-
E F Test [State | States]
|
39
|
-
<- (fail-if (/. X (= X false)) (h* E F Test (order_states E (F State))))
|
40
|
-
E F Test [_ | States] -> (h* E F Test States)
|
41
|
-
_ _ _ _ -> false)
|
42
|
-
|
43
|
-
(define order_states
|
44
|
-
{(state --> number) --> (list state) --> (list state)}
|
45
|
-
E States -> (sort (/. S1 (/. S2 (> (E S1) (E S2)))) States))
|
46
|
-
|
47
|
-
(define sort
|
48
|
-
{(A --> (A --> boolean)) --> (list A) --> (list A)}
|
49
|
-
R X -> (fix (/. Y (sort* R Y)) X))
|
50
|
-
|
51
|
-
(define sort*
|
52
|
-
{(A --> A --> boolean) --> (list A) --> (list A)}
|
53
|
-
_ [] -> []
|
54
|
-
_ [X] -> [X]
|
55
|
-
R [X Y | Z] -> [Y | (sort* R [X | Z])] where (R Y X)
|
1
|
+
(define breadth-first
|
2
|
+
{state --> (state --> (list state)) --> (state --> boolean) --> boolean}
|
3
|
+
Start F Test -> (b* F Test (F Start)))
|
4
|
+
|
5
|
+
(define b*
|
6
|
+
{(state --> (list state)) --> (state --> boolean) --> (list state) --> boolean}
|
7
|
+
F Test States -> true where (some Test States)
|
8
|
+
F Test States -> (let NewStates (mapcan F States)
|
9
|
+
(if (empty? NewStates)
|
10
|
+
false
|
11
|
+
(b* F Test NewStates))))
|
12
|
+
|
13
|
+
(define some
|
14
|
+
{(A --> boolean) --> (list A) --> boolean}
|
15
|
+
Test [] -> false
|
16
|
+
Test [X|Y] -> (or (Test X) (some Test Y)))
|
17
|
+
|
18
|
+
(define depth
|
19
|
+
{state --> (state --> (list state)) --> (state --> boolean) --> boolean}
|
20
|
+
Start _ Test -> true where (Test Start)
|
21
|
+
Start F Test -> (d* F Test (F Start)))
|
22
|
+
|
23
|
+
(define d*
|
24
|
+
{(state --> (list state)) --> (state --> boolean) --> (list state) --> boolean}
|
25
|
+
_ Test [State | _] -> true where (Test State)
|
26
|
+
F Test [State | States] <- (fail-if (= false) (d* F Test (F State)))
|
27
|
+
F Test [_ | States] -> (d* F Test States)
|
28
|
+
_ _ _ -> false)
|
29
|
+
|
30
|
+
(define hill
|
31
|
+
{(state --> number) --> state --> (state --> (list state)) --> (state --> boolean) --> boolean}
|
32
|
+
_ Start _ Test -> true where (Test Start)
|
33
|
+
E Start F Test -> (h* E F Test (order_states E (F Start))))
|
34
|
+
|
35
|
+
(define h*
|
36
|
+
{(state --> number) --> (state --> (list state)) --> (state --> boolean) --> (list state) --> boolean}
|
37
|
+
_ _ Test [State | _] -> true where (Test State)
|
38
|
+
E F Test [State | States]
|
39
|
+
<- (fail-if (/. X (= X false)) (h* E F Test (order_states E (F State))))
|
40
|
+
E F Test [_ | States] -> (h* E F Test States)
|
41
|
+
_ _ _ _ -> false)
|
42
|
+
|
43
|
+
(define order_states
|
44
|
+
{(state --> number) --> (list state) --> (list state)}
|
45
|
+
E States -> (sort (/. S1 (/. S2 (> (E S1) (E S2)))) States))
|
46
|
+
|
47
|
+
(define sort
|
48
|
+
{(A --> (A --> boolean)) --> (list A) --> (list A)}
|
49
|
+
R X -> (fix (/. Y (sort* R Y)) X))
|
50
|
+
|
51
|
+
(define sort*
|
52
|
+
{(A --> A --> boolean) --> (list A) --> (list A)}
|
53
|
+
_ [] -> []
|
54
|
+
_ [X] -> [X]
|
55
|
+
R [X Y | Z] -> [Y | (sort* R [X | Z])] where (R Y X)
|
56
56
|
R [X Y | Z] -> [X | (sort* R [Y | Z])])
|
@@ -1,44 +1,44 @@
|
|
1
|
-
(define query
|
2
|
-
[is Object Concept] -> (if (belongs? Object Concept) yes no))
|
3
|
-
|
4
|
-
(define belongs?
|
5
|
-
Object Concept -> (element? Concept (fix spread-activation [Object])))
|
6
|
-
|
7
|
-
(define spread-activation
|
8
|
-
[] -> []
|
9
|
-
[Vertex | Vertices] -> (union (accessible-from Vertex)
|
10
|
-
(spread-activation Vertices)))
|
11
|
-
|
12
|
-
(define accessible-from
|
13
|
-
Vertex -> [Vertex | (union (is_links Vertex) (type_links Vertex))])
|
14
|
-
|
15
|
-
(define is_links
|
16
|
-
Vertex -> (get-prop Vertex is_a []))
|
17
|
-
|
18
|
-
(define type_links
|
19
|
-
Vertex -> (get-prop Vertex type_of []))
|
20
|
-
|
21
|
-
(define assert
|
22
|
-
[Object is_a Type] -> (put Object is_a [Type | (is_links Object)])
|
23
|
-
[Type1 type_of Type2] -> (put Type1 type_of [Type2 | (type_links Type1)]))
|
24
|
-
|
25
|
-
(define get-prop
|
26
|
-
Ob Pointer Default -> (trap-error (get Ob Pointer) (/. E Default)))
|
27
|
-
|
28
|
-
(define clear
|
29
|
-
Ob -> (put Ob is_a (put Ob type_of [])))
|
30
|
-
|
31
|
-
|
32
|
-
|
33
|
-
|
34
|
-
|
35
|
-
|
36
|
-
|
37
|
-
|
38
|
-
|
39
|
-
|
40
|
-
|
41
|
-
|
42
|
-
|
43
|
-
|
44
|
-
|
1
|
+
(define query
|
2
|
+
[is Object Concept] -> (if (belongs? Object Concept) yes no))
|
3
|
+
|
4
|
+
(define belongs?
|
5
|
+
Object Concept -> (element? Concept (fix spread-activation [Object])))
|
6
|
+
|
7
|
+
(define spread-activation
|
8
|
+
[] -> []
|
9
|
+
[Vertex | Vertices] -> (union (accessible-from Vertex)
|
10
|
+
(spread-activation Vertices)))
|
11
|
+
|
12
|
+
(define accessible-from
|
13
|
+
Vertex -> [Vertex | (union (is_links Vertex) (type_links Vertex))])
|
14
|
+
|
15
|
+
(define is_links
|
16
|
+
Vertex -> (get-prop Vertex is_a []))
|
17
|
+
|
18
|
+
(define type_links
|
19
|
+
Vertex -> (get-prop Vertex type_of []))
|
20
|
+
|
21
|
+
(define assert
|
22
|
+
[Object is_a Type] -> (put Object is_a [Type | (is_links Object)])
|
23
|
+
[Type1 type_of Type2] -> (put Type1 type_of [Type2 | (type_links Type1)]))
|
24
|
+
|
25
|
+
(define get-prop
|
26
|
+
Ob Pointer Default -> (trap-error (get Ob Pointer) (/. E Default)))
|
27
|
+
|
28
|
+
(define clear
|
29
|
+
Ob -> (put Ob is_a (put Ob type_of [])))
|
30
|
+
|
31
|
+
|
32
|
+
|
33
|
+
|
34
|
+
|
35
|
+
|
36
|
+
|
37
|
+
|
38
|
+
|
39
|
+
|
40
|
+
|
41
|
+
|
42
|
+
|
43
|
+
|
44
|
+
|
@@ -1,35 +1,35 @@
|
|
1
|
-
(define assess-spreadsheet
|
2
|
-
Spreadsheet -> (map (/. Row (assign-fixed-values Row Spreadsheet))
|
3
|
-
Spreadsheet))
|
4
|
-
|
5
|
-
(define assign-fixed-values
|
6
|
-
[Index | Cells] Spreadsheet
|
7
|
-
-> [Index | (map (/. Cell (assign-cell-value Cell Spreadsheet)) Cells)])
|
8
|
-
|
9
|
-
(define assign-cell-value
|
10
|
-
[Attribute Value] _ -> [Attribute Value] where (fixed-value? Value)
|
11
|
-
[Attribute Value] Spreadsheet -> [Attribute (Value Spreadsheet)])
|
12
|
-
|
13
|
-
(define fixed-value?
|
14
|
-
\* number?, symbol? and string? are system functions - see appendix A *\
|
15
|
-
Value -> (or (number? Value) (or (symbol? Value) (string? Value))))
|
16
|
-
|
17
|
-
(define get'
|
18
|
-
\* spreads the spreadsheet! *\
|
19
|
-
Index Attribute Spreadsheet
|
20
|
-
-> (get-row Index Attribute Spreadsheet Spreadsheet))
|
21
|
-
|
22
|
-
(define get-row
|
23
|
-
\* looks for the right row using the index *\
|
24
|
-
Index Attribute [[Index | Cells] | _] Spreadsheet
|
25
|
-
-> (get-cell Attribute Cells Spreadsheet)
|
26
|
-
Index Attribute [_ | Rows] Spreadsheet
|
27
|
-
-> (get-row Index Attribute Rows Spreadsheet)
|
28
|
-
Index _ _ _ -> (error "Index ~A not found" Index))
|
29
|
-
|
30
|
-
(define get-cell
|
31
|
-
Attribute [[Attribute Value] | _] Spreadsheet
|
32
|
-
-> (if (fixed-value? Value) Value (Value Spreadsheet))
|
33
|
-
Attribute [_ | Cells] Spreadsheet
|
34
|
-
-> (get-cell Attribute Cells Spreadsheet)
|
1
|
+
(define assess-spreadsheet
|
2
|
+
Spreadsheet -> (map (/. Row (assign-fixed-values Row Spreadsheet))
|
3
|
+
Spreadsheet))
|
4
|
+
|
5
|
+
(define assign-fixed-values
|
6
|
+
[Index | Cells] Spreadsheet
|
7
|
+
-> [Index | (map (/. Cell (assign-cell-value Cell Spreadsheet)) Cells)])
|
8
|
+
|
9
|
+
(define assign-cell-value
|
10
|
+
[Attribute Value] _ -> [Attribute Value] where (fixed-value? Value)
|
11
|
+
[Attribute Value] Spreadsheet -> [Attribute (Value Spreadsheet)])
|
12
|
+
|
13
|
+
(define fixed-value?
|
14
|
+
\* number?, symbol? and string? are system functions - see appendix A *\
|
15
|
+
Value -> (or (number? Value) (or (symbol? Value) (string? Value))))
|
16
|
+
|
17
|
+
(define get'
|
18
|
+
\* spreads the spreadsheet! *\
|
19
|
+
Index Attribute Spreadsheet
|
20
|
+
-> (get-row Index Attribute Spreadsheet Spreadsheet))
|
21
|
+
|
22
|
+
(define get-row
|
23
|
+
\* looks for the right row using the index *\
|
24
|
+
Index Attribute [[Index | Cells] | _] Spreadsheet
|
25
|
+
-> (get-cell Attribute Cells Spreadsheet)
|
26
|
+
Index Attribute [_ | Rows] Spreadsheet
|
27
|
+
-> (get-row Index Attribute Rows Spreadsheet)
|
28
|
+
Index _ _ _ -> (error "Index ~A not found" Index))
|
29
|
+
|
30
|
+
(define get-cell
|
31
|
+
Attribute [[Attribute Value] | _] Spreadsheet
|
32
|
+
-> (if (fixed-value? Value) Value (Value Spreadsheet))
|
33
|
+
Attribute [_ | Cells] Spreadsheet
|
34
|
+
-> (get-cell Attribute Cells Spreadsheet)
|
35
35
|
Attribute _ _ -> (error "Attribute ~A not found" Attribute))
|
@@ -1,27 +1,27 @@
|
|
1
|
-
(declare empty-stack [A --> [stack B]])
|
2
|
-
|
3
|
-
(declare push [A --> [stack A] --> [stack A]])
|
4
|
-
|
5
|
-
(declare top [[stack A] --> A])
|
6
|
-
|
7
|
-
(declare pop [[stack A] --> [stack A]])
|
8
|
-
|
9
|
-
(define empty-stack
|
10
|
-
_ -> (/. X (if (or (= X pop) (= X top))
|
11
|
-
(error "this stack is empty~%")
|
12
|
-
(error "~A is not an operation on stacks.~%" X))))
|
13
|
-
|
14
|
-
(define push
|
15
|
-
X S -> (/. Y (if (= Y pop)
|
16
|
-
S
|
17
|
-
(if (= Y top)
|
18
|
-
X
|
19
|
-
(error "~A is not an operation on stacks.~%" Y)))))
|
20
|
-
|
21
|
-
(define top
|
22
|
-
S -> (S top))
|
23
|
-
|
24
|
-
(define pop
|
25
|
-
S -> (S pop))
|
26
|
-
|
27
|
-
|
1
|
+
(declare empty-stack [A --> [stack B]])
|
2
|
+
|
3
|
+
(declare push [A --> [stack A] --> [stack A]])
|
4
|
+
|
5
|
+
(declare top [[stack A] --> A])
|
6
|
+
|
7
|
+
(declare pop [[stack A] --> [stack A]])
|
8
|
+
|
9
|
+
(define empty-stack
|
10
|
+
_ -> (/. X (if (or (= X pop) (= X top))
|
11
|
+
(error "this stack is empty~%")
|
12
|
+
(error "~A is not an operation on stacks.~%" X))))
|
13
|
+
|
14
|
+
(define push
|
15
|
+
X S -> (/. Y (if (= Y pop)
|
16
|
+
S
|
17
|
+
(if (= Y top)
|
18
|
+
X
|
19
|
+
(error "~A is not an operation on stacks.~%" Y)))))
|
20
|
+
|
21
|
+
(define top
|
22
|
+
S -> (S top))
|
23
|
+
|
24
|
+
(define pop
|
25
|
+
S -> (S pop))
|
26
|
+
|
27
|
+
|
@@ -1,20 +1,20 @@
|
|
1
|
-
(datatype progression
|
2
|
-
|
3
|
-
X : (A * (A --> A) * (A --> boolean));
|
4
|
-
======================================
|
5
|
-
X : (progression A);)
|
6
|
-
|
7
|
-
(define delay
|
8
|
-
{(progression A) --> (progression A)}
|
9
|
-
(@p X F E) -> (if (not (E X))
|
10
|
-
(@p (F X) F E)
|
11
|
-
(error "progression exhausted!~%")))
|
12
|
-
|
13
|
-
(define force
|
14
|
-
{(progression A) --> A}
|
15
|
-
(@p X F E) -> X)
|
16
|
-
|
17
|
-
(define end?
|
18
|
-
{(progression A) --> boolean}
|
19
|
-
(@p X _ E) -> (E X))
|
20
|
-
|
1
|
+
(datatype progression
|
2
|
+
|
3
|
+
X : (A * (A --> A) * (A --> boolean));
|
4
|
+
======================================
|
5
|
+
X : (progression A);)
|
6
|
+
|
7
|
+
(define delay
|
8
|
+
{(progression A) --> (progression A)}
|
9
|
+
(@p X F E) -> (if (not (E X))
|
10
|
+
(@p (F X) F E)
|
11
|
+
(error "progression exhausted!~%")))
|
12
|
+
|
13
|
+
(define force
|
14
|
+
{(progression A) --> A}
|
15
|
+
(@p X F E) -> X)
|
16
|
+
|
17
|
+
(define end?
|
18
|
+
{(progression A) --> boolean}
|
19
|
+
(@p X _ E) -> (E X))
|
20
|
+
|
@@ -1,58 +1,58 @@
|
|
1
|
-
\* Replace the first occurrence of a string Rem by Rep *\
|
2
|
-
(define subst-string
|
3
|
-
{string --> string --> string --> string}
|
4
|
-
_ _ "" -> ""
|
5
|
-
Rep (@s S Ss) (@s S Ss') <- (fail-if (= "failed!") (subst-string' Rep Ss Ss'))
|
6
|
-
Rep Rem (@s S Ss) -> (@s S (subst-string Rep Rem Ss)))
|
7
|
-
|
8
|
-
(define subst-string'
|
9
|
-
{string --> string --> string --> string}
|
10
|
-
Rep "" Ss -> (@s Rep Ss)
|
11
|
-
Rep (@s S Ss) (@s S Ss') -> (subst-string' Rep Ss Ss')
|
12
|
-
_ _ _ -> "failed!")
|
13
|
-
|
14
|
-
(define rwilli
|
15
|
-
{string --> string}
|
16
|
-
"" -> ""
|
17
|
-
(@s "Willi" Ss) -> (rwilli Ss)
|
18
|
-
(@s _ Ss) -> (rwilli Ss))
|
19
|
-
|
20
|
-
|
21
|
-
\* Length of a string. *\
|
22
|
-
(define strlen
|
23
|
-
{string --> number}
|
24
|
-
"" -> 0
|
25
|
-
(@s _ S) -> (+ 1 (strlen S)))
|
26
|
-
|
27
|
-
\* Trim characters from the front of a string. *\
|
28
|
-
(define trim-string-left
|
29
|
-
{(list string) --> string --> string}
|
30
|
-
_ "" -> ""
|
31
|
-
Trim (@s S Ss) -> (@s S Ss) where (not (element? S Trim))
|
32
|
-
Trim (@s _ Ss) -> (trim-string-left Trim Ss))
|
33
|
-
|
34
|
-
\* Trim characters from the end of a string. *\
|
35
|
-
(define trim-string-right
|
36
|
-
{(list string) --> string --> string}
|
37
|
-
Trim S -> (reverse-string (trim-string-left Trim (reverse-string S))))
|
38
|
-
|
39
|
-
\* Trim characters from the front and end of a string *\
|
40
|
-
(define trim-string
|
41
|
-
{(list string) --> string --> string}
|
42
|
-
Trim S -> (reverse-string (trim-string-left Trim (reverse-string (trim-string-left Trim S)))))
|
43
|
-
|
44
|
-
\* Reverse a string. *\
|
45
|
-
(define reverse-string
|
46
|
-
{string --> string}
|
47
|
-
"" -> ""
|
48
|
-
(@s S Ss) -> (@s (reverse-string Ss) S))
|
49
|
-
|
50
|
-
\* A string of digits? *\
|
51
|
-
(define alldigits?
|
52
|
-
{string --> boolean}
|
53
|
-
"" -> true
|
54
|
-
(@s S Ss) -> (and (digit? S) (alldigits? Ss)))
|
55
|
-
|
56
|
-
(define digit?
|
57
|
-
{string --> boolean}
|
1
|
+
\* Replace the first occurrence of a string Rem by Rep *\
|
2
|
+
(define subst-string
|
3
|
+
{string --> string --> string --> string}
|
4
|
+
_ _ "" -> ""
|
5
|
+
Rep (@s S Ss) (@s S Ss') <- (fail-if (= "failed!") (subst-string' Rep Ss Ss'))
|
6
|
+
Rep Rem (@s S Ss) -> (@s S (subst-string Rep Rem Ss)))
|
7
|
+
|
8
|
+
(define subst-string'
|
9
|
+
{string --> string --> string --> string}
|
10
|
+
Rep "" Ss -> (@s Rep Ss)
|
11
|
+
Rep (@s S Ss) (@s S Ss') -> (subst-string' Rep Ss Ss')
|
12
|
+
_ _ _ -> "failed!")
|
13
|
+
|
14
|
+
(define rwilli
|
15
|
+
{string --> string}
|
16
|
+
"" -> ""
|
17
|
+
(@s "Willi" Ss) -> (rwilli Ss)
|
18
|
+
(@s _ Ss) -> (rwilli Ss))
|
19
|
+
|
20
|
+
|
21
|
+
\* Length of a string. *\
|
22
|
+
(define strlen
|
23
|
+
{string --> number}
|
24
|
+
"" -> 0
|
25
|
+
(@s _ S) -> (+ 1 (strlen S)))
|
26
|
+
|
27
|
+
\* Trim characters from the front of a string. *\
|
28
|
+
(define trim-string-left
|
29
|
+
{(list string) --> string --> string}
|
30
|
+
_ "" -> ""
|
31
|
+
Trim (@s S Ss) -> (@s S Ss) where (not (element? S Trim))
|
32
|
+
Trim (@s _ Ss) -> (trim-string-left Trim Ss))
|
33
|
+
|
34
|
+
\* Trim characters from the end of a string. *\
|
35
|
+
(define trim-string-right
|
36
|
+
{(list string) --> string --> string}
|
37
|
+
Trim S -> (reverse-string (trim-string-left Trim (reverse-string S))))
|
38
|
+
|
39
|
+
\* Trim characters from the front and end of a string *\
|
40
|
+
(define trim-string
|
41
|
+
{(list string) --> string --> string}
|
42
|
+
Trim S -> (reverse-string (trim-string-left Trim (reverse-string (trim-string-left Trim S)))))
|
43
|
+
|
44
|
+
\* Reverse a string. *\
|
45
|
+
(define reverse-string
|
46
|
+
{string --> string}
|
47
|
+
"" -> ""
|
48
|
+
(@s S Ss) -> (@s (reverse-string Ss) S))
|
49
|
+
|
50
|
+
\* A string of digits? *\
|
51
|
+
(define alldigits?
|
52
|
+
{string --> boolean}
|
53
|
+
"" -> true
|
54
|
+
(@s S Ss) -> (and (digit? S) (alldigits? Ss)))
|
55
|
+
|
56
|
+
(define digit?
|
57
|
+
{string --> boolean}
|
58
58
|
S -> (element? S ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9"]))
|