rubymotionlisp 0.2.2 → 1.0.0

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
Files changed (60) hide show
  1. checksums.yaml +4 -4
  2. data/README.md +129 -2
  3. data/lib/rubylisp/atom.rb +25 -6
  4. data/lib/rubylisp/boolean.rb +9 -6
  5. data/lib/rubylisp/builtins.rb +33 -0
  6. data/lib/rubylisp/character.rb +14 -275
  7. data/lib/rubylisp/class_object.rb +56 -0
  8. data/lib/rubylisp/cons_cell.rb +50 -20
  9. data/lib/rubylisp/environment.rb +27 -0
  10. data/lib/rubylisp/environment_frame.rb +24 -6
  11. data/lib/rubylisp/eof_object.rb +26 -0
  12. data/lib/rubylisp/exception.rb +61 -61
  13. data/lib/rubylisp/ext.rb +32 -6
  14. data/lib/rubylisp/ffi_new.rb +2 -1
  15. data/lib/rubylisp/ffi_send.rb +15 -5
  16. data/lib/rubylisp/frame.rb +5 -164
  17. data/lib/rubylisp/function.rb +4 -3
  18. data/lib/rubylisp/macro.rb +13 -8
  19. data/lib/rubylisp/{object.rb → native_object.rb} +0 -15
  20. data/lib/rubylisp/number.rb +5 -0
  21. data/lib/rubylisp/parser.rb +81 -52
  22. data/lib/rubylisp/port.rb +27 -0
  23. data/lib/rubylisp/prim_alist.rb +115 -0
  24. data/lib/rubylisp/prim_assignment.rb +61 -0
  25. data/lib/rubylisp/prim_character.rb +273 -0
  26. data/lib/rubylisp/{ffi_class.rb → prim_class_object.rb} +16 -69
  27. data/lib/rubylisp/prim_environment.rb +203 -0
  28. data/lib/rubylisp/prim_equivalence.rb +93 -0
  29. data/lib/rubylisp/prim_frame.rb +166 -0
  30. data/lib/rubylisp/prim_io.rb +266 -0
  31. data/lib/rubylisp/prim_list_support.rb +496 -0
  32. data/lib/rubylisp/{logical.rb → prim_logical.rb} +9 -14
  33. data/lib/rubylisp/prim_math.rb +397 -0
  34. data/lib/rubylisp/prim_native_object.rb +21 -0
  35. data/lib/rubylisp/prim_relational.rb +42 -0
  36. data/lib/rubylisp/{special_forms.rb → prim_special_forms.rb} +97 -84
  37. data/lib/rubylisp/prim_string.rb +792 -0
  38. data/lib/rubylisp/prim_system.rb +55 -0
  39. data/lib/rubylisp/prim_type_checks.rb +58 -0
  40. data/lib/rubylisp/prim_vector.rb +497 -0
  41. data/lib/rubylisp/primitive.rb +51 -6
  42. data/lib/rubylisp/string.rb +4 -803
  43. data/lib/rubylisp/symbol.rb +0 -1
  44. data/lib/rubylisp/tokenizer.rb +160 -136
  45. data/lib/rubylisp/vector.rb +10 -31
  46. data/lib/rubymotion/debug.rb +40 -0
  47. data/lib/rubymotion/require-fix.rb +1 -0
  48. data/lib/rubymotionlisp.rb +4 -0
  49. metadata +28 -17
  50. data/lib/rubylisp/alist.rb +0 -230
  51. data/lib/rubylisp/assignment.rb +0 -65
  52. data/lib/rubylisp/equivalence.rb +0 -118
  53. data/lib/rubylisp/io.rb +0 -74
  54. data/lib/rubylisp/list_support.rb +0 -526
  55. data/lib/rubylisp/math.rb +0 -405
  56. data/lib/rubylisp/motion_builtins.rb +0 -31
  57. data/lib/rubylisp/relational.rb +0 -46
  58. data/lib/rubylisp/system.rb +0 -20
  59. data/lib/rubylisp/testing.rb +0 -136
  60. data/lib/rubylisp/type_checks.rb +0 -60
@@ -0,0 +1,55 @@
1
+ module Lisp
2
+
3
+ class PrimSystem
4
+
5
+ def self.register
6
+ Primitive.register("sleep", "1") {|args, env| Lisp::PrimSystem.sleep_impl(args, env) }
7
+ Primitive.register("time", "1", "", true) {|args, env| Lisp::PrimSystem.time_impl(args, env) }
8
+ Primitive.register("quit", "0") {|args, env| exit() }
9
+ Primitive.register("error", "1") {|args, env| Lisp::PrimSystem.error_impl(args, env) }
10
+ Primitive.register("on-error", "2|3", "", true) {|args, env| Lisp::PrimSystem.on_error_impl(args, env) }
11
+ end
12
+
13
+
14
+ def self.sleep_impl(args, env)
15
+ arg = args.car
16
+ return Lisp::Debug.process_error("sleep needs a numeric argument", env) unless arg.number?
17
+ sleep(arg.value)
18
+ end
19
+
20
+
21
+ def self.time_impl(args, env)
22
+ start_time = Time.now
23
+ args.car.evaluate(env)
24
+ end_time = Time.now
25
+ Lisp::Number.with_value(end_time - start_time)
26
+ end
27
+
28
+
29
+ def self.error_impl(args, env)
30
+ #puts "error #{args.car.print_string}"
31
+ Lisp::Debug.process_error(args.car.to_s, env)
32
+ end
33
+
34
+
35
+ def self.on_error_impl(args, env)
36
+ #puts "on-error ===> #{args.car.body.print_string}"
37
+ begin
38
+ result = args.car.evaluate(env)
39
+ rescue => e
40
+ handler = args.cadr.evaluate(env)
41
+ return Lisp::Debug.process_error("on-error needs a function as it's second argument", env) unless handler.function?
42
+ #puts "ERROR: #{e}"
43
+ err_string = Lisp::String.with_value("#{e}")
44
+ handler.apply_to(Lisp::ConsCell.array_to_list([err_string]), env)
45
+ else
46
+ if args.length == 3
47
+ handler = args.caddr.evaluate(env)
48
+ return Lisp::Debug.process_error("on-error needs a function as it's third argument", env) unless handler.function?
49
+ handler.apply_to(nil, env)
50
+ end
51
+ end
52
+ end
53
+
54
+ end
55
+ end
@@ -0,0 +1,58 @@
1
+ module Lisp
2
+
3
+ class PrimTypeChecks
4
+
5
+ def self.register
6
+ Primitive.register("list?", "1") {|args, env| Lisp::PrimTypeChecks::typep_impl(args.car, :pair) }
7
+ Primitive.register("pair?", "1") {|args, env| Lisp::PrimTypeChecks::typep_impl(args.car, :pair) }
8
+ Primitive.register("symbol?", "1") {|args, env| Lisp::PrimTypeChecks::typep_impl(args.car, :symbol) }
9
+ Primitive.register("number?", "1") {|args, env| Lisp::PrimTypeChecks::typep_impl(args.car, :number) }
10
+ Primitive.register("frame?", "1") {|args, env| Lisp::PrimTypeChecks::typep_impl(args.car, :frame) }
11
+
12
+ Primitive.register("integer?", "1") {|args, env| Lisp::PrimTypeChecks::integerp_impl(args, env) }
13
+ Primitive.register("float?", "1") {|args, env| Lisp::PrimTypeChecks::floatp_impl(args, env) }
14
+ Primitive.register("function?", "1") {|args, env| Lisp::PrimTypeChecks::functionp_impl(args, env) }
15
+
16
+ Primitive.register("nil?", "1") {|args, env| Lisp::PrimTypeChecks::nilp_impl(args, env) }
17
+ Primitive.register("null?", "1") {|args, env| Lisp::PrimTypeChecks::nilp_impl(args, env) }
18
+ Primitive.register("not-nil?", "1") {|args, env| Lisp::PrimTypeChecks::not_nilp_impl(args, env) }
19
+ Primitive.register("not-null?", "1") {|args, env| Lisp::PrimTypeChecks::not_nilp_impl(args, env) }
20
+ end
21
+
22
+
23
+ def self.typep_impl(val, sym)
24
+ return Lisp::Boolean.with_value(val.type == sym)
25
+ end
26
+
27
+
28
+ def self.integerp_impl(args, env)
29
+ val = args.car
30
+ return Lisp::Boolean.with_value(val.type == :number && val.integer?)
31
+ end
32
+
33
+
34
+ def self.floatp_impl(args, env)
35
+ val = args.car
36
+ return Lisp::Boolean.with_value(val.type == :number && val.float?)
37
+ end
38
+
39
+
40
+ def self.functionp_impl(args, env)
41
+ val = args.car
42
+ return Lisp::Boolean.with_value(val.type == :function || val.type == :primitive)
43
+ end
44
+
45
+
46
+ def self.nilp_impl(args, env)
47
+ return Lisp::Boolean.with_value(args.car.nil? || (args.car.pair? && args.car.empty?))
48
+ end
49
+
50
+
51
+ def self.not_nilp_impl(args, env)
52
+ return Lisp::FALSE if args.car.nil?
53
+ return Lisp::TRUE unless args.car.pair?
54
+ return Lisp::Boolean.with_value(args.car.pair? && !args.car.empty?)
55
+ end
56
+
57
+ end
58
+ end
@@ -0,0 +1,497 @@
1
+ module Lisp
2
+
3
+ class PrimVector
4
+
5
+ def self.register
6
+ Primitive.register("vector?", "1") {|args, env| Lisp::PrimVector::vectorp_impl(args, env) }
7
+ Primitive.register("make-vector", "1|2") {|args, env| Lisp::PrimVector::make_vector_impl(args, env) }
8
+ Primitive.register("make-initialized-vector", "2") {|args, env| Lisp::PrimVector::make_initialized_vector_impl(args, env) }
9
+ Primitive.register("vector", "*") {|args, env| Lisp::PrimVector::vector_impl(args, env) }
10
+ Primitive.register("list->vector", "1") {|args, env| Lisp::PrimVector::list_to_vector_impl(args, env) }
11
+ Primitive.register("vector->list", "1") {|args, env| Lisp::PrimVector::vector_to_list_impl(args, env) }
12
+ Primitive.register("vector-copy", "1") {|args, env| Lisp::PrimVector::vector_copy_impl(args, env) }
13
+ Primitive.register("vector-grow", "2") {|args, env| Lisp::PrimVector::vector_grow_impl(args, env) }
14
+ Primitive.register("vector-map", "2") {|args, env| Lisp::PrimVector::vector_map_impl(args, env) }
15
+ Primitive.register("vector-reduce-left", "3") {|args, env| Lisp::PrimVector::vector_reduce_left_impl(args, env) }
16
+ Primitive.register("vector-for-each", "2") {|args, env| Lisp::PrimVector::vector_for_each_impl(args, env) }
17
+ Primitive.register("vector-length", "1") {|args, env| Lisp::PrimVector::vector_length_impl(args, env) }
18
+ Primitive.register("vector-ref", "2") {|args, env| Lisp::PrimVector::vector_ref_impl(args, env) }
19
+ Primitive.register("vector-set!", "3") {|args, env| Lisp::PrimVector::vector_set_impl(args, env) }
20
+ Primitive.register("vector-first", "1") {|args, env| Lisp::PrimVector::vector_first_impl(args, env) }
21
+ Primitive.register("vector-second", "1") {|args, env| Lisp::PrimVector::vector_second_impl(args, env) }
22
+ Primitive.register("vector-third", "1") {|args, env| Lisp::PrimVector::vector_third_impl(args, env) }
23
+ Primitive.register("vector-fourth", "1") {|args, env| Lisp::PrimVector::vector_fourth_impl(args, env) }
24
+ Primitive.register("vector-fifth", "1") {|args, env| Lisp::PrimVector::vector_fifth_impl(args, env) }
25
+ Primitive.register("vector-sixth", "1") {|args, env| Lisp::PrimVector::vector_sixth_impl(args, env) }
26
+ Primitive.register("vector-seventh", "1") {|args, env| Lisp::PrimVector::vector_seventh_impl(args, env) }
27
+ Primitive.register("vector-eighth", "1") {|args, env| Lisp::PrimVector::vector_eighth_impl(args, env) }
28
+ Primitive.register("vector-ninth", "1") {|args, env| Lisp::PrimVector::vector_ninth_impl(args, env) }
29
+ Primitive.register("vector-tenth", "1") {|args, env| Lisp::PrimVector::vector_tenth_impl(args, env) }
30
+ Primitive.register("vector-binary-search", "4") {|args, env| Lisp::PrimVector::vector_binary_search_impl(args, env) }
31
+ Primitive.register("subvector", "3") {|args, env| Lisp::PrimVector::subvector_impl(args, env) }
32
+ Primitive.register("vector-head", "2") {|args, env| Lisp::PrimVector::vector_head_impl(args, env) }
33
+ Primitive.register("vector-tail", "2") {|args, env| Lisp::PrimVector::vector_tail_impl(args, env) }
34
+ Primitive.register("vector-fill!", "2") {|args, env| Lisp::PrimVector::vector_fill_impl(args, env) }
35
+ Primitive.register("subvector-fill!", "4") {|args, env| Lisp::PrimVector::subvector_fill_impl(args, env) }
36
+ Primitive.register("subvector-move-left!", "5") {|args, env| Lisp::PrimVector::subvector_move_left_impl(args, env) }
37
+ Primitive.register("subvector-move-right!", "5") {|args, env| Lisp::PrimVector::subvector_move_right_impl(args, env) }
38
+ Primitive.register("vector-filter", "2") {|args, env| Lisp::PrimVector::vector_filter_impl(args, env) }
39
+ Primitive.register("vector-remove", "2") {|args, env| Lisp::PrimVector::vector_remove_impl(args, env) }
40
+ Primitive.register("sort!", "2") {|args, env| Lisp::PrimVector::vector_merge_sort_impl(args, env) }
41
+ Primitive.register("merge-sort!", "2") {|args, env| Lisp::PrimVector::vector_merge_sort_impl(args, env) }
42
+ Primitive.register("quick-sort!", "2") {|args, env| Lisp::PrimVector::vector_quick_sort_impl(args, env) }
43
+ end
44
+
45
+ def self.vectorp_impl(args, env)
46
+ Boolean.with_value(args.car.vector?)
47
+ end
48
+
49
+
50
+ def self.make_initialized_vector_impl(args, env)
51
+ k = args.car
52
+ return Lisp::Debug.process_error("make-vector requires its first argument to be a non-negative integer, but received #{k.to_s}.", env) unless k.integer? && k.value >= 0
53
+ proc = args.cadr
54
+ return Lisp::Debug.process_error("make-initialized-vector requires its second argument to be a procedure, but received #{proc.to_s}.", env) unless proc.function? || proc.primitive?
55
+ a = Array.new(k.value) {|i| proc.apply_to(Lisp::ConsCell.array_to_list([Lisp::Number.with_value(i)]), env)}
56
+ Lisp::Vector.with_array(a)
57
+ end
58
+
59
+
60
+ def self.make_vector_impl(args, env)
61
+ k = args.car
62
+ return Lisp::Debug.process_error("make-vector requires its first argument to be a non-negative integer, but received #{k.to_s}.", env) unless k.integer? && k.value >= 0
63
+ obj = (args.length == 2) ? args.cadr : nil
64
+ Lisp::Vector.new(Array.new(k.value, obj))
65
+ end
66
+
67
+
68
+ def self.vector_impl(args, env)
69
+ Lisp::Vector.with_array(args.to_a)
70
+ end
71
+
72
+
73
+ def self.list_to_vector_impl(args, env)
74
+ l = args.car
75
+ return Lisp::Debug.process_error("list->vector requires its first argument to be a list, but received #{l.to_s}.", env) unless l.list?
76
+ Lisp::Vector.with_array(l.to_a)
77
+ end
78
+
79
+
80
+ def self.vector_to_list_impl(args, env)
81
+ v = args.car
82
+ return Lisp::Debug.process_error("vector->list requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
83
+ Lisp::ConsCell.array_to_list(v.to_a)
84
+ end
85
+
86
+
87
+ def self.vector_copy_impl(args, env)
88
+ v = args.car
89
+ return Lisp::Debug.process_error("list->vector requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
90
+ Lisp::Vector.with_array(v.to_a.clone)
91
+ end
92
+
93
+
94
+ def self.vector_grow_impl(args, env)
95
+ v = args.car
96
+ return Lisp::Debug.process_error("vector-grow requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
97
+ len = v.length
98
+ k = args.cadr
99
+ return Lisp::Debug.process_error("vector-grow requires its second argument to be a non-negative integer > the length of the vector, but received #{k.to_s}.", env) unless k.integer? && k.value > len
100
+ new_array = v.to_a.clone
101
+ new_array[len..len] = Array.new(k.value - len)
102
+ Lisp::Vector.with_array(new_array)
103
+ end
104
+
105
+
106
+ def self.vector_map_impl(args, env)
107
+ proc = args.car
108
+ return Lisp::Debug.process_error("vector-map requires its first argument to be a procedure, but received #{proc.to_s}.", env) unless proc.function? || proc.primitive?
109
+ v = args.cadr
110
+ return Lisp::Debug.process_error("vector-map requires its second argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
111
+ Lisp::Vector.with_array(v.to_a.collect {|e| proc.apply_to_without_evaluating(Lisp::ConsCell.array_to_list([e]), env)})
112
+ end
113
+
114
+
115
+ def self.vector_reduce_left_impl(args, env)
116
+ proc = args.car
117
+ return Lisp::Debug.process_error("vector-reduce-left requires its first argument to be a procedure, but received #{proc.to_s}.", env) unless proc.function? || proc.primitive?
118
+ initial = args.cadr
119
+ v = args.caddr
120
+ return Lisp::Debug.process_error("vector-reduce-left requires its second argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
121
+ return initial if v.empty?
122
+ return v.at(0) if v.length == 1
123
+ v.to_a.inject do |acc, item|
124
+ proc.apply_to_without_evaluating(Lisp::ConsCell.array_to_list([acc, item]), env)
125
+ end
126
+ end
127
+
128
+
129
+ def self.vector_for_each_impl(args, env)
130
+ proc = args.car
131
+ return Lisp::Debug.process_error("vector-for-each requires its first argument to be a procedure, but received #{proc.to_s}.", env) unless proc.function? || proc.primitive?
132
+ v = args.cadr
133
+ return Lisp::Debug.process_error("vector-for-each requires its second argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
134
+ v.to_a.each {|e| proc.apply_to_without_evaluating(Lisp::ConsCell.array_to_list([e]), env)}
135
+ nil
136
+ end
137
+
138
+
139
+ def self.vector_length_impl(args, env)
140
+ v = args.car
141
+ return Lisp::Debug.process_error("vector-length requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
142
+ Lisp::Number.with_value(v.to_a.length)
143
+ end
144
+
145
+
146
+ def self.vector_ref_impl(args, env)
147
+ v = args.car
148
+ return Lisp::Debug.process_error("vector-ref requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
149
+ len = v.length
150
+ k = args.cadr
151
+ return Lisp::Debug.process_error("vector-ref requires its second argument to be a non-negative integer < the length of the vector, but received #{k.to_s}.", env) unless k.integer? && k.value < len
152
+ v.at(k.value)
153
+ end
154
+
155
+
156
+ def self.vector_set_impl(args, env)
157
+ v = args.car
158
+ return Lisp::Debug.process_error("vector-set requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
159
+ len = v.length
160
+ k = args.cadr
161
+ return Lisp::Debug.process_error("vector-set requires its second argument to be a non-negative integer < the length of the vector, but received #{k.to_s}.", env) unless k.integer? && k.value < len
162
+ obj = args.caddr
163
+ v.at_put(k.value, obj)
164
+ v
165
+ end
166
+
167
+
168
+ def self.vector_first_impl(args, env)
169
+ v = args.car
170
+ return Lisp::Debug.process_error("vector-first requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
171
+ return Lisp::Debug.process_error("vector index out of bounds", env) unless v.length >= 1
172
+ v.at(0)
173
+ end
174
+
175
+
176
+ def self.vector_second_impl(args, env)
177
+ v = args.car
178
+ return Lisp::Debug.process_error("vector-second requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
179
+ return Lisp::Debug.process_error("vector index out of bounds", env) unless v.length >= 2
180
+ v.at(1)
181
+ end
182
+
183
+
184
+ def self.vector_third_impl(args, env)
185
+ v = args.car
186
+ return Lisp::Debug.process_error("vector-third requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
187
+ return Lisp::Debug.process_error("vector index out of bounds", env) unless v.length >= 3
188
+ v.at(2)
189
+ end
190
+
191
+
192
+ def self.vector_fourth_impl(args, env)
193
+ v = args.car
194
+ return Lisp::Debug.process_error("vector-fourth requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
195
+ return Lisp::Debug.process_error("vector index out of bounds", env) unless v.length >= 4
196
+ v.at(3)
197
+ end
198
+
199
+
200
+ def self.vector_fifth_impl(args, env)
201
+ v = args.car
202
+ return Lisp::Debug.process_error("vector-fifth requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
203
+ return Lisp::Debug.process_error("vector index out of bounds", env) unless v.length >= 5
204
+ v.at(4)
205
+ end
206
+
207
+
208
+ def self.vector_sixth_impl(args, env)
209
+ v = args.car
210
+ return Lisp::Debug.process_error("vector-sixth requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
211
+ return Lisp::Debug.process_error("vector index out of bounds", env) unless v.length >= 6
212
+ v.at(5)
213
+ end
214
+
215
+
216
+ def self.vector_seventh_impl(args, env)
217
+ v = args.car
218
+ return Lisp::Debug.process_error("vector-seventh requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
219
+ return Lisp::Debug.process_error("vector index out of bounds", env) unless v.length >= 7
220
+ v.at(6)
221
+ end
222
+
223
+
224
+ def self.vector_eighth_impl(args, env)
225
+ v = args.car
226
+ return Lisp::Debug.process_error("vector-eighth requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
227
+ return Lisp::Debug.process_error("vector index out of bounds", env) unless v.length >= 8
228
+ v.at(7)
229
+ end
230
+
231
+
232
+ def self.vector_ninth_impl(args, env)
233
+ v = args.car
234
+ return Lisp::Debug.process_error("vector-ninth requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
235
+ return Lisp::Debug.process_error("vector index out of bounds", env) unless v.length >= 9
236
+ v.at(8)
237
+ end
238
+
239
+
240
+ def self.vector_tenth_impl(args, env)
241
+ v = args.car
242
+ return Lisp::Debug.process_error("vector-tenth requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
243
+ return Lisp::Debug.process_error("vector index out of bounds", env) unless v.length >= 10
244
+ v.at(9)
245
+ end
246
+
247
+
248
+ def self.vector_binary_search_impl(args, env)
249
+ v = args.car
250
+ return Lisp::Debug.process_error("vector-binary-search requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
251
+
252
+ comparison_predicate = args.cadr
253
+ return Lisp::Debug.process_error("vector-binary-search requires its second argument to be a procedure, but received #{comparison_predicate.to_s}.", env) unless comparison_predicate.function? || comparison_predicate.primitive?
254
+
255
+ unwrap_proc = args.caddr
256
+ return Lisp::Debug.process_error("vector-binary-search requires its third argument to be a procedure, but received #{unwrap_proc.to_s}.", env) unless unwrap_proc.function? || unwrap_proc.primitive?
257
+
258
+ key = args.cadddr
259
+
260
+ lo = 0
261
+ hi = v.length - 1
262
+
263
+ while lo <= hi
264
+ mid = lo + (hi - lo) / 2
265
+ val = unwrap_proc.apply_to_without_evaluating(Lisp::ConsCell.cons(v.at(mid)), env)
266
+ return v.at(mid) if key.equal?(val)
267
+ if comparison_predicate.apply_to_without_evaluating(Lisp::ConsCell.array_to_list([key, val]), env).value
268
+ hi = mid - 1
269
+ else
270
+ lo = mid + 1
271
+ end
272
+ end
273
+ Lisp::FALSE
274
+ end
275
+
276
+
277
+ def self.subvector_impl(args, env)
278
+ v = args.car
279
+ return Lisp::Debug.process_error("subvector requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
280
+ len = v.length
281
+ s = args.cadr
282
+ return Lisp::Debug.process_error("subvector requires its second argument to be a non-negative integer < the length of the vector, but received #{s.to_s}.", env) unless s.integer? && s.value >= 0 && s.value < len
283
+ e = args.caddr
284
+ return Lisp::Debug.process_error("subvector requires its third argument to be a non-negative integer >= the second argument and <= the length of the vector, but received #{e.to_s}.", env) unless e.integer? && e.value >= s.value && e.value <= len
285
+ Vector.with_array(v.to_a[s.value...e.value])
286
+ end
287
+
288
+
289
+ def self.vector_head_impl(args, env)
290
+ v = args.car
291
+ return Lisp::Debug.process_error("vector-head requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
292
+ e = args.cadr
293
+ return Lisp::Debug.process_error("vector-head requires its second argument to be a non-negative integer <= the length of the vector, but received #{e.to_s}.", env) unless e.integer? && e.value >= 0 && e.value <= v.length
294
+ Vector.with_array(v.to_a[0...e.value])
295
+ end
296
+
297
+
298
+ def self.vector_tail_impl(args, env)
299
+ v = args.car
300
+ return Lisp::Debug.process_error("vector-tail requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
301
+ s = args.cadr
302
+ return Lisp::Debug.process_error("vector-tail requires its second argument to be a non-negative integer <= the length of the vector, but received #{s.to_s}.", env) unless s.integer? && s.value >= 0 && s.value <= v.length
303
+ Vector.with_array(v.to_a[s.value..-1])
304
+ end
305
+
306
+
307
+ def self.vector_fill_impl(args, env)
308
+ v = args.car
309
+ return Lisp::Debug.process_error("vector-tail requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
310
+ obj = args.cadr
311
+ (0...v.length).each {|i| v.at_put(i, obj)}
312
+ v
313
+ end
314
+
315
+
316
+ def self.subvector_fill_impl(args, env)
317
+ v = args.car
318
+ return Lisp::Debug.process_error("subvector requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
319
+ len = v.length
320
+ s = args.cadr
321
+ return Lisp::Debug.process_error("subvector requires its second argument to be a non-negative integer < the length of the vector, but received #{s.to_s}.", env) unless s.integer? && s.value >= 0 && s.value < len
322
+ e = args.caddr
323
+ return Lisp::Debug.process_error("subvector requires its third argument to be a non-negative integer >= the second argument and <= the length of the vector, but received #{e.to_s}.", env) unless e.integer? && e.value >= s.value && e.value <= len
324
+ obj = args.cadddr
325
+ (s.value...e.value).each {|i| v.at_put(i, obj)}
326
+ v
327
+ end
328
+
329
+
330
+ def self.vector_filter_impl(args, env)
331
+ proc = args.car
332
+ return Lisp::Debug.process_error("vector-filter requires its first argument to be a procedure, but received #{proc.to_s}.", env) unless proc.function? || proc.primitive?
333
+ v = args.cadr
334
+ return Lisp::Debug.process_error("vector-filter requires its second argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
335
+ new_array = v.to_a.select {|e| proc.apply_to_without_evaluating(Lisp::ConsCell.cons(e), env).value}
336
+ Lisp::Vector.with_array(new_array)
337
+ end
338
+
339
+
340
+ def self.vector_remove_impl(args, env)
341
+ proc = args.car
342
+ return Lisp::Debug.process_error("vector-remove requires its first argument to be a procedure, but received #{proc.to_s}.", env) unless proc.function? || proc.primitive?
343
+ v = args.cadr
344
+ return Lisp::Debug.process_error("vector-remove requires its second argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
345
+ new_array = v.to_a.reject {|e| proc.apply_to_without_evaluating(Lisp::ConsCell.cons(e), env).value}
346
+ Lisp::Vector.with_array(new_array)
347
+ end
348
+
349
+
350
+ def self.subvector_move_left_impl(args, env)
351
+ v1 = args.car
352
+ return Lisp::Debug.process_error("subvector-move-left! requires its first argument to be a vector, but received #{v1.to_s}.", env) unless v1.vector?
353
+ len1 = v1.length
354
+
355
+ s1 = args.cadr
356
+ return Lisp::Debug.process_error("subvector-move-left! requires its second argument to be a non-negative integer < the length of the vector, but received #{s1.to_s}.", env) unless s1.integer? && s1.value >= 0 && s1.value < len1
357
+
358
+ e1 = args.caddr
359
+ return Lisp::Debug.process_error("subvector-move-left! requires its third argument to be a non-negative integer >= the second argument and <= the length of the vector, but received #{e1.to_s}.", env) unless e1.integer? && e1.value >= s1.value && e1.value <= len1
360
+
361
+ v2 = args.cadddr
362
+ return Lisp::Debug.process_error("subvector-move-left! requires its fourth argument to be a vector, but received #{v2.to_s}.", env) unless v2.vector?
363
+ len2 = v2.length
364
+
365
+ s2 = args.caddddr
366
+ return Lisp::Debug.process_error("subvector-move-left! requires its fifth argument to be a non-negative integer < the length of the vector, but received #{s2.to_s}.", env) unless s2.integer? && s2.value >= 0 && s2.value < len2
367
+
368
+ source_length = e1.value - s1.value
369
+ tail_size2 = len2 - s2.value
370
+ return Lisp::Debug.process_error("subvector-move-left! source subvector is longer than the available space in the destination (0-#{tail_size2}), got #{source_length}.", env) unless source_length < tail_size2
371
+
372
+ i1 = s1.value
373
+ i2 = s2.value
374
+ while i1 < e1.value
375
+ v2.at_put(i2, v1.at(i1))
376
+ i1 = i1 + 1
377
+ i2 = i2 + 1
378
+ end
379
+
380
+ v2
381
+ end
382
+
383
+
384
+ def self.subvector_move_right_impl(args, env)
385
+ v1 = args.car
386
+ return Lisp::Debug.process_error("subvector-move-right! requires its first argument to be a vector, but received #{v1.to_s}.", env) unless v1.vector?
387
+ len1 = v1.length
388
+
389
+ s1 = args.cadr
390
+ return Lisp::Debug.process_error("subvector-move-right! requires its second argument to be a non-negative integer < the length of the vector, but received #{s1.to_s}.", env) unless s1.integer? && s1.value >= 0 && s1.value < len1
391
+
392
+ e1 = args.caddr
393
+ return Lisp::Debug.process_error("subvector-move-right! requires its third argument to be a non-negative integer >= the second argument and <= the length of the vector, but received #{e1.to_s}.", env) unless e1.integer? && e1.value >= s1.value && e1.value <= len1
394
+
395
+ v2 = args.cadddr
396
+ return Lisp::Debug.process_error("subvector-move-right! requires its fourth argument to be a vector, but received #{v2.to_s}.", env) unless v2.vector?
397
+ len2 = v2.length
398
+
399
+ s2 = args.caddddr
400
+ return Lisp::Debug.process_error("subvector-move-right! requires its fifth argument to be a non-negative integer < the length of the vector, but received #{s2.to_s}.", env) unless s2.integer? && s2.value >= 0 && s2.value < len2
401
+
402
+ source_length = e1.value - s1.value
403
+ tail_size2 = len2 - s2.value
404
+ return Lisp::Debug.process_error("subvector-move-right! source subvector is longer than the available space in the destination (0-#{tail_size2}), got #{source_length}.", env) unless source_length < tail_size2
405
+
406
+ i1 = e1.value - 1
407
+ i2 = s2.value + source_length - 1
408
+ while i1 >= s1.value
409
+ v2.at_put(i2, v1.at(i1))
410
+ i1 = i1 - 1
411
+ i2 = i2 - 1
412
+ end
413
+
414
+ v2
415
+ end
416
+
417
+
418
+ def self.merge(left, right, comparison_predicate, env)
419
+ result = []
420
+ while !left.empty? && !right.empty?
421
+ if comparison_predicate.apply_to_without_evaluating(Lisp::ConsCell.array_to_list([left[0], right[0]]), env).value
422
+ result << left.shift
423
+ else
424
+ result << right.shift
425
+ end
426
+ end
427
+ result[result.length..result.length] = left
428
+ result[result.length..result.length] = right
429
+ result
430
+ end
431
+
432
+
433
+ def self.merge_sort(m, comparison_predicate, env)
434
+ return m if m.length <= 1
435
+ middle = m.length / 2
436
+ left = m[0...middle]
437
+ right = m[middle..-1]
438
+ merge(merge_sort(left, comparison_predicate, env), merge_sort(right, comparison_predicate, env), comparison_predicate, env)
439
+ end
440
+
441
+
442
+ def self.vector_merge_sort_impl(args, env)
443
+ v = args.car
444
+ return Lisp::Debug.process_error("merge-sort! requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
445
+
446
+ comparison_predicate = args.cadr
447
+ return Lisp::Debug.process_error("merge-sort! requires its second argument to be a procedure, but received #{comparison_predicate.to_s}.", env) unless comparison_predicate.function? || comparison_predicate.primitive?
448
+
449
+ v.update!(merge_sort(v.to_a, comparison_predicate, env))
450
+ v
451
+ end
452
+
453
+
454
+ def self.partition(v, lo, hi, comparison_predicate, env)
455
+ pivot = v[lo]
456
+ i = lo - 1
457
+ j = hi + 1
458
+ while true
459
+ begin
460
+ j = j - 1
461
+ end while comparison_predicate.apply_to_without_evaluating(Lisp::ConsCell.array_to_list([pivot, v[j]]), env).value
462
+ begin
463
+ i = i + 1
464
+ end while comparison_predicate.apply_to_without_evaluating(Lisp::ConsCell.array_to_list([v[i], pivot]), env).value
465
+ if i < j
466
+ v[i], v[j] = v[j], v[i]
467
+ else
468
+ return j
469
+ end
470
+ end
471
+ end
472
+
473
+
474
+ def self.quicksort(v, lo, hi, comparison_predicate, env)
475
+ if lo < hi
476
+ p = partition(v, lo, hi, comparison_predicate, env)
477
+ quicksort(v, lo, p, comparison_predicate, env)
478
+ quicksort(v, p + 1, hi, comparison_predicate, env)
479
+ end
480
+ v
481
+ end
482
+
483
+
484
+ def self.vector_quick_sort_impl(args, env)
485
+ v = args.car
486
+ return Lisp::Debug.process_error("quick-sort! requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
487
+
488
+ comparison_predicate = args.cadr
489
+ return Lisp::Debug.process_error("quick-sort! requires its second argument to be a procedure, but received #{comparison_predicate.to_s}.", env) unless comparison_predicate.function? || comparison_predicate.primitive?
490
+ v.update!(quicksort(v.to_a, 0, v.length - 1, comparison_predicate, env))
491
+ v
492
+ end
493
+
494
+
495
+ end
496
+
497
+ end