rubymotionlisp 0.1.3

data/lib/rubylisp/string.rb

@@ -0,0 +1,841 @@
+module Lisp
+
+  class String < Atom
+
+    def self.register
+      Primitive.register("str")   {|args, env| Lisp::String::str_impl(args, env) }
+      Primitive.register("string?")   {|args, env| Lisp::String::stringp_impl(args, env) }
+      Primitive.register("make-string") {|args, env| Lisp::String::make_string_impl(args, env) }      
+      Primitive.register("string") {|args, env| Lisp::String::string_impl(args, env) }      
+      Primitive.register("list->string") {|args, env| Lisp::String::list_string_impl(args, env) }      
+      Primitive.register("string->list") {|args, env| Lisp::String::string_list_impl(args, env) }      
+      Primitive.register("string-copy") {|args, env| Lisp::String::string_copy_impl(args, env) }      
+      Primitive.register("string-length") {|args, env| Lisp::String::string_length_impl(args, env) }      
+      Primitive.register("string-null?") {|args, env| Lisp::String::string_nullp_impl(args, env) }      
+      Primitive.register("string-ref") {|args, env| Lisp::String::string_ref_impl(args, env) }      
+      Primitive.register("string-set!") {|args, env| Lisp::String::string_set_impl(args, env) }      
+
+      Primitive.register("string=?") {|args, env| Lisp::String::string_eq_impl(args, env) }      
+      Primitive.register("substring=?") {|args, env| Lisp::String::substring_eq_impl(args, env) }      
+      Primitive.register("string-ci=?") {|args, env| Lisp::String::string_ci_eq_impl(args, env) }      
+      Primitive.register("substring-ci=?") {|args, env| Lisp::String::substring_ci_eq_impl(args, env) }      
+
+      Primitive.register("string<?") {|args, env| Lisp::String::string_lt_impl(args, env) }      
+      Primitive.register("substring<?") {|args, env| Lisp::String::substring_lt_impl(args, env) }      
+      Primitive.register("string-ci<?") {|args, env| Lisp::String::string_ci_lt_impl(args, env) }      
+      Primitive.register("substring-ci<?") {|args, env| Lisp::String::substring_ci_lt_impl(args, env) }      
+
+      Primitive.register("string>?") {|args, env| Lisp::String::string_gt_impl(args, env) }      
+      Primitive.register("substring>?") {|args, env| Lisp::String::substring_gt_impl(args, env) }      
+      Primitive.register("string-ci>?") {|args, env| Lisp::String::string_ci_gt_impl(args, env) }      
+      Primitive.register("substring-ci>?") {|args, env| Lisp::String::substring_ci_gt_impl(args, env) }      
+
+      Primitive.register("string<=?") {|args, env| Lisp::String::string_lte_impl(args, env) }      
+      Primitive.register("substring<=?") {|args, env| Lisp::String::substring_lte_impl(args, env) }      
+      Primitive.register("string-ci<=?") {|args, env| Lisp::String::string_ci_lte_impl(args, env) }      
+      Primitive.register("substring-ci<=?") {|args, env| Lisp::String::substring_ci_lte_impl(args, env) }      
+
+      Primitive.register("string>=?") {|args, env| Lisp::String::string_gte_impl(args, env) }      
+      Primitive.register("substring>=?") {|args, env| Lisp::String::substring_gte_impl(args, env) }      
+      Primitive.register("string-ci>=?") {|args, env| Lisp::String::string_ci_gte_impl(args, env) }      
+      Primitive.register("substring-ci>=?") {|args, env| Lisp::String::substring_ci_gte_impl(args, env) }      
+
+      Primitive.register("string-compare") {|args, env| Lisp::String::string_compare_impl(args, env) }      
+      Primitive.register("string-compare-ci") {|args, env| Lisp::String::string_compare_ci_impl(args, env) }      
+
+      Primitive.register("string-hash") {|args, env| Lisp::String::string_hash_impl(args, env) }      
+      Primitive.register("string-hash-mod") {|args, env| Lisp::String::string_hash_mod_impl(args, env) }      
+
+      Primitive.register("string-capitalized?") {|args, env| Lisp::String::string_capitalizedp_impl(args, env) }      
+      Primitive.register("substring-capitalized?") {|args, env| Lisp::String::substring_capitalizedp_impl(args, env) }      
+      Primitive.register("string-upper-case?") {|args, env| Lisp::String::string_upperp_impl(args, env) }      
+      Primitive.register("substring-upper-case?") {|args, env| Lisp::String::substring_upperp_impl(args, env) }      
+      Primitive.register("string-lower-case?") {|args, env| Lisp::String::string_lowerp_impl(args, env) }      
+      Primitive.register("substring-lower-case?") {|args, env| Lisp::String::substring_lowerp_impl(args, env) }      
+
+      Primitive.register("string-capitalize") {|args, env| Lisp::String::string_capitalize_impl(args, env) }      
+      Primitive.register("string-capitalize!") {|args, env| Lisp::String::string_capitalize_bang_impl(args, env) }      
+      Primitive.register("substring-capitalize!") {|args, env| Lisp::String::substring_capitalize_bang_impl(args, env) }      
+      Primitive.register("string-downcase") {|args, env| Lisp::String::string_downcase_impl(args, env) }      
+      Primitive.register("string-downcase!") {|args, env| Lisp::String::string_downcase_bang_impl(args, env) }      
+      Primitive.register("substring-downcase!") {|args, env| Lisp::String::substring_downcase_bang_impl(args, env) }      
+      Primitive.register("string-upcase") {|args, env| Lisp::String::string_upcase_impl(args, env) }      
+      Primitive.register("string-upcase!") {|args, env| Lisp::String::string_upcase_bang_impl(args, env) }      
+      Primitive.register("substring-upcase!") {|args, env| Lisp::String::substring_upcase_bang_impl(args, env) }
+
+      Primitive.register("string-append") {|args, env| Lisp::String::string_append_impl(args, env) }      
+      Primitive.register("substring") {|args, env| Lisp::String::substring_impl(args, env) }      
+      Primitive.register("string-head") {|args, env| Lisp::String::string_head_impl(args, env) }      
+      Primitive.register("string-tail") {|args, env| Lisp::String::string_tail_impl(args, env) }      
+
+      Primitive.register("string-pad-left") {|args, env| Lisp::String::string_pad_left_impl(args, env) }      
+      Primitive.register("string-pad-right") {|args, env| Lisp::String::string_pad_right_impl(args, env) }      
+
+      Primitive.register("string-trim") {|args, env| Lisp::String::string_trim_impl(args, env) }      
+      Primitive.register("string-trim-right") {|args, env| Lisp::String::string_trim_right_impl(args, env) }      
+      Primitive.register("string-trim-left") {|args, env| Lisp::String::string_trim_left_impl(args, env) }      
+end
+
+    def self.str_impl(args, env)
+      strings = args.to_a.map {|e| e.evaluate(env).to_s}
+      String.with_value(strings.join)
+    end
+    
+
+    def self.stringp_impl(args, env)
+      raise "string? requires 1 argument" unless args.length == 1
+      return Lisp::Boolean.with_value(args.car.evaluate(env).string?)
+    end
+
+
+    def self.make_string_impl(args, env)
+      raise "make-string need requires at least 1 argument" unless args.length > 0
+      raise "make-string accepts at most 2 arguments, but was passed #{args.length}" if args.length > 2
+      k_arg = args.car.evaluate(env)
+      raise "make-string requires an integer as it's first argument." unless k_arg.integer?
+      k = k_arg.value
+      c = if args.length == 2
+            c_arg = args.cadr.evaluate(env)
+            raise "make-string requires a character as it's second argument, but received #{c_arg}." unless c_arg.character?
+            c_arg.value
+          else
+            " "
+          end
+      self.with_value(c * k)
+    end
+
+
+    def self.string_impl(args, env)
+      chars = args.to_a.map do |a|
+        ea = a.evaluate(env)
+        raise "string requires character args, but was passed #{ea}." unless ea.character?
+        ea.value
+      end
+      self.with_value(chars.join)
+    end
+
+
+    def self.list_string_impl(args, env)
+      raise "list->string requires 1 argument, but received #{args.length}" unless args.length == 1      
+      list_of_chars = args.car.evaluate(env)
+      raise "list->string requires a list argument, but received #{str_arg}" unless list_of_chars.list?      
+      chars = list_of_chars.to_a.map do |a|
+        ea = a.evaluate(env)
+        raise "string requires a list of characters, but it contained #{ea}." unless ea.character?
+        ea.value
+      end
+      self.with_value(chars.join)
+    end
+
+
+    def self.string_list_impl(args, env)
+      raise "string->list requires 1 argument, but received #{args.length}" unless args.length == 1      
+      str_arg = args.car.evaluate(env)
+      raise "string->list requires a string argument, but received #{str_arg}" unless str_arg.string?
+      chars = str_arg.value.each_char.map {|c| Lisp::Character.find_character_for_chr(c) }
+      Lisp::ConsCell.array_to_list(chars)
+    end
+
+
+    def self.string_copy_impl(args, env)
+      raise "string-copy requires 1 argument, but received #{args.length}" unless args.length == 1      
+      str_arg = args.car.evaluate(env)
+      raise "string-copy requires a string argument, but received #{str_arg}" unless str_arg.string?
+      self.with_value(str_arg.value)
+    end
+
+
+    def self.string_length_impl(args, env)
+      raise "string-length requires 1 argument, but received #{args.length}" unless args.length == 1      
+      str_arg = args.car.evaluate(env)
+      raise "string-length requires a string argument, but received #{str_arg}" unless str_arg.string?
+      Lisp::Number.with_value(str_arg.value.length)
+    end
+
+
+    def self.string_nullp_impl(args, env)
+      raise "string-length requires 1 argument, but received #{args.length}" unless args.length == 1      
+      str_arg = args.car.evaluate(env)
+      raise "string-length requires a string argument, but received #{str_arg}" unless str_arg.string?
+      Lisp::Boolean.with_value(str_arg.value.length == 0)
+    end
+
+
+    def self.string_ref_impl(args, env)
+      raise "string-ref requires 2 arguments, but received #{args.length}" unless args.length == 2      
+      str_arg = args.car.evaluate(env)
+      raise "string-ref requires a string as it's first argument, but received #{arg.car}" unless str_arg.string?
+      str = str_arg.value
+      k_arg = args.cadr.evaluate(env)
+      raise "string-ref requires it's second argument to be an integer, but received #{k_arg}" unless k_arg.integer?
+      k = k_arg.value
+      return Lisp::FALSE if k < 0 || k >= str.length
+      Lisp::Character.find_character_for_chr(str[k])
+    end
+
+
+    def self.string_set_impl(args, env)
+      raise "string-set! needs 3 arguments, but received #{args.length}" unless args.length == 3
+      str_arg = args.car.evaluate(env)
+      raise "string-set! needs a string as it's first argument, but received #{str_arg}" unless str_arg.string?
+      str = str_arg.value
+      k_arg = args.cadr.evaluate(env)
+      raise "string-set! requires an integer as it's second argument, but received #{k_arg}" unless k_arg.integer?
+      k = k_arg.value
+      return Lisp::FALSE if k < 0 || k >= str.length
+      replacement_arg = args.caddr.evaluate(env)
+      raise "string-set! requires a character as it's third argument, but received #{replacement_arg}" unless replacement_arg.character?
+      replacement = replacement_arg.value
+      str[k] = replacement
+      self.with_value(str)
+    end
+
+
+    def self.get_substring(func, str, start_index, end_index)
+      raise "#{func} requires a string, but received #{str}" unless str.string?
+      s = str.value
+      raise "#{func} requires an integer start index, but received #{start_index}" unless start_index.integer?
+      si = start_index.value
+      raise "#{func} received an invalid substring start index: #{si}" if si < 0 || si > s.length
+      raise "#{func} requires an integer end index, but received #{end_index}" unless end_index.integer?
+      ei = end_index.value
+      raise "#{func} received an invalid substring end index: #{ei}" if ei < 0 || ei > s.length
+      s[si...ei]
+    end
+
+
+    def self.extract_substrings(func, args, env)
+      raise "#{func} requires 6 arguments, but received #{args.length}" unless args.length == 6      
+      substr1 = get_substring(func, args.nth(1).evaluate(env), args.nth(2).evaluate(env), args.nth(3).evaluate(env))
+      substr2 = get_substring(func, args.nth(4).evaluate(env), args.nth(5).evaluate(env), args.nth(6).evaluate(env))
+      return [substr1, substr2]
+    end
+
+    
+    def self.get_string(func, str)
+      raise "#{func} requires a string, but received #{str}" unless str.string?
+      str.value
+    end
+
+
+    def self.extract_strings(func, args, env)
+      raise "#{func} requires 2 arguments, but received #{args.length}" unless args.length == 2
+      str1 = get_string(func, args.nth(1).evaluate(env))
+      str2 = get_string(func, args.nth(2).evaluate(env))
+      return [str1, str2]
+    end
+
+    
+    def self.string_eq_impl(args, env)
+      str1, str2 = extract_strings("string=?", args, env)
+      Lisp::Boolean.with_value(str1 == str2)
+    end
+
+
+    def self.substring_eq_impl(args, env)
+      substr1, substr2 = extract_substrings("substring=?", args, env)
+      Lisp::Boolean.with_value(substr1 == substr2)
+    end
+
+
+    def self.string_ci_eq_impl(args, env)
+      str1, str2 = extract_strings("string-ci=?", args, env)
+      Lisp::Boolean.with_value(str1.downcase == str2.downcase)
+    end
+
+
+    def self.substring_ci_eq_impl(args, env)
+      substr1, substr2 = extract_substrings("substring-ci=?", args, env)
+      Lisp::Boolean.with_value(substr1.downcase == substr2.downcase)
+    end
+
+
+    def self.string_lt_impl(args, env)
+      str1, str2 = extract_strings("string<?", args, env)
+      Lisp::Boolean.with_value(str1 < str2)
+    end
+
+
+    def self.substring_lt_impl(args, env)
+      substr1, substr2 = extract_substrings("substring<?", args, env)
+      Lisp::Boolean.with_value(substr1 < substr2)
+    end
+
+
+    def self.string_ci_lt_impl(args, env)
+      str1, str2 = extract_strings("string-ci<?", args, env)
+      Lisp::Boolean.with_value(str1.downcase < str2.downcase)
+    end
+
+
+    def self.substring_ci_lt_impl(args, env)
+      substr1, substr2 = extract_substrings("substring-ci<?", args, env)
+      Lisp::Boolean.with_value(substr1.downcase < substr2.downcase)
+    end
+
+    
+    def self.string_gt_impl(args, env)
+      str1, str2 = extract_strings("string>?", args, env)
+      Lisp::Boolean.with_value(str1 > str2)
+    end
+
+
+    def self.substring_gt_impl(args, env)
+      substr1, substr2 = extract_substrings("substring>?", args, env)
+      Lisp::Boolean.with_value(substr1 > substr2)
+    end
+
+
+    def self.string_ci_gt_impl(args, env)
+      str1, str2 = extract_strings("string-ci>?", args, env)
+      Lisp::Boolean.with_value(str1.downcase > str2.downcase)
+    end
+
+
+    def self.substring_ci_gt_impl(args, env)
+      substr1, substr2 = extract_substrings("substring-ci>?", args, env)
+      Lisp::Boolean.with_value(substr1.downcase > substr2.downcase)
+    end
+
+    
+    def self.string_lte_impl(args, env)
+      str1, str2 = extract_strings("string<=?", args, env)
+      Lisp::Boolean.with_value(str1 <= str2)
+    end
+
+
+    def self.substring_lte_impl(args, env)
+      substr1, substr2 = extract_substrings("substring<=?", args, env)
+      Lisp::Boolean.with_value(substr1 <= substr2)
+    end
+
+
+    def self.string_ci_lte_impl(args, env)
+      str1, str2 = extract_strings("string-ci<=?", args, env)
+      Lisp::Boolean.with_value(str1.downcase <= str2.downcase)
+    end
+
+
+    def self.substring_ci_lte_impl(args, env)
+      substr1, substr2 = extract_substrings("substring-ci<=?", args, env)
+      Lisp::Boolean.with_value(substr1.downcase <= substr2.downcase)
+    end
+
+    
+    def self.string_gte_impl(args, env)
+      str1, str2 = extract_strings("string>=?", args, env)
+      Lisp::Boolean.with_value(str1 >= str2)
+    end
+
+
+    def self.substring_gte_impl(args, env)
+      substr1, substr2 = extract_substrings("substring>=?", args, env)
+      Lisp::Boolean.with_value(substr1 >= substr2)
+    end
+
+
+    def self.string_ci_gte_impl(args, env)
+      str1, str2 = extract_strings("string-ci>=?", args, env)
+      Lisp::Boolean.with_value(str1.downcase >= str2.downcase)
+    end
+
+
+    def self.substring_ci_gte_impl(args, env)
+      substr1, substr2 = extract_substrings("substring-ci>=?", args, env)
+      Lisp::Boolean.with_value(substr1.downcase >= substr2.downcase)
+    end
+
+    
+    def self.string_compare_impl(args, env)
+      raise "string-compare requires 5 arguments, but received #{args.length}" unless args.length == 5
+      str1 = get_string("string-compare", args.nth(1).evaluate(env))
+      str2 = get_string("string-compare", args.nth(2).evaluate(env))
+      f_number = case str1 <=> str2
+                 when -1
+                   4
+                 when 0
+                   3
+                 when 1
+                   5
+                 end
+      f = args.nth(f_number).evaluate(env)
+      raise "string-compare requires functions for argument #{f_number}, but received #{f}" unless f.function?
+      f.apply_to(Lisp::ConsCell.cons, env)
+    end
+
+
+    def self.string_compare_ci_impl(args, env)
+      raise "string-compare-ci requires 5 arguments, but received #{args.length}" unless args.length == 5
+      str1 = get_string("string-compare-ci", args.nth(1).evaluate(env))
+      str2 = get_string("string-compare-ci", args.nth(2).evaluate(env))
+      f_number = case str1.downcase <=> str2.downcase
+                 when -1
+                   4
+                 when 0
+                   3
+                 when 1
+                   5
+                 end
+      f = args.nth(f_number).evaluate(env)
+      raise "string-compare-ci requires functions for argument #{f_number}, but received #{f}" unless f.function?
+      f.apply_to(Lisp::ConsCell.cons, env)
+    end
+
+
+    def self.string_hash_impl(args, env)
+      str = get_string("string-hash", args.nth(1).evaluate(env))
+      Lisp::Number.with_value(str.hash)
+    end
+
+
+    def self.string_hash_mod_impl(args, env)
+      str = get_string("string-hash-mod", args.nth(1).evaluate(env))
+      k_arg = args.cadr.evaluate(env)
+      raise "string-hash-mod requires it's second argument to be an integer, but received #{k_arg}" unless k_arg.integer?
+      k = k_arg.value
+      Lisp::Number.with_value(str.hash % k)
+    end
+
+
+    # str is assumed to be a single word
+    def self.uppercase?(str)
+      (str =~ /^[[:upper:]]*$/) == 0
+    end
+    
+
+    def self.lowercase?(str)
+      (str =~ /^[[:lower:]]*$/) == 0
+    end
+    
+
+    def self.capitalized?(str)
+      first = str[0]
+      rest = str[1..-1]
+      return false unless first =~ /[[:upper:]]/
+      lowercase?(rest)
+    end
+
+
+    def self.split_into_words(str)
+      str.split(/[^[[:alpha:]]]+/)
+    end
+    
+
+    def self.string_capitalizedp_impl(args, env)
+      str = get_string("string-capitalized?", args.nth(1).evaluate(env))
+      words = split_into_words(str)
+      Lisp::Boolean.with_value(capitalized?(words[0])&& words[1..-1].all? {|w| capitalized?(w) || lowercase?(w)})
+    end
+
+
+    def self.substring_capitalizedp_impl(args, env)
+      str = get_substring("substring-capitalized?", args.nth(1).evaluate(env), args.nth(2).evaluate(env), args.nth(3).evaluate(env))
+      words = split_into_words(str)
+      Lisp::Boolean.with_value(capitalized?(words[0]) && words[1..-1].all? {|w| capitalized?(w) || lowercase?(w)})
+    end
+
+
+    def self.string_upperp_impl(args, env)
+      str = get_string("string-upper-case?", args.nth(1).evaluate(env))
+      words = split_into_words(str)
+      Lisp::Boolean.with_value(words.all? {|w| uppercase?(w)})
+    end
+
+
+    def self.substring_upperp_impl(args, env)
+      str = get_substring("substring-upper-case?", args.nth(1).evaluate(env), args.nth(2).evaluate(env), args.nth(3).evaluate(env))
+      words = split_into_words(str)
+      Lisp::Boolean.with_value(words.all? {|w| uppercase?(w)})
+    end
+
+
+    def self.string_lowerp_impl(args, env)
+      str = get_string("string-lower-case?", args.nth(1).evaluate(env))
+      words = split_into_words(str)
+      Lisp::Boolean.with_value(words.all? {|w| lowercase?(w)})
+    end
+
+
+    def self.substring_lowerp_impl(args, env)
+      str = get_substring("substring-lower-case?", args.nth(1).evaluate(env), args.nth(2).evaluate(env), args.nth(3).evaluate(env))
+      words = split_into_words(str)
+      Lisp::Boolean.with_value(words.all? {|w| lowercase?(w)})
+    end
+
+
+    def self.capitalize_string(str)
+      saw_first = false
+      str.chars.map do |c|
+        if c =~ /[[:alpha:]]/
+          if saw_first
+            c.downcase
+          else
+            saw_first = true
+            c.upcase
+          end
+        else
+          c
+        end
+      end
+    end
+
+    def self.string_capitalize_impl(args, env)
+      str = get_string("string-capitalize", args.nth(1).evaluate(env))
+      new_chars = capitalize_string(str)
+      new_str = ""
+      new_chars.each {|c| new_str << c}
+      self.with_value(new_str)
+    end
+
+
+    def self.string_capitalize_bang_impl(args, env)
+      raise "string-capitalize! requires 1 argument, but received #{args.length}" unless args.length == 1
+      str = args.nth(1).evaluate(env)
+      raise "string-capitalize! requires a string, but received #{str}" unless str.string?
+      new_chars = capitalize_string(str.value)
+      new_str = ""
+      new_chars.each {|c| new_str << c}
+      str.set!(new_str)
+      str
+    end
+
+
+    def self.substring_capitalize_bang_impl(args, env)
+      raise "substring-capitalize! requires 3 arguments, but received #{args.length}" unless args.length == 3
+      s = args.nth(1).evaluate(env)
+      raise "substring-capitalize! requires a string as it's first argument, but received #{s}" unless s.string?
+      str = s.value
+      
+      start_index = args.nth(2).evaluate(env)
+      raise "substring-capitalize! requires an integer start index, but received #{start_index}" unless start_index.integer?
+      si = start_index.value
+      raise "substring-capitalize! received an invalid substring start index: #{si}" if si < 0 || si > str.length
+
+      end_index = args.nth(3).evaluate(env)
+      raise "substring-capitalize! requires an integer end index, but received #{end_index}" unless end_index.integer?
+      ei = end_index.value
+      raise "substring-capitalize! received an invalid substring end index: #{ei}" if ei < 0 || ei > str.length
+
+      prefix = str[0...si]
+      substr = str[si...ei]
+      suffix = str[ei..-1]
+      
+      new_chars = capitalize_string(substr)
+      new_substr = ""   
+      new_chars.each {|c| new_substr << c}
+      s.set!(prefix + new_substr + suffix)
+      s
+    end
+    
+
+    def self.string_downcase_impl(args, env)
+      str = get_string("string-downcase?", args.nth(1).evaluate(env))
+      self.with_value(str.downcase)
+    end
+
+
+    def self.string_downcase_bang_impl(args, env)
+      raise "string-downcase! requires 1 argument, but received #{args.length}" unless args.length == 1
+      str = args.nth(1).evaluate(env)
+      raise "string-downcase! requires a string, but received #{str}" unless str.string?
+      str.set!(str.value.downcase)
+      str
+    end
+
+
+    def self.substring_downcase_bang_impl(args, env)
+      raise "substring-downcase! requires 3 arguments, but received #{args.length}" unless args.length == 3
+      s = args.nth(1).evaluate(env)
+      raise "substring-downcase! requires a string as it's first argument, but received #{s}" unless s.string?
+      str = s.value
+      
+      start_index = args.nth(2).evaluate(env)
+      raise "substring-downcase! requires an integer start index, but received #{start_index}" unless start_index.integer?
+      si = start_index.value
+      raise "substring-downcase! received an invalid substring start index: #{si}" if si < 0 || si > str.length
+
+      end_index = args.nth(3).evaluate(env)
+      raise "substring-downcase! requires an integer end index, but received #{end_index}" unless end_index.integer?
+      ei = end_index.value
+      raise "substring-downcase! received an invalid substring end index: #{ei}" if ei < 0 || ei > str.length
+
+      prefix = str[0...si]
+      substr = str[si...ei]
+      suffix = str[ei..-1]
+      
+      new_chars = capitalize_string(substr)
+      new_substr = ""   
+      new_chars.each {|c| new_substr << c}
+      s.set!(prefix + substr.downcase + suffix)
+      s
+    end
+    
+
+    def self.string_upcase_impl(args, env)
+      str = get_string("string-upcase?", args.nth(1).evaluate(env))
+      self.with_value(str.upcase)
+    end
+
+
+    def self.string_upcase_bang_impl(args, env)
+      raise "string-upcase! requires 1 argument, but received #{args.length}" unless args.length == 1
+      str = args.nth(1).evaluate(env)
+      raise "string-upcase! requires a string, but received #{str}" unless str.string?
+      str.set!(str.value.upcase)
+      str
+    end
+
+
+    def self.substring_upcase_bang_impl(args, env)
+      raise "substring-upcase! requires 3 arguments, but received #{args.length}" unless args.length == 3
+      s = args.nth(1).evaluate(env)
+      raise "substring-upcase! requires a string as it's first argument, but received #{s}" unless s.string?
+      str = s.value
+      
+      start_index = args.nth(2).evaluate(env)
+      raise "substring-upcase! requires an integer start index, but received #{start_index}" unless start_index.integer?
+      si = start_index.value
+      raise "substring-upcase! received an invalid substring start index: #{si}" if si < 0 || si > str.length
+
+      end_index = args.nth(3).evaluate(env)
+      raise "substring-upcase! requires an integer end index, but received #{end_index}" unless end_index.integer?
+      ei = end_index.value
+      raise "substring-upcase! received an invalid substring end index: #{ei}" if ei < 0 || ei > str.length
+
+      prefix = str[0...si]
+      substr = str[si...ei]
+      suffix = str[ei..-1]
+      
+      new_chars = capitalize_string(substr)
+      new_substr = ""   
+      new_chars.each {|c| new_substr << c}
+      s.set!(prefix + substr.upcase + suffix)
+      s
+    end
+
+
+    def self.string_append_impl(args, env)
+      strings = args.to_a.map do |a|
+        s = a.evaluate(env)
+        raise "string-append requires strings, but received #{s}" unless s.string?
+        s.value
+      end
+
+      self.with_value(strings.join)
+    end
+
+
+    def self.substring_impl(args, env)
+      str = get_substring("substring", args.nth(1).evaluate(env), args.nth(2).evaluate(env), args.nth(3).evaluate(env))
+      self.with_value(str)
+    end
+
+
+    def self.string_head_impl(args, env)
+      raise "string-head requires 2 arguments, but received #{args.length}" unless args.length == 2
+      s = args.nth(1).evaluate(env)
+      raise "string-head requires a string as it's first argument, but received #{s}" unless s.string?
+      str = s.value
+      
+      end_index = args.nth(2).evaluate(env)
+      raise "string-head requires an integer end index, but received #{end_index}" unless end_index.integer?
+      ei = end_index.value
+      raise "string-head received an invalid end index: #{ei}" if ei < 0 || ei > str.length
+
+      self.with_value(str[0...ei])
+    end
+
+
+    def self.string_tail_impl(args, env)
+      raise "string-tail requires 2 arguments, but received #{args.length}" unless args.length == 2
+      s = args.nth(1).evaluate(env)
+      raise "string-tail requires a string as it's first argument, but received #{s}" unless s.string?
+      str = s.value
+      
+      start_index = args.nth(2).evaluate(env)
+      raise "string-tail requires an integer start index, but received #{start_index}" unless start_index.integer?
+      si = start_index.value
+      raise "string-tail received an invalid end index: #{si}" if si < 0 || si > str.length
+
+      self.with_value(str[si..-1])
+    end
+
+
+    def self.string_pad_left_impl(args, env)
+      raise "string-pad-left requires 2 or 3 arguments, but received #{args.length}" unless args.length == 2 || args.length == 3
+      s = args.nth(1).evaluate(env)
+      raise "string-pad-left requires a string as it's first argument, but received #{s}" unless s.string?
+      str = s.value
+      
+      size_arg = args.nth(2).evaluate(env)
+      raise "string-pad-left requires an integer size, but received #{size_arg}" unless size_arg.integer?
+      size = size_arg.value
+      raise "string-pad-left received an invalid size: #{size}" if size < 0
+
+      padding_char = if args.length == 3
+                       ch_arg = args.nth(3).evaluate(env)
+                       raise "string-pad-left requires a character pad, but received #{ch_arg}" unless ch_arg.character?
+                       ch_arg.value
+                     else
+                       " "
+                     end
+        
+      
+      new_str = if size > str.length
+                  padding = size - str.length
+                  pad = ""
+                  padding.times {|i| pad << padding_char}
+                  pad + str
+                else
+                  start = str.length - size
+                  str[start..-1]
+                end
+      self.with_value(new_str)
+    end
+
+
+    def self.string_pad_right_impl(args, env)
+      raise "string-pad-right requires 2 or 3 arguments, but received #{args.length}" unless args.length == 2 || args.length == 3
+      s = args.nth(1).evaluate(env)
+      raise "string-pad-right requires a string as it's first argument, but received #{s}" unless s.string?
+      str = s.value
+      
+      size_arg = args.nth(2).evaluate(env)
+      raise "string-pad-right requires an integer size, but received #{size_arg}" unless size_arg.integer?
+      size = size_arg.value
+      raise "string-pad-right received an invalid size: #{size}" if size < 0
+
+      padding_char = if args.length == 3
+                       ch_arg = args.nth(3).evaluate(env)
+                       raise "string-pad-right requires a character pad, but received #{ch_arg}" unless ch_arg.character?
+                       ch_arg.value
+                     else
+                       " "
+                     end
+        
+      
+      new_str = if size > str.length
+                  padding = size - str.length
+                  pad = ""
+                  padding.times {|i| pad << padding_char}
+                  str + pad
+                else
+                  last = str.length - size
+                  str[0...4]
+                end
+      self.with_value(new_str)
+    end
+
+
+    def self.string_trim_impl(args, env)
+      raise "string-trim requires 1 or 2 arguments, but received #{args.length}" unless args.length == 1 || args.length == 2
+      s1 = args.nth(1).evaluate(env)
+      raise "string-trim requires a string as it's first argument, but received #{s1}" unless s1.string?
+      str = s1.value
+
+      pattern = Regexp.new(if args.length == 2
+                             s2 = args.nth(2).evaluate(env)
+                             raise "string-trim requires a string as it's second argument, but received #{s2}" unless s2.string?
+                             s2.value
+                           else
+                             "[[:graph:]]"
+                           end)
+
+      
+      left_i = 0
+      while pattern.match(str[left_i]).nil? && left_i < str.length
+        left_i += 1
+      end
+      
+      right_i = str.length - 1
+      while pattern.match(str[right_i]).nil? && right_i >= 0
+        right_i -= 1
+      end
+      
+      self.with_value(str[left_i..right_i])
+    end
+
+
+    def self.string_trim_left_impl(args, env)
+      raise "string-trim-left requires 1 or 2 arguments, but received #{args.length}" unless args.length == 1 || args.length == 2
+      s1 = args.nth(1).evaluate(env)
+      raise "string-trim-left requires a string as it's first argument, but received #{s1}" unless s1.string?
+      str = s1.value
+
+      pattern = Regexp.new(if args.length == 2
+                             s2 = args.nth(2).evaluate(env)
+                             raise "string-trim-left requires a string as it's second argument, but received #{s2}" unless s2.string?
+                             s2.value
+                           else
+                             "[[:graph:]]"
+                           end)
+
+      
+      left_i = 0
+      while pattern.match(str[left_i]).nil? && left_i < str.length
+        left_i += 1
+      end
+      
+      self.with_value(str[left_i..-1])
+    end
+
+
+    def self.string_trim_right_impl(args, env)
+      raise "string-trim-right requires 1 or 2 arguments, but received #{args.length}" unless args.length == 1 || args.length == 2
+      s1 = args.nth(1).evaluate(env)
+      raise "string-trim-right requires a string as it's first argument, but received #{s1}" unless s1.string?
+      str = s1.value
+
+      pattern = Regexp.new(if args.length == 2
+                             s2 = args.nth(2).evaluate(env)
+                             raise "string-trim-right requires a string as it's second argument, but received #{s2}" unless s2.string?
+                             s2.value
+                           else
+                             "[[:graph:]]"
+                           end)
+
+      right_i = str.length - 1
+      while pattern.match(str[right_i]).nil? && right_i >= 0
+        right_i -= 1
+      end
+      
+      self.with_value(str[0..right_i])
+    end
+
+
+    # --------------------------------------------------------------------------------
+    
+    def self.with_value(n)
+      self.new(n)
+    end
+
+    def initialize(n = '')
+      @value = n.to_s
+    end
+
+    def set!(n)
+      @value = n.to_s
+    end
+
+    def string?
+      true
+    end
+
+    def type
+      :string
+    end
+
+    def to_s
+      @value
+    end
+
+    def to_sym
+      @value.to_sym
+    end
+    
+    def print_string
+      "\"#{@value}\""
+    end
+  end
+
+end