rubylisp 0.2.1 → 1.0.2
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +4 -4
- data/README.md +129 -2
- data/bin/rubylisp +87 -12
- data/lib/rubylisp/atom.rb +25 -6
- data/lib/rubylisp/boolean.rb +9 -6
- data/lib/rubylisp/builtins.rb +19 -18
- data/lib/rubylisp/character.rb +14 -275
- data/lib/rubylisp/class_object.rb +56 -0
- data/lib/rubylisp/cons_cell.rb +56 -25
- data/lib/rubylisp/debug.rb +15 -19
- data/lib/rubylisp/environment.rb +27 -0
- data/lib/rubylisp/environment_frame.rb +31 -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} +98 -85
- 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 +161 -137
- data/lib/rubylisp/vector.rb +10 -31
- data/lib/rubylisp.rb +1 -0
- metadata +46 -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/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
data/lib/rubylisp/character.rb
CHANGED
@@ -3,278 +3,6 @@ module Lisp
|
|
3
3
|
|
4
4
|
class Character < Atom
|
5
5
|
|
6
|
-
def self.register
|
7
|
-
Primitive.register("char->name", "(char->name char)\n\nReturns a string corresponding to the printed representation of char. This is the character or character-name component of the external representation.") do |args, env|
|
8
|
-
Lisp::Character::char_name_impl(args, env)
|
9
|
-
end
|
10
|
-
|
11
|
-
Primitive.register("name->char", "(name->char string)\n\nConverts a string that names a character into the character specified. If string does not name any character, name->char signals an error.") do |args, env|
|
12
|
-
Lisp::Character::name_char_impl(args, env)
|
13
|
-
end
|
14
|
-
|
15
|
-
Primitive.register("char=?", "(char=? char1 char2)\n\nReturn whether char1 and char2 are the same") do |args, env|
|
16
|
-
Lisp::Character::char_eq_impl(args, env)
|
17
|
-
end
|
18
|
-
|
19
|
-
Primitive.register("char<?", "(char<? char1 char2)\n\nReturn whether char1 is less than char2") do |args, env|
|
20
|
-
Lisp::Character::char_lt_impl(args, env)
|
21
|
-
end
|
22
|
-
|
23
|
-
Primitive.register("char>?", "(char>? char1 char2)\n\nReturn whether char1 is greater than char2") do |args, env|
|
24
|
-
Lisp::Character::char_gt_impl(args, env)
|
25
|
-
end
|
26
|
-
|
27
|
-
Primitive.register("char<=?", "(char<=? char1 char2)\n\nReturn whether char1 is less than or equal to char2") do |args, env|
|
28
|
-
Lisp::Character::char_lteq_impl(args, env)
|
29
|
-
end
|
30
|
-
|
31
|
-
Primitive.register("char>=?", "(char>=? char1 char2)\n\nReturn whether char1 is greater than or equal to char2") do |args, env|
|
32
|
-
Lisp::Character::char_gteq_impl(args, env)
|
33
|
-
end
|
34
|
-
|
35
|
-
Primitive.register("char-ci=?", "(char=? char1 char2)\n\nReturn whether char1 is equal to char2, ignoring case") do |args, env|
|
36
|
-
Lisp::Character::char_ci_eq_impl(args, env)
|
37
|
-
end
|
38
|
-
|
39
|
-
Primitive.register("char-ci<?", "(char=? char1 char2)\n\nReturn whether char1 is less than char2, ignoring case") do |args, env|
|
40
|
-
Lisp::Character::char_ci_lt_impl(args, env)
|
41
|
-
end
|
42
|
-
|
43
|
-
Primitive.register("char-ci>?", "(char=? char1 char2)\n\nReturn whether char1 is greater than char2, ignoring case") do |args, env|
|
44
|
-
Lisp::Character::char_ci_gt_impl(args, env)
|
45
|
-
end
|
46
|
-
|
47
|
-
Primitive.register("char-ci<=?", "(char=? char1 char2)\n\nReturn whether char1 is less than or equal to char2, ignoring case") do |args, env|
|
48
|
-
Lisp::Character::char_ci_lteq_impl(args, env)
|
49
|
-
end
|
50
|
-
|
51
|
-
Primitive.register("char-ci>=?", "(char=? char1 char2)\n\nReturn whether char1 is greater than orequal to char2, ignoring case") do |args, env|
|
52
|
-
Lisp::Character::char_ci_gteq_impl(args, env)
|
53
|
-
end
|
54
|
-
|
55
|
-
Primitive.register("char?", "(char? sexpr)\n\nReturns #t if object is a character; otherwise returns #f.") do |args, env|
|
56
|
-
Lisp::Character::charp_impl(args, env)
|
57
|
-
end
|
58
|
-
|
59
|
-
Primitive.register("char-upcase", "(char-upcase char)\n\nReturns the uppercase equivalent of char if char is a letter; otherwise returns char. These procedures return a character char2 such that (char-ci=? char char2).") do |args, env|
|
60
|
-
Lisp::Character::char_upcase_impl(args, env)
|
61
|
-
end
|
62
|
-
|
63
|
-
Primitive.register("char-downcase", "(char-downcase char)\n\nReturns the lowercase equivalent of char if char is a letter; otherwise returns char. These procedures return a character char2 such that (char-ci=? char char2).") do |args, env|
|
64
|
-
Lisp::Character::char_downcase_impl(args, env)
|
65
|
-
end
|
66
|
-
|
67
|
-
Primitive.register("char->digit", "(char->digit char [radix])\n\nIf char is a character representing a digit in the given radix, returns the corresponding integer value. If you specify radix (which must be an integer between 2 and 36 inclusive), the conversion is done in that base, otherwise it is done in base 10. If char doesn’t represent a digit in base radix, char->digit returns #f.\n\nNote that this procedure is insensitive to the alphabetic case of char.") do |args, env|
|
68
|
-
Lisp::Character::char_digit_impl(args, env)
|
69
|
-
end
|
70
|
-
|
71
|
-
Primitive.register("digit->char", "(digit->char digit [radix])\n\nReturns a character that represents digit in the radix given by radix. Radix must be an exact integer between 2 and 36 (inclusive), and defaults to 10. Digit, which must be a non-negative integer, should be less than radix; if digit is greater than or equal to radix, digit->char returns #f.") do |args, env|
|
72
|
-
Lisp::Character::digit_char_impl(args, env)
|
73
|
-
end
|
74
|
-
|
75
|
-
Primitive.register("char->integer", "(char->integer char)\n\nchar->integer returns the character code representation for char.") do |args, env|
|
76
|
-
Lisp::Character::char_int_impl(args, env)
|
77
|
-
end
|
78
|
-
|
79
|
-
Primitive.register("integer->char", "(integer->char k)\n\ninteger->char returns the character whose character code representation is k.") do |args, env|
|
80
|
-
Lisp::Character::int_char_impl(args, env)
|
81
|
-
end
|
82
|
-
end
|
83
|
-
|
84
|
-
|
85
|
-
def self.find_character_for_chr(ch)
|
86
|
-
@@character_constants.each_value {|v| return v if v.value == ch}
|
87
|
-
return @@character_constants[ch] = Lisp::Character.new(ch)
|
88
|
-
end
|
89
|
-
|
90
|
-
|
91
|
-
def self.find_character_for_name(n)
|
92
|
-
return @@character_constants[n] if @@character_constants.has_key?(n)
|
93
|
-
if n.length == 1
|
94
|
-
ch = self.new(n[0])
|
95
|
-
return @@character_constants[n] = ch
|
96
|
-
end
|
97
|
-
nil
|
98
|
-
end
|
99
|
-
|
100
|
-
|
101
|
-
def self.char_name_impl(args, env)
|
102
|
-
return Lisp::Debug.process_error("char->name requires a single argument, found #{args.length}", env) unless args.length == 1
|
103
|
-
char = args.car.evaluate(env)
|
104
|
-
return Lisp::Debug.process_error("char->name requires a character argument", env) unless char.character?
|
105
|
-
kv = @@character_constants.rassoc(char)
|
106
|
-
return Lisp::String.with_value(kv[0]) unless kv.nil?
|
107
|
-
return Lisp::Debug.process_error("char->name was passed an invalid character", env)
|
108
|
-
end
|
109
|
-
|
110
|
-
|
111
|
-
def self.name_char_impl(args, env)
|
112
|
-
return Lisp::Debug.process_error("name->char requires a single argument, found #{args.length}", env) unless args.length == 1
|
113
|
-
name = args.car.evaluate(env)
|
114
|
-
return Lisp::Debug.process_error("name->char requires a string argument", env) unless name.string?
|
115
|
-
ch = find_character_for_name(name.value)
|
116
|
-
return ch unless ch.nil?
|
117
|
-
return Lisp::Debug.process_error("There is no character with the name #{name}", env)
|
118
|
-
end
|
119
|
-
|
120
|
-
|
121
|
-
def self.get_one_character_arg(func, args, env)
|
122
|
-
return Lisp::Debug.process_error("#{func} requires a character argument, found no args", env) unless args.length >= 1
|
123
|
-
char1 = args.car.evaluate(env)
|
124
|
-
return Lisp::Debug.process_error("#{func} requires a character argument, found #{char1}", env) unless char1.character?
|
125
|
-
return char1
|
126
|
-
end
|
127
|
-
|
128
|
-
|
129
|
-
def self.get_two_character_args(func, args, env)
|
130
|
-
return Lisp::Debug.process_error("#{func} requires two arguments, found
|
131
|
-
##{args.length}", env) unless args.length == 2
|
132
|
-
char1 = args.car.evaluate(env)
|
133
|
-
return Lisp::Debug.process_error("#{func} requires character arguments, found #{char1}", env) unless char1.character?
|
134
|
-
char2 = args.cadr.evaluate(env)
|
135
|
-
return Lisp::Debug.process_error("#{func} requires character arguments, found #{char2}", env) unless char2.character?
|
136
|
-
return [char1, char2]
|
137
|
-
end
|
138
|
-
|
139
|
-
|
140
|
-
def self.char_eq_impl(args, env)
|
141
|
-
char1, char2 = get_two_character_args("char=?", args, env)
|
142
|
-
Lisp::Boolean.with_value(char1.value == char2.value)
|
143
|
-
end
|
144
|
-
|
145
|
-
|
146
|
-
def self.char_lt_impl(args, env)
|
147
|
-
char1, char2 = get_two_character_args("char<?", args, env)
|
148
|
-
Lisp::Boolean.with_value(char1.value < char2.value)
|
149
|
-
end
|
150
|
-
|
151
|
-
|
152
|
-
def self.char_gt_impl(args, env)
|
153
|
-
char1, char2 = get_two_character_args("char>?", args, env)
|
154
|
-
Lisp::Boolean.with_value(char1.value > char2.value)
|
155
|
-
end
|
156
|
-
|
157
|
-
|
158
|
-
def self.char_lteq_impl(args, env)
|
159
|
-
char1, char2 = get_two_character_args("char<=?", args, env)
|
160
|
-
Lisp::Boolean.with_value(char1.value <= char2.value)
|
161
|
-
end
|
162
|
-
|
163
|
-
|
164
|
-
def self.char_gteq_impl(args, env)
|
165
|
-
char1, char2 = get_two_character_args("char>=?", args, env)
|
166
|
-
Lisp::Boolean.with_value(char1.value >= char2.value)
|
167
|
-
end
|
168
|
-
|
169
|
-
|
170
|
-
def self.char_ci_eq_impl(args, env)
|
171
|
-
char1, char2 = get_two_character_args("char-ci=?", args, env)
|
172
|
-
Lisp::Boolean.with_value(char1.value.downcase == char2.value.downcase)
|
173
|
-
end
|
174
|
-
|
175
|
-
|
176
|
-
def self.char_ci_lt_impl(args, env)
|
177
|
-
char1, char2 = get_two_character_args("char-ci<?", args, env)
|
178
|
-
Lisp::Boolean.with_value(char1.value.downcase < char2.value.downcase)
|
179
|
-
end
|
180
|
-
|
181
|
-
|
182
|
-
def self.char_ci_gt_impl(args, env)
|
183
|
-
char1, char2 = get_two_character_args("char-ci>?", args, env)
|
184
|
-
Lisp::Boolean.with_value(char1.value.downcase > char2.value.downcase)
|
185
|
-
end
|
186
|
-
|
187
|
-
|
188
|
-
def self.char_ci_lteq_impl(args, env)
|
189
|
-
char1, char2 = get_two_character_args("char-ci<=?", args, env)
|
190
|
-
Lisp::Boolean.with_value(char1.value.downcase <= char2.value.downcase)
|
191
|
-
end
|
192
|
-
|
193
|
-
|
194
|
-
def self.char_ci_gteq_impl(args, env)
|
195
|
-
char1, char2 = get_two_character_args("char-ci>=?", args, env)
|
196
|
-
Lisp::Boolean.with_value(char1.value.downcase >= char2.value.downcase)
|
197
|
-
end
|
198
|
-
|
199
|
-
|
200
|
-
def self.charp_impl(args, env)
|
201
|
-
return Lisp::Debug.process_error("char->name requires a single argument, found #{args.length}", env) unless args.length == 1
|
202
|
-
char = args.car.evaluate(env)
|
203
|
-
Lisp::Boolean.with_value(char.character?)
|
204
|
-
end
|
205
|
-
|
206
|
-
|
207
|
-
def self.char_upcase_impl(args, env)
|
208
|
-
char = get_one_character_arg("char->digit", args, env)
|
209
|
-
find_character_for_chr(char.value.upcase)
|
210
|
-
end
|
211
|
-
|
212
|
-
|
213
|
-
def self.char_downcase_impl(args, env)
|
214
|
-
char = get_one_character_arg("char->digit", args, env)
|
215
|
-
find_character_for_chr(char.value.downcase)
|
216
|
-
end
|
217
|
-
|
218
|
-
|
219
|
-
def self.char_digit_impl(args, env)
|
220
|
-
char = get_one_character_arg("char->digit", args, env)
|
221
|
-
base = if args.length == 1
|
222
|
-
10
|
223
|
-
else
|
224
|
-
b = args.cadr.evaluate(env)
|
225
|
-
return Lisp::Debug.process_error("Base for char->digit has to be an integer", env) unless b.integer?
|
226
|
-
return Lisp::Debug.process_error("Base for char->digit has to be between 2 and 36", env) unless b.value >=2 && b.value <= 36
|
227
|
-
b.value
|
228
|
-
end
|
229
|
-
ch = char.value.upcase
|
230
|
-
value = case ch
|
231
|
-
when /[0-9]/
|
232
|
-
ch[0].ord - 48
|
233
|
-
when /[A-Z]/
|
234
|
-
10 + ch[0].ord - 65
|
235
|
-
else
|
236
|
-
-1
|
237
|
-
end
|
238
|
-
if value == -1
|
239
|
-
Lisp::FALSE
|
240
|
-
elsif value >= base
|
241
|
-
Lisp::FALSE
|
242
|
-
else
|
243
|
-
Lisp::Number.with_value(value)
|
244
|
-
end
|
245
|
-
end
|
246
|
-
|
247
|
-
|
248
|
-
def self.digit_char_impl(args, env)
|
249
|
-
d = args.car.evaluate(env)
|
250
|
-
return Lisp::Debug.process_error("Digit value for digit->char has to be an integer", env) unless d.integer?
|
251
|
-
base = if args.length == 1
|
252
|
-
10
|
253
|
-
else
|
254
|
-
b = args.cadr.evaluate(env)
|
255
|
-
return Lisp::Debug.process_error("Base for char->digit has to be an integer", env) unless b.integer?
|
256
|
-
return Lisp::Debug.process_error("Base for char->digit has to be between 2 and 36", env) unless b.value >=2 && b.value <= 36
|
257
|
-
b.value
|
258
|
-
end
|
259
|
-
val = d.value
|
260
|
-
return Lisp::FALSE if val < 0 || val >= base
|
261
|
-
find_character_for_chr((((val < 10) ? 48 : 55) + val).chr)
|
262
|
-
end
|
263
|
-
|
264
|
-
|
265
|
-
def self.char_int_impl(args, env)
|
266
|
-
char = get_one_character_arg("char->int", args, env)
|
267
|
-
Lisp::Number.with_value(char.value.ord)
|
268
|
-
end
|
269
|
-
|
270
|
-
|
271
|
-
def self.int_char_impl(args, env)
|
272
|
-
i = args.car.evaluate(env)
|
273
|
-
return Lisp::Debug.process_error("Integer value for int->char has to be an integer", env) unless i.integer?
|
274
|
-
find_character_for_chr(i.value.chr)
|
275
|
-
end
|
276
|
-
|
277
|
-
|
278
6
|
def initialize(n)
|
279
7
|
@value = n
|
280
8
|
end
|
@@ -289,6 +17,12 @@ module Lisp
|
|
289
17
|
true
|
290
18
|
end
|
291
19
|
|
20
|
+
|
21
|
+
def eqv?(other)
|
22
|
+
return false unless other.character?
|
23
|
+
@value == other.value
|
24
|
+
end
|
25
|
+
|
292
26
|
|
293
27
|
def type
|
294
28
|
:character
|
@@ -363,9 +97,14 @@ module Lisp
|
|
363
97
|
@@character_constants["DEL"] = Lisp::Character.new("\x7F")
|
364
98
|
|
365
99
|
|
100
|
+
def self.character_constants()
|
101
|
+
@@character_constants
|
102
|
+
end
|
103
|
+
|
104
|
+
|
366
105
|
def self.with_value(n)
|
367
106
|
if n.length == 1
|
368
|
-
ch = find_character_for_chr(n[0])
|
107
|
+
ch = Lisp::PrimCharacter.find_character_for_chr(n[0])
|
369
108
|
return ch unless ch.nil?
|
370
109
|
ch = self.new(n[0])
|
371
110
|
@@character_constants[n] = ch
|
@@ -373,9 +112,9 @@ module Lisp
|
|
373
112
|
elsif @@character_constants.has_key?(n)
|
374
113
|
@@character_constants[n]
|
375
114
|
elsif n[0..1] == "U+"
|
376
|
-
find_character_for_chr(n[2..-1].to_i(16).chr)
|
115
|
+
Lisp::PrimCharacter.find_character_for_chr(n[2..-1].to_i(16).chr)
|
377
116
|
else
|
378
|
-
return Lisp::Debug.process_error("Invalid character name: #{n}",
|
117
|
+
return Lisp::Debug.process_error("Invalid character name: #{n}", Lisp::EnvironmentFrame.global)
|
379
118
|
end
|
380
119
|
end
|
381
120
|
|
@@ -0,0 +1,56 @@
|
|
1
|
+
# -*- coding: utf-8 -*-
|
2
|
+
module Lisp
|
3
|
+
|
4
|
+
class ClassObject < Atom
|
5
|
+
|
6
|
+
def self.new_instance
|
7
|
+
self.new(@value.alloc.init)
|
8
|
+
end
|
9
|
+
|
10
|
+
|
11
|
+
def self.with_class(c)
|
12
|
+
self.new(c)
|
13
|
+
end
|
14
|
+
|
15
|
+
|
16
|
+
def initialize(c)
|
17
|
+
@value = c
|
18
|
+
end
|
19
|
+
|
20
|
+
|
21
|
+
def with_value(&block)
|
22
|
+
block.call(@value)
|
23
|
+
end
|
24
|
+
|
25
|
+
|
26
|
+
def class?
|
27
|
+
true
|
28
|
+
end
|
29
|
+
|
30
|
+
|
31
|
+
def type
|
32
|
+
:class
|
33
|
+
end
|
34
|
+
|
35
|
+
|
36
|
+
def native_type
|
37
|
+
@value.class
|
38
|
+
end
|
39
|
+
|
40
|
+
|
41
|
+
def to_s
|
42
|
+
"<a class: #{@value.name}>"
|
43
|
+
end
|
44
|
+
|
45
|
+
|
46
|
+
def true?
|
47
|
+
@value != nil
|
48
|
+
end
|
49
|
+
|
50
|
+
|
51
|
+
def false?
|
52
|
+
@value == nil
|
53
|
+
end
|
54
|
+
|
55
|
+
end
|
56
|
+
end
|
data/lib/rubylisp/cons_cell.rb
CHANGED
@@ -5,6 +5,7 @@ module Lisp
|
|
5
5
|
attr_reader :car, :cdr
|
6
6
|
|
7
7
|
def self.cons(a=nil, b=nil)
|
8
|
+
b = nil if b.pair? && b.empty?
|
8
9
|
ConsCell.new(a, b)
|
9
10
|
end
|
10
11
|
|
@@ -31,8 +32,9 @@ module Lisp
|
|
31
32
|
|
32
33
|
|
33
34
|
def set_nth!(n, d)
|
35
|
+
return nil if empty?
|
34
36
|
c = self
|
35
|
-
|
37
|
+
n.times {|i| c = c.cdr}
|
36
38
|
c.set_car!(d)
|
37
39
|
end
|
38
40
|
|
@@ -93,10 +95,6 @@ module Lisp
|
|
93
95
|
true
|
94
96
|
end
|
95
97
|
|
96
|
-
def alist?
|
97
|
-
false
|
98
|
-
end
|
99
|
-
|
100
98
|
def frame?
|
101
99
|
false
|
102
100
|
end
|
@@ -104,10 +102,21 @@ module Lisp
|
|
104
102
|
def vector?
|
105
103
|
false
|
106
104
|
end
|
105
|
+
|
106
|
+
def eq?(other)
|
107
|
+
return true if empty? && (other.nil? || (other.pair? && other.empty?))
|
108
|
+
other.pair? && self == other
|
109
|
+
end
|
110
|
+
|
111
|
+
def eqv?(other)
|
112
|
+
return true if empty? && (other.nil? || (other.pair? && other.empty?))
|
113
|
+
other.pair? && self == other
|
114
|
+
end
|
107
115
|
|
108
|
-
def
|
109
|
-
return
|
110
|
-
|
116
|
+
def equal?(other)
|
117
|
+
return true if empty? && (other.nil? || (other.pair? && other.empty?))
|
118
|
+
return false unless other.pair?
|
119
|
+
@car.equal?(other.car) && @cdr.equal?(other.cdr)
|
111
120
|
end
|
112
121
|
|
113
122
|
def type
|
@@ -124,7 +133,7 @@ module Lisp
|
|
124
133
|
return "()" if self.empty?
|
125
134
|
return "'#{@cdr.car.to_s}" if @car.symbol? && @car.name == "quote"
|
126
135
|
return "{#{@cdr.to_s_helper}}" if @car.symbol? && @car.name == "make-frame"
|
127
|
-
return "
|
136
|
+
return "#(#{@cdr.to_s_helper})" if @car.symbol? && @car.name == "make-vector"
|
128
137
|
return "(#{@car.to_s} . #{@cdr.to_s})" if !@cdr.nil? && !@cdr.pair?
|
129
138
|
return "(#{self.to_s_helper})"
|
130
139
|
end
|
@@ -137,22 +146,24 @@ module Lisp
|
|
137
146
|
return "()" if self.empty?
|
138
147
|
return "'#{@cdr.car.print_string}" if @car.symbol? && @car.name == "quote"
|
139
148
|
return "{#{@cdr.print_string_helper}}" if @car.symbol? && @car.name == "make-frame"
|
140
|
-
return "
|
149
|
+
return "#(#{@cdr.print_string_helper})" if @car.symbol? && @car.name == "make-vector"
|
141
150
|
return "(#{@car.print_string} . #{@cdr.print_string})" if !@cdr.nil? && !@cdr.pair?
|
142
151
|
return "(#{self.print_string_helper})"
|
143
152
|
end
|
144
153
|
|
145
154
|
def to_a
|
146
155
|
a = []
|
156
|
+
return a if empty?
|
147
157
|
c = self
|
148
158
|
until c.nil?
|
149
|
-
a << c.car
|
159
|
+
a << c.car
|
150
160
|
c = c.cdr
|
151
161
|
end
|
152
162
|
a
|
153
163
|
end
|
154
164
|
|
155
165
|
def each &block
|
166
|
+
return if empty?
|
156
167
|
c = self
|
157
168
|
if self.length > 0
|
158
169
|
until c.nil?
|
@@ -163,11 +174,11 @@ module Lisp
|
|
163
174
|
end
|
164
175
|
|
165
176
|
def self.array_to_list(cells, tail=nil)
|
166
|
-
return
|
177
|
+
return cons() if cells.empty? && tail.nil?
|
167
178
|
head = ConsCell.new
|
168
179
|
last_cell = head
|
169
|
-
cells.each do |
|
170
|
-
new_cell = self.cons(
|
180
|
+
(0...cells.length).each do |i|
|
181
|
+
new_cell = self.cons(cells[i], nil)
|
171
182
|
last_cell.set_cdr!(new_cell)
|
172
183
|
last_cell = new_cell
|
173
184
|
end
|
@@ -176,11 +187,12 @@ module Lisp
|
|
176
187
|
end
|
177
188
|
|
178
189
|
def traverse(path)
|
179
|
-
|
180
|
-
|
181
|
-
|
182
|
-
|
183
|
-
|
190
|
+
next_cell = self
|
191
|
+
path.chars.each do |p|
|
192
|
+
return nil if next_cell.nil? || !next_cell.pair?
|
193
|
+
next_cell = ((p == ?a) ? next_cell.car : next_cell.cdr)
|
194
|
+
end
|
195
|
+
next_cell
|
184
196
|
end
|
185
197
|
|
186
198
|
def method_missing(name, *args, &block)
|
@@ -193,13 +205,13 @@ module Lisp
|
|
193
205
|
|
194
206
|
def nth(n)
|
195
207
|
c = self
|
196
|
-
|
208
|
+
n.times {|i| c = c.cdr}
|
197
209
|
c.car
|
198
210
|
end
|
199
211
|
|
200
212
|
def nth_tail(n)
|
201
213
|
c = self
|
202
|
-
|
214
|
+
n.times {|i| c = c.cdr}
|
203
215
|
c
|
204
216
|
end
|
205
217
|
|
@@ -225,6 +237,7 @@ module Lisp
|
|
225
237
|
Lisp::Debug.debug_repl(env)
|
226
238
|
end
|
227
239
|
end
|
240
|
+
|
228
241
|
result = func.apply_to(@cdr, env)
|
229
242
|
env.current_code.shift() if !Lisp::Debug.eval_in_debug_repl && Lisp::Debug.interactive
|
230
243
|
Lisp::Debug.log_result(result, env)
|
@@ -236,8 +249,8 @@ module Lisp
|
|
236
249
|
return self if empty?
|
237
250
|
sexpr = if @car.symbol?
|
238
251
|
key = @car
|
239
|
-
frame = nth(
|
240
|
-
value = nth(
|
252
|
+
frame = nth(1)
|
253
|
+
value = nth(2)
|
241
254
|
|
242
255
|
s = key.name
|
243
256
|
if s.end_with?(":")
|
@@ -246,6 +259,10 @@ module Lisp
|
|
246
259
|
ConsCell.array_to_list([Symbol.named("set-slot!"), frame, Symbol.named(s[0..-2]), value])
|
247
260
|
elsif s.end_with?(":?")
|
248
261
|
ConsCell.array_to_list([Symbol.named("has-slot?"), frame, Symbol.named(s[0..-2])])
|
262
|
+
elsif s.end_with?(":>")
|
263
|
+
ConsCell.array_to_list([Symbol.named("send"), frame, Symbol.named(s[0..-2])] << self.cdddr)
|
264
|
+
elsif s.end_with?(":^")
|
265
|
+
ConsCell.array_to_list([Symbol.named("send-super"), frame, Symbol.named(s[0..-2])] << self.cdddr)
|
249
266
|
else
|
250
267
|
self
|
251
268
|
end
|
@@ -256,6 +273,7 @@ module Lisp
|
|
256
273
|
end
|
257
274
|
|
258
275
|
def evaluate_each(env)
|
276
|
+
return nil if empty?
|
259
277
|
result = @car.evaluate(env)
|
260
278
|
return result if @cdr.nil?
|
261
279
|
@cdr.evaluate_each(env)
|
@@ -287,9 +305,22 @@ module Lisp
|
|
287
305
|
c
|
288
306
|
end
|
289
307
|
|
308
|
+
def print_ary(a)
|
309
|
+
(0...a.length).map {|i| puts (a[i].nil? ? "nil" : a[i])}
|
310
|
+
end
|
311
|
+
|
290
312
|
def flatten
|
291
|
-
ary =
|
292
|
-
|
313
|
+
ary = []
|
314
|
+
to_a.each do |s|
|
315
|
+
if s.nil?
|
316
|
+
ary << nil
|
317
|
+
elsif s.list?
|
318
|
+
s.to_a.each {|e| ary << e}
|
319
|
+
else
|
320
|
+
ary << s
|
321
|
+
end
|
322
|
+
end
|
323
|
+
ConsCell.array_to_list(ary)
|
293
324
|
end
|
294
325
|
|
295
326
|
|
data/lib/rubylisp/debug.rb
CHANGED
@@ -18,28 +18,26 @@ module Lisp
|
|
18
18
|
self.on_entry = Set.new
|
19
19
|
self.single_step = false
|
20
20
|
self.interactive = false
|
21
|
-
|
22
|
-
Primitive.register("debug-trace") {|args, env| Lisp::Debug::debug_trace_impl(args, env) }
|
23
|
-
Primitive.register("debug-on-error") {|args, env| Lisp::Debug::debug_on_error_impl(args, env) }
|
24
|
-
Primitive.register("debug-on-entry") {|args, env| Lisp::Debug::debug_on_entry_impl(args, env) }
|
25
|
-
Primitive.register("add-debug-on-entry") {|args, env| Lisp::Debug::add_debug_on_entry_impl(args, env) }
|
26
|
-
Primitive.register("remove-debug-on-entry") {|args, env| Lisp::Debug::remove_debug_on_entry_impl(args, env) }
|
27
|
-
Primitive.register("debug") {|args, env| Lisp::Debug::debug_impl(args, env) }
|
28
|
-
Primitive.register("dump") {|args, env| Lisp::Debug::dump_imp2l(args, env) }
|
21
|
+
|
22
|
+
Primitive.register("debug-trace", "1") {|args, env| Lisp::Debug::debug_trace_impl(args, env) }
|
23
|
+
Primitive.register("debug-on-error", "1") {|args, env| Lisp::Debug::debug_on_error_impl(args, env) }
|
24
|
+
Primitive.register("debug-on-entry", "0") {|args, env| Lisp::Debug::debug_on_entry_impl(args, env) }
|
25
|
+
Primitive.register("add-debug-on-entry", "1") {|args, env| Lisp::Debug::add_debug_on_entry_impl(args, env) }
|
26
|
+
Primitive.register("remove-debug-on-entry", "1") {|args, env| Lisp::Debug::remove_debug_on_entry_impl(args, env) }
|
27
|
+
Primitive.register("debug", "0") {|args, env| Lisp::Debug::debug_impl(args, env) }
|
28
|
+
Primitive.register("dump", "0") {|args, env| Lisp::Debug::dump_imp2l(args, env) }
|
29
29
|
end
|
30
|
-
|
30
|
+
|
31
31
|
|
32
32
|
def self.debug_trace_impl(args, env)
|
33
|
-
|
34
|
-
flag = args.car.evaluate(env)
|
33
|
+
flag = args.car
|
35
34
|
return Lisp::Debug.process_error("the argument to debug-trace has to be a boolean", env) unless flag.boolean?
|
36
35
|
self.trace = flag.value
|
37
36
|
flag
|
38
37
|
end
|
39
38
|
|
40
39
|
def self.debug_on_error_impl(args, env)
|
41
|
-
|
42
|
-
flag = args.car.evaluate(env)
|
40
|
+
flag = args.car
|
43
41
|
return Lisp::Debug.process_error("the argument to debug-on-error has to be a boolean", env) unless flag.boolean?
|
44
42
|
self.on_error = flag.value
|
45
43
|
flag
|
@@ -50,8 +48,7 @@ module Lisp
|
|
50
48
|
end
|
51
49
|
|
52
50
|
def self.add_debug_on_entry_impl(args, env)
|
53
|
-
|
54
|
-
f = args.car.evaluate(env)
|
51
|
+
f = args.car
|
55
52
|
return Lisp::Debug.process_error("the argument to add-debug-on-error has to be a function", env) unless f.function? || f.primitive?
|
56
53
|
|
57
54
|
self.on_entry.add(f.name)
|
@@ -59,8 +56,7 @@ module Lisp
|
|
59
56
|
end
|
60
57
|
|
61
58
|
def self.remove_debug_on_entry_impl(args, env)
|
62
|
-
|
63
|
-
f = args.car.evaluate(env)
|
59
|
+
f = args.car
|
64
60
|
return Lisp::Debug.process_error("the argument to remove-debug-on-error has to be a function", env) unless f.function?
|
65
61
|
|
66
62
|
self.on_entry.remove(f.name)
|
@@ -232,7 +228,7 @@ module Lisp
|
|
232
228
|
puts(" #{result.to_s}")
|
233
229
|
end
|
234
230
|
end
|
235
|
-
|
236
|
-
|
231
|
+
|
237
232
|
end
|
233
|
+
|
238
234
|
end
|
@@ -0,0 +1,27 @@
|
|
1
|
+
module Lisp
|
2
|
+
|
3
|
+
class Environment < Atom
|
4
|
+
|
5
|
+
def self.with_value(e)
|
6
|
+
self.new(e)
|
7
|
+
end
|
8
|
+
|
9
|
+
def initialize(e)
|
10
|
+
@value = e
|
11
|
+
end
|
12
|
+
|
13
|
+
def environment?
|
14
|
+
true
|
15
|
+
end
|
16
|
+
|
17
|
+
def equal?(other)
|
18
|
+
other.environment? && @value == other.value
|
19
|
+
end
|
20
|
+
|
21
|
+
def type
|
22
|
+
:environment
|
23
|
+
end
|
24
|
+
|
25
|
+
end
|
26
|
+
|
27
|
+
end
|