rubylisp 0.2.1 → 1.0.2

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