rubymotionlisp 0.1.3

Sign up to get free protection for your applications and to get access to all the features.
@@ -0,0 +1,841 @@
1
+ module Lisp
2
+
3
+ class String < Atom
4
+
5
+ def self.register
6
+ Primitive.register("str") {|args, env| Lisp::String::str_impl(args, env) }
7
+ Primitive.register("string?") {|args, env| Lisp::String::stringp_impl(args, env) }
8
+ Primitive.register("make-string") {|args, env| Lisp::String::make_string_impl(args, env) }
9
+ Primitive.register("string") {|args, env| Lisp::String::string_impl(args, env) }
10
+ Primitive.register("list->string") {|args, env| Lisp::String::list_string_impl(args, env) }
11
+ Primitive.register("string->list") {|args, env| Lisp::String::string_list_impl(args, env) }
12
+ Primitive.register("string-copy") {|args, env| Lisp::String::string_copy_impl(args, env) }
13
+ Primitive.register("string-length") {|args, env| Lisp::String::string_length_impl(args, env) }
14
+ Primitive.register("string-null?") {|args, env| Lisp::String::string_nullp_impl(args, env) }
15
+ Primitive.register("string-ref") {|args, env| Lisp::String::string_ref_impl(args, env) }
16
+ Primitive.register("string-set!") {|args, env| Lisp::String::string_set_impl(args, env) }
17
+
18
+ Primitive.register("string=?") {|args, env| Lisp::String::string_eq_impl(args, env) }
19
+ Primitive.register("substring=?") {|args, env| Lisp::String::substring_eq_impl(args, env) }
20
+ Primitive.register("string-ci=?") {|args, env| Lisp::String::string_ci_eq_impl(args, env) }
21
+ Primitive.register("substring-ci=?") {|args, env| Lisp::String::substring_ci_eq_impl(args, env) }
22
+
23
+ Primitive.register("string<?") {|args, env| Lisp::String::string_lt_impl(args, env) }
24
+ Primitive.register("substring<?") {|args, env| Lisp::String::substring_lt_impl(args, env) }
25
+ Primitive.register("string-ci<?") {|args, env| Lisp::String::string_ci_lt_impl(args, env) }
26
+ Primitive.register("substring-ci<?") {|args, env| Lisp::String::substring_ci_lt_impl(args, env) }
27
+
28
+ Primitive.register("string>?") {|args, env| Lisp::String::string_gt_impl(args, env) }
29
+ Primitive.register("substring>?") {|args, env| Lisp::String::substring_gt_impl(args, env) }
30
+ Primitive.register("string-ci>?") {|args, env| Lisp::String::string_ci_gt_impl(args, env) }
31
+ Primitive.register("substring-ci>?") {|args, env| Lisp::String::substring_ci_gt_impl(args, env) }
32
+
33
+ Primitive.register("string<=?") {|args, env| Lisp::String::string_lte_impl(args, env) }
34
+ Primitive.register("substring<=?") {|args, env| Lisp::String::substring_lte_impl(args, env) }
35
+ Primitive.register("string-ci<=?") {|args, env| Lisp::String::string_ci_lte_impl(args, env) }
36
+ Primitive.register("substring-ci<=?") {|args, env| Lisp::String::substring_ci_lte_impl(args, env) }
37
+
38
+ Primitive.register("string>=?") {|args, env| Lisp::String::string_gte_impl(args, env) }
39
+ Primitive.register("substring>=?") {|args, env| Lisp::String::substring_gte_impl(args, env) }
40
+ Primitive.register("string-ci>=?") {|args, env| Lisp::String::string_ci_gte_impl(args, env) }
41
+ Primitive.register("substring-ci>=?") {|args, env| Lisp::String::substring_ci_gte_impl(args, env) }
42
+
43
+ Primitive.register("string-compare") {|args, env| Lisp::String::string_compare_impl(args, env) }
44
+ Primitive.register("string-compare-ci") {|args, env| Lisp::String::string_compare_ci_impl(args, env) }
45
+
46
+ Primitive.register("string-hash") {|args, env| Lisp::String::string_hash_impl(args, env) }
47
+ Primitive.register("string-hash-mod") {|args, env| Lisp::String::string_hash_mod_impl(args, env) }
48
+
49
+ Primitive.register("string-capitalized?") {|args, env| Lisp::String::string_capitalizedp_impl(args, env) }
50
+ Primitive.register("substring-capitalized?") {|args, env| Lisp::String::substring_capitalizedp_impl(args, env) }
51
+ Primitive.register("string-upper-case?") {|args, env| Lisp::String::string_upperp_impl(args, env) }
52
+ Primitive.register("substring-upper-case?") {|args, env| Lisp::String::substring_upperp_impl(args, env) }
53
+ Primitive.register("string-lower-case?") {|args, env| Lisp::String::string_lowerp_impl(args, env) }
54
+ Primitive.register("substring-lower-case?") {|args, env| Lisp::String::substring_lowerp_impl(args, env) }
55
+
56
+ Primitive.register("string-capitalize") {|args, env| Lisp::String::string_capitalize_impl(args, env) }
57
+ Primitive.register("string-capitalize!") {|args, env| Lisp::String::string_capitalize_bang_impl(args, env) }
58
+ Primitive.register("substring-capitalize!") {|args, env| Lisp::String::substring_capitalize_bang_impl(args, env) }
59
+ Primitive.register("string-downcase") {|args, env| Lisp::String::string_downcase_impl(args, env) }
60
+ Primitive.register("string-downcase!") {|args, env| Lisp::String::string_downcase_bang_impl(args, env) }
61
+ Primitive.register("substring-downcase!") {|args, env| Lisp::String::substring_downcase_bang_impl(args, env) }
62
+ Primitive.register("string-upcase") {|args, env| Lisp::String::string_upcase_impl(args, env) }
63
+ Primitive.register("string-upcase!") {|args, env| Lisp::String::string_upcase_bang_impl(args, env) }
64
+ Primitive.register("substring-upcase!") {|args, env| Lisp::String::substring_upcase_bang_impl(args, env) }
65
+
66
+ Primitive.register("string-append") {|args, env| Lisp::String::string_append_impl(args, env) }
67
+ Primitive.register("substring") {|args, env| Lisp::String::substring_impl(args, env) }
68
+ Primitive.register("string-head") {|args, env| Lisp::String::string_head_impl(args, env) }
69
+ Primitive.register("string-tail") {|args, env| Lisp::String::string_tail_impl(args, env) }
70
+
71
+ Primitive.register("string-pad-left") {|args, env| Lisp::String::string_pad_left_impl(args, env) }
72
+ Primitive.register("string-pad-right") {|args, env| Lisp::String::string_pad_right_impl(args, env) }
73
+
74
+ Primitive.register("string-trim") {|args, env| Lisp::String::string_trim_impl(args, env) }
75
+ Primitive.register("string-trim-right") {|args, env| Lisp::String::string_trim_right_impl(args, env) }
76
+ Primitive.register("string-trim-left") {|args, env| Lisp::String::string_trim_left_impl(args, env) }
77
+ end
78
+
79
+ def self.str_impl(args, env)
80
+ strings = args.to_a.map {|e| e.evaluate(env).to_s}
81
+ String.with_value(strings.join)
82
+ end
83
+
84
+
85
+ def self.stringp_impl(args, env)
86
+ raise "string? requires 1 argument" unless args.length == 1
87
+ return Lisp::Boolean.with_value(args.car.evaluate(env).string?)
88
+ end
89
+
90
+
91
+ def self.make_string_impl(args, env)
92
+ raise "make-string need requires at least 1 argument" unless args.length > 0
93
+ raise "make-string accepts at most 2 arguments, but was passed #{args.length}" if args.length > 2
94
+ k_arg = args.car.evaluate(env)
95
+ raise "make-string requires an integer as it's first argument." unless k_arg.integer?
96
+ k = k_arg.value
97
+ c = if args.length == 2
98
+ c_arg = args.cadr.evaluate(env)
99
+ raise "make-string requires a character as it's second argument, but received #{c_arg}." unless c_arg.character?
100
+ c_arg.value
101
+ else
102
+ " "
103
+ end
104
+ self.with_value(c * k)
105
+ end
106
+
107
+
108
+ def self.string_impl(args, env)
109
+ chars = args.to_a.map do |a|
110
+ ea = a.evaluate(env)
111
+ raise "string requires character args, but was passed #{ea}." unless ea.character?
112
+ ea.value
113
+ end
114
+ self.with_value(chars.join)
115
+ end
116
+
117
+
118
+ def self.list_string_impl(args, env)
119
+ raise "list->string requires 1 argument, but received #{args.length}" unless args.length == 1
120
+ list_of_chars = args.car.evaluate(env)
121
+ raise "list->string requires a list argument, but received #{str_arg}" unless list_of_chars.list?
122
+ chars = list_of_chars.to_a.map do |a|
123
+ ea = a.evaluate(env)
124
+ raise "string requires a list of characters, but it contained #{ea}." unless ea.character?
125
+ ea.value
126
+ end
127
+ self.with_value(chars.join)
128
+ end
129
+
130
+
131
+ def self.string_list_impl(args, env)
132
+ raise "string->list requires 1 argument, but received #{args.length}" unless args.length == 1
133
+ str_arg = args.car.evaluate(env)
134
+ raise "string->list requires a string argument, but received #{str_arg}" unless str_arg.string?
135
+ chars = str_arg.value.each_char.map {|c| Lisp::Character.find_character_for_chr(c) }
136
+ Lisp::ConsCell.array_to_list(chars)
137
+ end
138
+
139
+
140
+ def self.string_copy_impl(args, env)
141
+ raise "string-copy requires 1 argument, but received #{args.length}" unless args.length == 1
142
+ str_arg = args.car.evaluate(env)
143
+ raise "string-copy requires a string argument, but received #{str_arg}" unless str_arg.string?
144
+ self.with_value(str_arg.value)
145
+ end
146
+
147
+
148
+ def self.string_length_impl(args, env)
149
+ raise "string-length requires 1 argument, but received #{args.length}" unless args.length == 1
150
+ str_arg = args.car.evaluate(env)
151
+ raise "string-length requires a string argument, but received #{str_arg}" unless str_arg.string?
152
+ Lisp::Number.with_value(str_arg.value.length)
153
+ end
154
+
155
+
156
+ def self.string_nullp_impl(args, env)
157
+ raise "string-length requires 1 argument, but received #{args.length}" unless args.length == 1
158
+ str_arg = args.car.evaluate(env)
159
+ raise "string-length requires a string argument, but received #{str_arg}" unless str_arg.string?
160
+ Lisp::Boolean.with_value(str_arg.value.length == 0)
161
+ end
162
+
163
+
164
+ def self.string_ref_impl(args, env)
165
+ raise "string-ref requires 2 arguments, but received #{args.length}" unless args.length == 2
166
+ str_arg = args.car.evaluate(env)
167
+ raise "string-ref requires a string as it's first argument, but received #{arg.car}" unless str_arg.string?
168
+ str = str_arg.value
169
+ k_arg = args.cadr.evaluate(env)
170
+ raise "string-ref requires it's second argument to be an integer, but received #{k_arg}" unless k_arg.integer?
171
+ k = k_arg.value
172
+ return Lisp::FALSE if k < 0 || k >= str.length
173
+ Lisp::Character.find_character_for_chr(str[k])
174
+ end
175
+
176
+
177
+ def self.string_set_impl(args, env)
178
+ raise "string-set! needs 3 arguments, but received #{args.length}" unless args.length == 3
179
+ str_arg = args.car.evaluate(env)
180
+ raise "string-set! needs a string as it's first argument, but received #{str_arg}" unless str_arg.string?
181
+ str = str_arg.value
182
+ k_arg = args.cadr.evaluate(env)
183
+ raise "string-set! requires an integer as it's second argument, but received #{k_arg}" unless k_arg.integer?
184
+ k = k_arg.value
185
+ return Lisp::FALSE if k < 0 || k >= str.length
186
+ replacement_arg = args.caddr.evaluate(env)
187
+ raise "string-set! requires a character as it's third argument, but received #{replacement_arg}" unless replacement_arg.character?
188
+ replacement = replacement_arg.value
189
+ str[k] = replacement
190
+ self.with_value(str)
191
+ end
192
+
193
+
194
+ def self.get_substring(func, str, start_index, end_index)
195
+ raise "#{func} requires a string, but received #{str}" unless str.string?
196
+ s = str.value
197
+ raise "#{func} requires an integer start index, but received #{start_index}" unless start_index.integer?
198
+ si = start_index.value
199
+ raise "#{func} received an invalid substring start index: #{si}" if si < 0 || si > s.length
200
+ raise "#{func} requires an integer end index, but received #{end_index}" unless end_index.integer?
201
+ ei = end_index.value
202
+ raise "#{func} received an invalid substring end index: #{ei}" if ei < 0 || ei > s.length
203
+ s[si...ei]
204
+ end
205
+
206
+
207
+ def self.extract_substrings(func, args, env)
208
+ raise "#{func} requires 6 arguments, but received #{args.length}" unless args.length == 6
209
+ substr1 = get_substring(func, args.nth(1).evaluate(env), args.nth(2).evaluate(env), args.nth(3).evaluate(env))
210
+ substr2 = get_substring(func, args.nth(4).evaluate(env), args.nth(5).evaluate(env), args.nth(6).evaluate(env))
211
+ return [substr1, substr2]
212
+ end
213
+
214
+
215
+ def self.get_string(func, str)
216
+ raise "#{func} requires a string, but received #{str}" unless str.string?
217
+ str.value
218
+ end
219
+
220
+
221
+ def self.extract_strings(func, args, env)
222
+ raise "#{func} requires 2 arguments, but received #{args.length}" unless args.length == 2
223
+ str1 = get_string(func, args.nth(1).evaluate(env))
224
+ str2 = get_string(func, args.nth(2).evaluate(env))
225
+ return [str1, str2]
226
+ end
227
+
228
+
229
+ def self.string_eq_impl(args, env)
230
+ str1, str2 = extract_strings("string=?", args, env)
231
+ Lisp::Boolean.with_value(str1 == str2)
232
+ end
233
+
234
+
235
+ def self.substring_eq_impl(args, env)
236
+ substr1, substr2 = extract_substrings("substring=?", args, env)
237
+ Lisp::Boolean.with_value(substr1 == substr2)
238
+ end
239
+
240
+
241
+ def self.string_ci_eq_impl(args, env)
242
+ str1, str2 = extract_strings("string-ci=?", args, env)
243
+ Lisp::Boolean.with_value(str1.downcase == str2.downcase)
244
+ end
245
+
246
+
247
+ def self.substring_ci_eq_impl(args, env)
248
+ substr1, substr2 = extract_substrings("substring-ci=?", args, env)
249
+ Lisp::Boolean.with_value(substr1.downcase == substr2.downcase)
250
+ end
251
+
252
+
253
+ def self.string_lt_impl(args, env)
254
+ str1, str2 = extract_strings("string<?", args, env)
255
+ Lisp::Boolean.with_value(str1 < str2)
256
+ end
257
+
258
+
259
+ def self.substring_lt_impl(args, env)
260
+ substr1, substr2 = extract_substrings("substring<?", args, env)
261
+ Lisp::Boolean.with_value(substr1 < substr2)
262
+ end
263
+
264
+
265
+ def self.string_ci_lt_impl(args, env)
266
+ str1, str2 = extract_strings("string-ci<?", args, env)
267
+ Lisp::Boolean.with_value(str1.downcase < str2.downcase)
268
+ end
269
+
270
+
271
+ def self.substring_ci_lt_impl(args, env)
272
+ substr1, substr2 = extract_substrings("substring-ci<?", args, env)
273
+ Lisp::Boolean.with_value(substr1.downcase < substr2.downcase)
274
+ end
275
+
276
+
277
+ def self.string_gt_impl(args, env)
278
+ str1, str2 = extract_strings("string>?", args, env)
279
+ Lisp::Boolean.with_value(str1 > str2)
280
+ end
281
+
282
+
283
+ def self.substring_gt_impl(args, env)
284
+ substr1, substr2 = extract_substrings("substring>?", args, env)
285
+ Lisp::Boolean.with_value(substr1 > substr2)
286
+ end
287
+
288
+
289
+ def self.string_ci_gt_impl(args, env)
290
+ str1, str2 = extract_strings("string-ci>?", args, env)
291
+ Lisp::Boolean.with_value(str1.downcase > str2.downcase)
292
+ end
293
+
294
+
295
+ def self.substring_ci_gt_impl(args, env)
296
+ substr1, substr2 = extract_substrings("substring-ci>?", args, env)
297
+ Lisp::Boolean.with_value(substr1.downcase > substr2.downcase)
298
+ end
299
+
300
+
301
+ def self.string_lte_impl(args, env)
302
+ str1, str2 = extract_strings("string<=?", args, env)
303
+ Lisp::Boolean.with_value(str1 <= str2)
304
+ end
305
+
306
+
307
+ def self.substring_lte_impl(args, env)
308
+ substr1, substr2 = extract_substrings("substring<=?", args, env)
309
+ Lisp::Boolean.with_value(substr1 <= substr2)
310
+ end
311
+
312
+
313
+ def self.string_ci_lte_impl(args, env)
314
+ str1, str2 = extract_strings("string-ci<=?", args, env)
315
+ Lisp::Boolean.with_value(str1.downcase <= str2.downcase)
316
+ end
317
+
318
+
319
+ def self.substring_ci_lte_impl(args, env)
320
+ substr1, substr2 = extract_substrings("substring-ci<=?", args, env)
321
+ Lisp::Boolean.with_value(substr1.downcase <= substr2.downcase)
322
+ end
323
+
324
+
325
+ def self.string_gte_impl(args, env)
326
+ str1, str2 = extract_strings("string>=?", args, env)
327
+ Lisp::Boolean.with_value(str1 >= str2)
328
+ end
329
+
330
+
331
+ def self.substring_gte_impl(args, env)
332
+ substr1, substr2 = extract_substrings("substring>=?", args, env)
333
+ Lisp::Boolean.with_value(substr1 >= substr2)
334
+ end
335
+
336
+
337
+ def self.string_ci_gte_impl(args, env)
338
+ str1, str2 = extract_strings("string-ci>=?", args, env)
339
+ Lisp::Boolean.with_value(str1.downcase >= str2.downcase)
340
+ end
341
+
342
+
343
+ def self.substring_ci_gte_impl(args, env)
344
+ substr1, substr2 = extract_substrings("substring-ci>=?", args, env)
345
+ Lisp::Boolean.with_value(substr1.downcase >= substr2.downcase)
346
+ end
347
+
348
+
349
+ def self.string_compare_impl(args, env)
350
+ raise "string-compare requires 5 arguments, but received #{args.length}" unless args.length == 5
351
+ str1 = get_string("string-compare", args.nth(1).evaluate(env))
352
+ str2 = get_string("string-compare", args.nth(2).evaluate(env))
353
+ f_number = case str1 <=> str2
354
+ when -1
355
+ 4
356
+ when 0
357
+ 3
358
+ when 1
359
+ 5
360
+ end
361
+ f = args.nth(f_number).evaluate(env)
362
+ raise "string-compare requires functions for argument #{f_number}, but received #{f}" unless f.function?
363
+ f.apply_to(Lisp::ConsCell.cons, env)
364
+ end
365
+
366
+
367
+ def self.string_compare_ci_impl(args, env)
368
+ raise "string-compare-ci requires 5 arguments, but received #{args.length}" unless args.length == 5
369
+ str1 = get_string("string-compare-ci", args.nth(1).evaluate(env))
370
+ str2 = get_string("string-compare-ci", args.nth(2).evaluate(env))
371
+ f_number = case str1.downcase <=> str2.downcase
372
+ when -1
373
+ 4
374
+ when 0
375
+ 3
376
+ when 1
377
+ 5
378
+ end
379
+ f = args.nth(f_number).evaluate(env)
380
+ raise "string-compare-ci requires functions for argument #{f_number}, but received #{f}" unless f.function?
381
+ f.apply_to(Lisp::ConsCell.cons, env)
382
+ end
383
+
384
+
385
+ def self.string_hash_impl(args, env)
386
+ str = get_string("string-hash", args.nth(1).evaluate(env))
387
+ Lisp::Number.with_value(str.hash)
388
+ end
389
+
390
+
391
+ def self.string_hash_mod_impl(args, env)
392
+ str = get_string("string-hash-mod", args.nth(1).evaluate(env))
393
+ k_arg = args.cadr.evaluate(env)
394
+ raise "string-hash-mod requires it's second argument to be an integer, but received #{k_arg}" unless k_arg.integer?
395
+ k = k_arg.value
396
+ Lisp::Number.with_value(str.hash % k)
397
+ end
398
+
399
+
400
+ # str is assumed to be a single word
401
+ def self.uppercase?(str)
402
+ (str =~ /^[[:upper:]]*$/) == 0
403
+ end
404
+
405
+
406
+ def self.lowercase?(str)
407
+ (str =~ /^[[:lower:]]*$/) == 0
408
+ end
409
+
410
+
411
+ def self.capitalized?(str)
412
+ first = str[0]
413
+ rest = str[1..-1]
414
+ return false unless first =~ /[[:upper:]]/
415
+ lowercase?(rest)
416
+ end
417
+
418
+
419
+ def self.split_into_words(str)
420
+ str.split(/[^[[:alpha:]]]+/)
421
+ end
422
+
423
+
424
+ def self.string_capitalizedp_impl(args, env)
425
+ str = get_string("string-capitalized?", args.nth(1).evaluate(env))
426
+ words = split_into_words(str)
427
+ Lisp::Boolean.with_value(capitalized?(words[0])&& words[1..-1].all? {|w| capitalized?(w) || lowercase?(w)})
428
+ end
429
+
430
+
431
+ def self.substring_capitalizedp_impl(args, env)
432
+ str = get_substring("substring-capitalized?", args.nth(1).evaluate(env), args.nth(2).evaluate(env), args.nth(3).evaluate(env))
433
+ words = split_into_words(str)
434
+ Lisp::Boolean.with_value(capitalized?(words[0]) && words[1..-1].all? {|w| capitalized?(w) || lowercase?(w)})
435
+ end
436
+
437
+
438
+ def self.string_upperp_impl(args, env)
439
+ str = get_string("string-upper-case?", args.nth(1).evaluate(env))
440
+ words = split_into_words(str)
441
+ Lisp::Boolean.with_value(words.all? {|w| uppercase?(w)})
442
+ end
443
+
444
+
445
+ def self.substring_upperp_impl(args, env)
446
+ str = get_substring("substring-upper-case?", args.nth(1).evaluate(env), args.nth(2).evaluate(env), args.nth(3).evaluate(env))
447
+ words = split_into_words(str)
448
+ Lisp::Boolean.with_value(words.all? {|w| uppercase?(w)})
449
+ end
450
+
451
+
452
+ def self.string_lowerp_impl(args, env)
453
+ str = get_string("string-lower-case?", args.nth(1).evaluate(env))
454
+ words = split_into_words(str)
455
+ Lisp::Boolean.with_value(words.all? {|w| lowercase?(w)})
456
+ end
457
+
458
+
459
+ def self.substring_lowerp_impl(args, env)
460
+ str = get_substring("substring-lower-case?", args.nth(1).evaluate(env), args.nth(2).evaluate(env), args.nth(3).evaluate(env))
461
+ words = split_into_words(str)
462
+ Lisp::Boolean.with_value(words.all? {|w| lowercase?(w)})
463
+ end
464
+
465
+
466
+ def self.capitalize_string(str)
467
+ saw_first = false
468
+ str.chars.map do |c|
469
+ if c =~ /[[:alpha:]]/
470
+ if saw_first
471
+ c.downcase
472
+ else
473
+ saw_first = true
474
+ c.upcase
475
+ end
476
+ else
477
+ c
478
+ end
479
+ end
480
+ end
481
+
482
+ def self.string_capitalize_impl(args, env)
483
+ str = get_string("string-capitalize", args.nth(1).evaluate(env))
484
+ new_chars = capitalize_string(str)
485
+ new_str = ""
486
+ new_chars.each {|c| new_str << c}
487
+ self.with_value(new_str)
488
+ end
489
+
490
+
491
+ def self.string_capitalize_bang_impl(args, env)
492
+ raise "string-capitalize! requires 1 argument, but received #{args.length}" unless args.length == 1
493
+ str = args.nth(1).evaluate(env)
494
+ raise "string-capitalize! requires a string, but received #{str}" unless str.string?
495
+ new_chars = capitalize_string(str.value)
496
+ new_str = ""
497
+ new_chars.each {|c| new_str << c}
498
+ str.set!(new_str)
499
+ str
500
+ end
501
+
502
+
503
+ def self.substring_capitalize_bang_impl(args, env)
504
+ raise "substring-capitalize! requires 3 arguments, but received #{args.length}" unless args.length == 3
505
+ s = args.nth(1).evaluate(env)
506
+ raise "substring-capitalize! requires a string as it's first argument, but received #{s}" unless s.string?
507
+ str = s.value
508
+
509
+ start_index = args.nth(2).evaluate(env)
510
+ raise "substring-capitalize! requires an integer start index, but received #{start_index}" unless start_index.integer?
511
+ si = start_index.value
512
+ raise "substring-capitalize! received an invalid substring start index: #{si}" if si < 0 || si > str.length
513
+
514
+ end_index = args.nth(3).evaluate(env)
515
+ raise "substring-capitalize! requires an integer end index, but received #{end_index}" unless end_index.integer?
516
+ ei = end_index.value
517
+ raise "substring-capitalize! received an invalid substring end index: #{ei}" if ei < 0 || ei > str.length
518
+
519
+ prefix = str[0...si]
520
+ substr = str[si...ei]
521
+ suffix = str[ei..-1]
522
+
523
+ new_chars = capitalize_string(substr)
524
+ new_substr = ""
525
+ new_chars.each {|c| new_substr << c}
526
+ s.set!(prefix + new_substr + suffix)
527
+ s
528
+ end
529
+
530
+
531
+ def self.string_downcase_impl(args, env)
532
+ str = get_string("string-downcase?", args.nth(1).evaluate(env))
533
+ self.with_value(str.downcase)
534
+ end
535
+
536
+
537
+ def self.string_downcase_bang_impl(args, env)
538
+ raise "string-downcase! requires 1 argument, but received #{args.length}" unless args.length == 1
539
+ str = args.nth(1).evaluate(env)
540
+ raise "string-downcase! requires a string, but received #{str}" unless str.string?
541
+ str.set!(str.value.downcase)
542
+ str
543
+ end
544
+
545
+
546
+ def self.substring_downcase_bang_impl(args, env)
547
+ raise "substring-downcase! requires 3 arguments, but received #{args.length}" unless args.length == 3
548
+ s = args.nth(1).evaluate(env)
549
+ raise "substring-downcase! requires a string as it's first argument, but received #{s}" unless s.string?
550
+ str = s.value
551
+
552
+ start_index = args.nth(2).evaluate(env)
553
+ raise "substring-downcase! requires an integer start index, but received #{start_index}" unless start_index.integer?
554
+ si = start_index.value
555
+ raise "substring-downcase! received an invalid substring start index: #{si}" if si < 0 || si > str.length
556
+
557
+ end_index = args.nth(3).evaluate(env)
558
+ raise "substring-downcase! requires an integer end index, but received #{end_index}" unless end_index.integer?
559
+ ei = end_index.value
560
+ raise "substring-downcase! received an invalid substring end index: #{ei}" if ei < 0 || ei > str.length
561
+
562
+ prefix = str[0...si]
563
+ substr = str[si...ei]
564
+ suffix = str[ei..-1]
565
+
566
+ new_chars = capitalize_string(substr)
567
+ new_substr = ""
568
+ new_chars.each {|c| new_substr << c}
569
+ s.set!(prefix + substr.downcase + suffix)
570
+ s
571
+ end
572
+
573
+
574
+ def self.string_upcase_impl(args, env)
575
+ str = get_string("string-upcase?", args.nth(1).evaluate(env))
576
+ self.with_value(str.upcase)
577
+ end
578
+
579
+
580
+ def self.string_upcase_bang_impl(args, env)
581
+ raise "string-upcase! requires 1 argument, but received #{args.length}" unless args.length == 1
582
+ str = args.nth(1).evaluate(env)
583
+ raise "string-upcase! requires a string, but received #{str}" unless str.string?
584
+ str.set!(str.value.upcase)
585
+ str
586
+ end
587
+
588
+
589
+ def self.substring_upcase_bang_impl(args, env)
590
+ raise "substring-upcase! requires 3 arguments, but received #{args.length}" unless args.length == 3
591
+ s = args.nth(1).evaluate(env)
592
+ raise "substring-upcase! requires a string as it's first argument, but received #{s}" unless s.string?
593
+ str = s.value
594
+
595
+ start_index = args.nth(2).evaluate(env)
596
+ raise "substring-upcase! requires an integer start index, but received #{start_index}" unless start_index.integer?
597
+ si = start_index.value
598
+ raise "substring-upcase! received an invalid substring start index: #{si}" if si < 0 || si > str.length
599
+
600
+ end_index = args.nth(3).evaluate(env)
601
+ raise "substring-upcase! requires an integer end index, but received #{end_index}" unless end_index.integer?
602
+ ei = end_index.value
603
+ raise "substring-upcase! received an invalid substring end index: #{ei}" if ei < 0 || ei > str.length
604
+
605
+ prefix = str[0...si]
606
+ substr = str[si...ei]
607
+ suffix = str[ei..-1]
608
+
609
+ new_chars = capitalize_string(substr)
610
+ new_substr = ""
611
+ new_chars.each {|c| new_substr << c}
612
+ s.set!(prefix + substr.upcase + suffix)
613
+ s
614
+ end
615
+
616
+
617
+ def self.string_append_impl(args, env)
618
+ strings = args.to_a.map do |a|
619
+ s = a.evaluate(env)
620
+ raise "string-append requires strings, but received #{s}" unless s.string?
621
+ s.value
622
+ end
623
+
624
+ self.with_value(strings.join)
625
+ end
626
+
627
+
628
+ def self.substring_impl(args, env)
629
+ str = get_substring("substring", args.nth(1).evaluate(env), args.nth(2).evaluate(env), args.nth(3).evaluate(env))
630
+ self.with_value(str)
631
+ end
632
+
633
+
634
+ def self.string_head_impl(args, env)
635
+ raise "string-head requires 2 arguments, but received #{args.length}" unless args.length == 2
636
+ s = args.nth(1).evaluate(env)
637
+ raise "string-head requires a string as it's first argument, but received #{s}" unless s.string?
638
+ str = s.value
639
+
640
+ end_index = args.nth(2).evaluate(env)
641
+ raise "string-head requires an integer end index, but received #{end_index}" unless end_index.integer?
642
+ ei = end_index.value
643
+ raise "string-head received an invalid end index: #{ei}" if ei < 0 || ei > str.length
644
+
645
+ self.with_value(str[0...ei])
646
+ end
647
+
648
+
649
+ def self.string_tail_impl(args, env)
650
+ raise "string-tail requires 2 arguments, but received #{args.length}" unless args.length == 2
651
+ s = args.nth(1).evaluate(env)
652
+ raise "string-tail requires a string as it's first argument, but received #{s}" unless s.string?
653
+ str = s.value
654
+
655
+ start_index = args.nth(2).evaluate(env)
656
+ raise "string-tail requires an integer start index, but received #{start_index}" unless start_index.integer?
657
+ si = start_index.value
658
+ raise "string-tail received an invalid end index: #{si}" if si < 0 || si > str.length
659
+
660
+ self.with_value(str[si..-1])
661
+ end
662
+
663
+
664
+ def self.string_pad_left_impl(args, env)
665
+ raise "string-pad-left requires 2 or 3 arguments, but received #{args.length}" unless args.length == 2 || args.length == 3
666
+ s = args.nth(1).evaluate(env)
667
+ raise "string-pad-left requires a string as it's first argument, but received #{s}" unless s.string?
668
+ str = s.value
669
+
670
+ size_arg = args.nth(2).evaluate(env)
671
+ raise "string-pad-left requires an integer size, but received #{size_arg}" unless size_arg.integer?
672
+ size = size_arg.value
673
+ raise "string-pad-left received an invalid size: #{size}" if size < 0
674
+
675
+ padding_char = if args.length == 3
676
+ ch_arg = args.nth(3).evaluate(env)
677
+ raise "string-pad-left requires a character pad, but received #{ch_arg}" unless ch_arg.character?
678
+ ch_arg.value
679
+ else
680
+ " "
681
+ end
682
+
683
+
684
+ new_str = if size > str.length
685
+ padding = size - str.length
686
+ pad = ""
687
+ padding.times {|i| pad << padding_char}
688
+ pad + str
689
+ else
690
+ start = str.length - size
691
+ str[start..-1]
692
+ end
693
+ self.with_value(new_str)
694
+ end
695
+
696
+
697
+ def self.string_pad_right_impl(args, env)
698
+ raise "string-pad-right requires 2 or 3 arguments, but received #{args.length}" unless args.length == 2 || args.length == 3
699
+ s = args.nth(1).evaluate(env)
700
+ raise "string-pad-right requires a string as it's first argument, but received #{s}" unless s.string?
701
+ str = s.value
702
+
703
+ size_arg = args.nth(2).evaluate(env)
704
+ raise "string-pad-right requires an integer size, but received #{size_arg}" unless size_arg.integer?
705
+ size = size_arg.value
706
+ raise "string-pad-right received an invalid size: #{size}" if size < 0
707
+
708
+ padding_char = if args.length == 3
709
+ ch_arg = args.nth(3).evaluate(env)
710
+ raise "string-pad-right requires a character pad, but received #{ch_arg}" unless ch_arg.character?
711
+ ch_arg.value
712
+ else
713
+ " "
714
+ end
715
+
716
+
717
+ new_str = if size > str.length
718
+ padding = size - str.length
719
+ pad = ""
720
+ padding.times {|i| pad << padding_char}
721
+ str + pad
722
+ else
723
+ last = str.length - size
724
+ str[0...4]
725
+ end
726
+ self.with_value(new_str)
727
+ end
728
+
729
+
730
+ def self.string_trim_impl(args, env)
731
+ raise "string-trim requires 1 or 2 arguments, but received #{args.length}" unless args.length == 1 || args.length == 2
732
+ s1 = args.nth(1).evaluate(env)
733
+ raise "string-trim requires a string as it's first argument, but received #{s1}" unless s1.string?
734
+ str = s1.value
735
+
736
+ pattern = Regexp.new(if args.length == 2
737
+ s2 = args.nth(2).evaluate(env)
738
+ raise "string-trim requires a string as it's second argument, but received #{s2}" unless s2.string?
739
+ s2.value
740
+ else
741
+ "[[:graph:]]"
742
+ end)
743
+
744
+
745
+ left_i = 0
746
+ while pattern.match(str[left_i]).nil? && left_i < str.length
747
+ left_i += 1
748
+ end
749
+
750
+ right_i = str.length - 1
751
+ while pattern.match(str[right_i]).nil? && right_i >= 0
752
+ right_i -= 1
753
+ end
754
+
755
+ self.with_value(str[left_i..right_i])
756
+ end
757
+
758
+
759
+ def self.string_trim_left_impl(args, env)
760
+ raise "string-trim-left requires 1 or 2 arguments, but received #{args.length}" unless args.length == 1 || args.length == 2
761
+ s1 = args.nth(1).evaluate(env)
762
+ raise "string-trim-left requires a string as it's first argument, but received #{s1}" unless s1.string?
763
+ str = s1.value
764
+
765
+ pattern = Regexp.new(if args.length == 2
766
+ s2 = args.nth(2).evaluate(env)
767
+ raise "string-trim-left requires a string as it's second argument, but received #{s2}" unless s2.string?
768
+ s2.value
769
+ else
770
+ "[[:graph:]]"
771
+ end)
772
+
773
+
774
+ left_i = 0
775
+ while pattern.match(str[left_i]).nil? && left_i < str.length
776
+ left_i += 1
777
+ end
778
+
779
+ self.with_value(str[left_i..-1])
780
+ end
781
+
782
+
783
+ def self.string_trim_right_impl(args, env)
784
+ raise "string-trim-right requires 1 or 2 arguments, but received #{args.length}" unless args.length == 1 || args.length == 2
785
+ s1 = args.nth(1).evaluate(env)
786
+ raise "string-trim-right requires a string as it's first argument, but received #{s1}" unless s1.string?
787
+ str = s1.value
788
+
789
+ pattern = Regexp.new(if args.length == 2
790
+ s2 = args.nth(2).evaluate(env)
791
+ raise "string-trim-right requires a string as it's second argument, but received #{s2}" unless s2.string?
792
+ s2.value
793
+ else
794
+ "[[:graph:]]"
795
+ end)
796
+
797
+ right_i = str.length - 1
798
+ while pattern.match(str[right_i]).nil? && right_i >= 0
799
+ right_i -= 1
800
+ end
801
+
802
+ self.with_value(str[0..right_i])
803
+ end
804
+
805
+
806
+ # --------------------------------------------------------------------------------
807
+
808
+ def self.with_value(n)
809
+ self.new(n)
810
+ end
811
+
812
+ def initialize(n = '')
813
+ @value = n.to_s
814
+ end
815
+
816
+ def set!(n)
817
+ @value = n.to_s
818
+ end
819
+
820
+ def string?
821
+ true
822
+ end
823
+
824
+ def type
825
+ :string
826
+ end
827
+
828
+ def to_s
829
+ @value
830
+ end
831
+
832
+ def to_sym
833
+ @value.to_sym
834
+ end
835
+
836
+ def print_string
837
+ "\"#{@value}\""
838
+ end
839
+ end
840
+
841
+ end