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.
- checksums.yaml +4 -4
- data/README.md +129 -2
- data/lib/rubylisp/atom.rb +25 -6
- data/lib/rubylisp/boolean.rb +9 -6
- data/lib/rubylisp/builtins.rb +33 -0
- data/lib/rubylisp/character.rb +14 -275
- data/lib/rubylisp/class_object.rb +56 -0
- data/lib/rubylisp/cons_cell.rb +50 -20
- data/lib/rubylisp/environment.rb +27 -0
- data/lib/rubylisp/environment_frame.rb +24 -6
- data/lib/rubylisp/eof_object.rb +26 -0
- data/lib/rubylisp/exception.rb +61 -61
- data/lib/rubylisp/ext.rb +32 -6
- data/lib/rubylisp/ffi_new.rb +2 -1
- data/lib/rubylisp/ffi_send.rb +15 -5
- data/lib/rubylisp/frame.rb +5 -164
- data/lib/rubylisp/function.rb +4 -3
- data/lib/rubylisp/macro.rb +13 -8
- data/lib/rubylisp/{object.rb → native_object.rb} +0 -15
- data/lib/rubylisp/number.rb +5 -0
- data/lib/rubylisp/parser.rb +81 -52
- data/lib/rubylisp/port.rb +27 -0
- data/lib/rubylisp/prim_alist.rb +115 -0
- data/lib/rubylisp/prim_assignment.rb +61 -0
- data/lib/rubylisp/prim_character.rb +273 -0
- data/lib/rubylisp/{ffi_class.rb → prim_class_object.rb} +16 -69
- data/lib/rubylisp/prim_environment.rb +203 -0
- data/lib/rubylisp/prim_equivalence.rb +93 -0
- data/lib/rubylisp/prim_frame.rb +166 -0
- data/lib/rubylisp/prim_io.rb +266 -0
- data/lib/rubylisp/prim_list_support.rb +496 -0
- data/lib/rubylisp/{logical.rb → prim_logical.rb} +9 -14
- data/lib/rubylisp/prim_math.rb +397 -0
- data/lib/rubylisp/prim_native_object.rb +21 -0
- data/lib/rubylisp/prim_relational.rb +42 -0
- data/lib/rubylisp/{special_forms.rb → prim_special_forms.rb} +97 -84
- data/lib/rubylisp/prim_string.rb +792 -0
- data/lib/rubylisp/prim_system.rb +55 -0
- data/lib/rubylisp/prim_type_checks.rb +58 -0
- data/lib/rubylisp/prim_vector.rb +497 -0
- data/lib/rubylisp/primitive.rb +51 -6
- data/lib/rubylisp/string.rb +4 -803
- data/lib/rubylisp/symbol.rb +0 -1
- data/lib/rubylisp/tokenizer.rb +160 -136
- data/lib/rubylisp/vector.rb +10 -31
- data/lib/rubymotion/debug.rb +40 -0
- data/lib/rubymotion/require-fix.rb +1 -0
- data/lib/rubymotionlisp.rb +4 -0
- metadata +28 -17
- data/lib/rubylisp/alist.rb +0 -230
- data/lib/rubylisp/assignment.rb +0 -65
- data/lib/rubylisp/equivalence.rb +0 -118
- data/lib/rubylisp/io.rb +0 -74
- data/lib/rubylisp/list_support.rb +0 -526
- data/lib/rubylisp/math.rb +0 -405
- data/lib/rubylisp/motion_builtins.rb +0 -31
- data/lib/rubylisp/relational.rb +0 -46
- data/lib/rubylisp/system.rb +0 -20
- data/lib/rubylisp/testing.rb +0 -136
- 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
|