Class: Lisp::PrimCharacter

Inherits:
Object show all
Defined in:
lib/rubylisp/prim_character.rb

Class Method Summary collapse

Class Method Details

.char_ci_eq_impl(args, env) ⇒ Object 



165
166
167
168
 
# File 'lib/rubylisp/prim_character.rb', line 165

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 



177
178
179
180
 
# File 'lib/rubylisp/prim_character.rb', line 177

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 



189
190
191
192
 
# File 'lib/rubylisp/prim_character.rb', line 189

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 



171
172
173
174
 
# File 'lib/rubylisp/prim_character.rb', line 171

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 



183
184
185
186
 
# File 'lib/rubylisp/prim_character.rb', line 183

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 



213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
 
# File 'lib/rubylisp/prim_character.rb', line 213

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
           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 



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

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 



135
136
137
138
 
# File 'lib/rubylisp/prim_character.rb', line 135

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 



147
148
149
150
 
# File 'lib/rubylisp/prim_character.rb', line 147

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 



159
160
161
162
 
# File 'lib/rubylisp/prim_character.rb', line 159

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 



259
260
261
262
 
# File 'lib/rubylisp/prim_character.rb', line 259

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 



141
142
143
144
 
# File 'lib/rubylisp/prim_character.rb', line 141

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 



153
154
155
156
 
# File 'lib/rubylisp/prim_character.rb', line 153

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
 
# File 'lib/rubylisp/prim_character.rb', line 101

def self.char_name_impl(args, env)
  char = args.car
  return Lisp::Debug.process_error("char->name requires a character argument", env) unless char.character?
  kv = Lisp::Character.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 



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

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 



195
196
197
198
 
# File 'lib/rubylisp/prim_character.rb', line 195

def self.charp_impl(args, env)
  char = args.car
  Lisp::Boolean.with_value(char.character?)
end

.digit_char_impl(args, env) ⇒ Object 



242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
 
# File 'lib/rubylisp/prim_character.rb', line 242

def self.digit_char_impl(args, env)
  d = args.car
  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
           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/prim_character.rb', line 85

def self.find_character_for_chr(ch)
  Lisp::Character.character_constants.each_value {|v| return v if v.value == ch}
  return Lisp::Character.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/prim_character.rb', line 91

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

.get_one_character_arg(func, args, env) ⇒ Object 



119
120
121
122
123
 
# File 'lib/rubylisp/prim_character.rb', line 119

def self.get_one_character_arg(func, args, env)
  char1 = args.car
  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 



126
127
128
129
130
131
132
 
# File 'lib/rubylisp/prim_character.rb', line 126

def self.get_two_character_args(func, args, env)
  char1 = args.car
  return Lisp::Debug.process_error("#{func} requires character arguments, found #{char1}", env) unless char1.character?
  char2 = args.cadr
  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 



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

def self.int_char_impl(args, env)
  i = args.car
  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 



110
111
112
113
114
115
116
 
# File 'lib/rubylisp/prim_character.rb', line 110

def self.name_char_impl(args, env)
  name = args.car
  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/prim_character.rb', line 6

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