Class: Lisp::Character

Inherits:
Atom show all
Defined in:
lib/rubylisp/character.rb

Constant Summary collapse

@@character_constants = 
{}

Instance Attribute Summary

Attributes inherited from Atom

#value

Class Method Summary collapse

Instance Method Summary collapse

Methods inherited from Atom

#alist?, #all?, #apply_to, #car, #cdr, #class?, #copy, #doc, #eq?, #evaluate, #false?, #frame?, #function?, #length, #lisp_object?, #list?, #macro?, #negative?, #number?, #object?, #pair?, #positive?, #primitive?, #quoted, #special?, #string?, #symbol?, #true?, #vector?, #zero?

Constructor Details

#initialize(n) ⇒ Character

Returns a new instance of Character.



278
279
280
 
# File 'lib/rubylisp/character.rb', line 278

def initialize(n)
  @value = n
end

Class Method Details

.char_ci_eq_impl(args, env) ⇒ Object 



170
171
172
173
 
# File 'lib/rubylisp/character.rb', line 170

def self.char_ci_eq_impl(args, env)
  char1, char2 = get_two_character_args("char-ci=?", args, env)
  Lisp::Boolean.with_value(char1.value.downcase == char2.value.downcase)
end

.char_ci_gt_impl(args, env) ⇒ Object 



182
183
184
185
 
# File 'lib/rubylisp/character.rb', line 182

def self.char_ci_gt_impl(args, env)
  char1, char2 = get_two_character_args("char-ci>?", args, env)
  Lisp::Boolean.with_value(char1.value.downcase > char2.value.downcase)
end

.char_ci_gteq_impl(args, env) ⇒ Object 



194
195
196
197
 
# File 'lib/rubylisp/character.rb', line 194

def self.char_ci_gteq_impl(args, env)
  char1, char2 = get_two_character_args("char-ci>=?", args, env)
  Lisp::Boolean.with_value(char1.value.downcase >= char2.value.downcase)
end

.char_ci_lt_impl(args, env) ⇒ Object 



176
177
178
179
 
# File 'lib/rubylisp/character.rb', line 176

def self.char_ci_lt_impl(args, env)
  char1, char2 = get_two_character_args("char-ci<?", args, env)
  Lisp::Boolean.with_value(char1.value.downcase < char2.value.downcase)
end

.char_ci_lteq_impl(args, env) ⇒ Object 



188
189
190
191
 
# File 'lib/rubylisp/character.rb', line 188

def self.char_ci_lteq_impl(args, env)
  char1, char2 = get_two_character_args("char-ci<=?", args, env)
  Lisp::Boolean.with_value(char1.value.downcase <= char2.value.downcase)
end

.char_digit_impl(args, env) ⇒ Object 



219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
 
# File 'lib/rubylisp/character.rb', line 219

def self.char_digit_impl(args, env)
  char = get_one_character_arg("char->digit", args, env)
  base = if args.length == 1
           10
         else
           b = args.cadr.evaluate(env)
           return Lisp::Debug.process_error("Base for char->digit has to be an integer", env) unless b.integer?
           return Lisp::Debug.process_error("Base for char->digit has to be between 2 and 36", env) unless b.value >=2 && b.value <= 36
           b.value
         end
  ch = char.value.upcase
  value = case ch
          when /[0-9]/
            ch[0].ord - 48
          when /[A-Z]/
            10 + ch[0].ord - 65
          else
            -1
          end
  if value == -1
    Lisp::FALSE
  elsif value >= base
    Lisp::FALSE
  else
    Lisp::Number.with_value(value)
  end
end

.char_downcase_impl(args, env) ⇒ Object 



213
214
215
216
 
# File 'lib/rubylisp/character.rb', line 213

def self.char_downcase_impl(args, env)
  char = get_one_character_arg("char->digit", args, env)
  find_character_for_chr(char.value.downcase)
end

.char_eq_impl(args, env) ⇒ Object 



140
141
142
143
 
# File 'lib/rubylisp/character.rb', line 140

def self.char_eq_impl(args, env)
  char1, char2 = get_two_character_args("char=?", args, env)
  Lisp::Boolean.with_value(char1.value == char2.value)
end

.char_gt_impl(args, env) ⇒ Object 



152
153
154
155
 
# File 'lib/rubylisp/character.rb', line 152

def self.char_gt_impl(args, env)
  char1, char2 = get_two_character_args("char>?", args, env)
  Lisp::Boolean.with_value(char1.value > char2.value)
end

.char_gteq_impl(args, env) ⇒ Object 



164
165
166
167
 
# File 'lib/rubylisp/character.rb', line 164

def self.char_gteq_impl(args, env)
  char1, char2 = get_two_character_args("char>=?", args, env)
  Lisp::Boolean.with_value(char1.value >= char2.value)
end

.char_int_impl(args, env) ⇒ Object 



265
266
267
268
 
# File 'lib/rubylisp/character.rb', line 265

def self.char_int_impl(args, env)
  char = get_one_character_arg("char->int", args, env)
  Lisp::Number.with_value(char.value.ord)
end

.char_lt_impl(args, env) ⇒ Object 



146
147
148
149
 
# File 'lib/rubylisp/character.rb', line 146

def self.char_lt_impl(args, env)
  char1, char2 = get_two_character_args("char<?", args, env)
  Lisp::Boolean.with_value(char1.value < char2.value)
end

.char_lteq_impl(args, env) ⇒ Object 



158
159
160
161
 
# File 'lib/rubylisp/character.rb', line 158

def self.char_lteq_impl(args, env)
  char1, char2 = get_two_character_args("char<=?", args, env)
  Lisp::Boolean.with_value(char1.value <= char2.value)
end

.char_name_impl(args, env) ⇒ Object 



101
102
103
104
105
106
107
108
 
# File 'lib/rubylisp/character.rb', line 101

def self.char_name_impl(args, env)
  return Lisp::Debug.process_error("char->name requires a single argument, found #{args.length}", env) unless args.length == 1
  char = args.car.evaluate(env)
  return Lisp::Debug.process_error("char->name requires a character argument", env) unless char.character?
  kv = @@character_constants.rassoc(char)
  return Lisp::String.with_value(kv[0]) unless kv.nil?
  return Lisp::Debug.process_error("char->name was passed an invalid character", env)
end

.char_upcase_impl(args, env) ⇒ Object 



207
208
209
210
 
# File 'lib/rubylisp/character.rb', line 207

def self.char_upcase_impl(args, env)
  char = get_one_character_arg("char->digit", args, env)
  find_character_for_chr(char.value.upcase)
end

.charp_impl(args, env) ⇒ Object 



200
201
202
203
204
 
# File 'lib/rubylisp/character.rb', line 200

def self.charp_impl(args, env)
  return Lisp::Debug.process_error("char->name requires a single argument, found #{args.length}", env) unless args.length == 1
  char = args.car.evaluate(env)
  Lisp::Boolean.with_value(char.character?)
end

.digit_char_impl(args, env) ⇒ Object 



248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
 
# File 'lib/rubylisp/character.rb', line 248

def self.digit_char_impl(args, env)
  d = args.car.evaluate(env)
  return Lisp::Debug.process_error("Digit value for digit->char has to be an integer", env) unless d.integer?
  base = if args.length == 1
           10
         else
           b = args.cadr.evaluate(env)
           return Lisp::Debug.process_error("Base for char->digit has to be an integer", env) unless b.integer?
           return Lisp::Debug.process_error("Base for char->digit has to be between 2 and 36", env) unless b.value >=2 && b.value <= 36
           b.value
         end
  val = d.value
  return Lisp::FALSE if val < 0 || val >= base 
  find_character_for_chr((((val < 10) ? 48 : 55) + val).chr)
end

.find_character_for_chr(ch) ⇒ Object 



85
86
87
88
 
# File 'lib/rubylisp/character.rb', line 85

def self.find_character_for_chr(ch)
  @@character_constants.each_value {|v| return v if v.value == ch}
  return @@character_constants[ch] = Lisp::Character.new(ch)
end

.find_character_for_name(n) ⇒ Object 



91
92
93
94
95
96
97
98
 
# File 'lib/rubylisp/character.rb', line 91

def self.find_character_for_name(n)
  return @@character_constants[n] if @@character_constants.has_key?(n)
  if n.length == 1
    ch = self.new(n[0])
   return @@character_constants[n] = ch
  end
  nil
end

.get_one_character_arg(func, args, env) ⇒ Object 



121
122
123
124
125
126
 
# File 'lib/rubylisp/character.rb', line 121

def self.get_one_character_arg(func, args, env)
  return Lisp::Debug.process_error("#{func} requires a character argument, found no args", env) unless args.length >= 1
  char1 = args.car.evaluate(env)
  return Lisp::Debug.process_error("#{func} requires a character argument, found #{char1}", env) unless char1.character?
  return char1
end

.get_two_character_args(func, args, env) ⇒ Object 



129
130
131
132
133
134
135
136
137
 
# File 'lib/rubylisp/character.rb', line 129

def self.get_two_character_args(func, args, env)
  return Lisp::Debug.process_error("#{func} requires two arguments, found
                            ##{args.length}", env) unless args.length == 2
  char1 = args.car.evaluate(env)
  return Lisp::Debug.process_error("#{func} requires character arguments, found #{char1}", env) unless char1.character?
  char2 = args.cadr.evaluate(env)
  return Lisp::Debug.process_error("#{func} requires character arguments, found #{char2}", env) unless char2.character?
  return [char1, char2]
end

.int_char_impl(args, env) ⇒ Object 



271
272
273
274
275
 
# File 'lib/rubylisp/character.rb', line 271

def self.int_char_impl(args, env)
  i = args.car.evaluate(env)
  return Lisp::Debug.process_error("Integer value for int->char has to be an integer", env) unless i.integer?
  find_character_for_chr(i.value.chr)
end

.name_char_impl(args, env) ⇒ Object 



111
112
113
114
115
116
117
118
 
# File 'lib/rubylisp/character.rb', line 111

def self.name_char_impl(args, env)
  return Lisp::Debug.process_error("name->char requires a single argument, found #{args.length}", env) unless args.length == 1
  name = args.car.evaluate(env)
  return Lisp::Debug.process_error("name->char requires a string argument", env) unless name.string?
  ch = find_character_for_name(name.value)
  return ch unless ch.nil?
  return Lisp::Debug.process_error("There is no character with the name #{name}", env)
end

.register ⇒ Object 



6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
 
# File 'lib/rubylisp/character.rb', line 6

def self.register
  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|
    Lisp::Character::char_name_impl(args, env)
  end
  
  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|
    Lisp::Character::name_char_impl(args, env)
  end
  
  Primitive.register("char=?", "(char=? char1 char2)\n\nReturn whether char1 and char2 are the same") do |args, env|
    Lisp::Character::char_eq_impl(args, env)
  end
  
  Primitive.register("char<?", "(char<? char1 char2)\n\nReturn whether char1 is less than char2") do |args, env|
    Lisp::Character::char_lt_impl(args, env)
  end
  
  Primitive.register("char>?", "(char>? char1 char2)\n\nReturn whether char1 is greater than char2") do |args, env|
    Lisp::Character::char_gt_impl(args, env)
  end
  
  Primitive.register("char<=?", "(char<=? char1 char2)\n\nReturn whether char1 is less than or equal to char2") do |args, env|
    Lisp::Character::char_lteq_impl(args, env)
  end
  
  Primitive.register("char>=?", "(char>=? char1 char2)\n\nReturn whether char1 is greater than or equal to char2") do |args, env|
    Lisp::Character::char_gteq_impl(args, env)
  end
  
  Primitive.register("char-ci=?", "(char=? char1 char2)\n\nReturn whether char1 is equal to char2, ignoring case") do |args, env|
    Lisp::Character::char_ci_eq_impl(args, env)
  end
  
  Primitive.register("char-ci<?", "(char=? char1 char2)\n\nReturn whether char1 is less than char2, ignoring case") do |args, env|
    Lisp::Character::char_ci_lt_impl(args, env)
  end
  
  Primitive.register("char-ci>?", "(char=? char1 char2)\n\nReturn whether char1 is greater than char2, ignoring case") do |args, env|
    Lisp::Character::char_ci_gt_impl(args, env)
  end
  
  Primitive.register("char-ci<=?", "(char=? char1 char2)\n\nReturn whether char1 is less than or equal to char2, ignoring case") do |args, env|
    Lisp::Character::char_ci_lteq_impl(args, env)
  end
  
  Primitive.register("char-ci>=?", "(char=? char1 char2)\n\nReturn whether char1 is greater than orequal to char2, ignoring case") do |args, env|
    Lisp::Character::char_ci_gteq_impl(args, env)
  end
  
  Primitive.register("char?", "(char? sexpr)\n\nReturns #t if object is a character; otherwise returns #f.") do |args, env|
    Lisp::Character::charp_impl(args, env)
  end
  
  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|
    Lisp::Character::char_upcase_impl(args, env)
  end
  
  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|
    Lisp::Character::char_downcase_impl(args, env)
  end
  
  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|
    Lisp::Character::char_digit_impl(args, env)
  end
  
  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|
    Lisp::Character::digit_char_impl(args, env)
  end
  
  Primitive.register("char->integer", "(char->integer char)\n\nchar->integer returns the character code representation for char.") do |args, env|
    Lisp::Character::char_int_impl(args, env)
  end
  
  Primitive.register("integer->char", "(integer->char k)\n\ninteger->char returns the character whose character code representation is k.") do |args, env|
    Lisp::Character::int_char_impl(args, env)
  end
end

.with_value(n) ⇒ Object 



366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
 
# File 'lib/rubylisp/character.rb', line 366

def self.with_value(n)
  if n.length == 1
    ch = find_character_for_chr(n[0])
    return ch unless ch.nil?
    ch = self.new(n[0])
    @@character_constants[n] = ch
    ch
  elsif @@character_constants.has_key?(n)
    @@character_constants[n]
  elsif n[0..1] == "U+"
    find_character_for_chr(n[2..-1].to_i(16).chr)
  else
    return Lisp::Debug.process_error("Invalid character name: #{n}", env)
  end
end

Instance Method Details

#character? ⇒ Boolean

Returns:



288
289
290
 
# File 'lib/rubylisp/character.rb', line 288

def character?
  true
end

#find_charactername ⇒ Object 



308
309
310
311
 
# File 'lib/rubylisp/character.rb', line 308

def find_charactername
  @@character_constants.each {|k, v| return k if v == self}
  "UNKNOWN"
end

#print_string ⇒ Object 



314
315
316
 
# File 'lib/rubylisp/character.rb', line 314

def print_string
  return "#\\#{find_charactername}"
end

#set!(n) ⇒ Object 



283
284
285
 
# File 'lib/rubylisp/character.rb', line 283

def set!(n)
  @value = n
end

#to_s ⇒ Object 



298
299
300
 
# File 'lib/rubylisp/character.rb', line 298

def to_s
  @value
end

#to_sym ⇒ Object 



303
304
305
 
# File 'lib/rubylisp/character.rb', line 303

def to_sym
  @value.to_sym
end

#type ⇒ Object 



293
294
295
 
# File 'lib/rubylisp/character.rb', line 293

def type
  :character
end