chervil/lib/chervil/core.rb

module Chervil
  module Core
    def self.compare_pairs(ary, method)
      pairs = Array.new
      ary.each_with_index do |el, i|
        unless ary[i + 1].nil?
          pairs.push([el, ary[i + 1]])
        end
      end

      !(pairs.map { |pair| pair[0].send(method, pair[1]) }.any?(false))
    end

    def self.display_class_name(cls)
      case cls.inspect
      when "Float"
        "number"
      when "Array"
        "list"
      when "String"
        "string"
      end
    end

    def self.type_check(args, cls)
      args_with_wrong_type = args.select { |arg| !arg.is_a?(cls) }

      if args_with_wrong_type.length.zero?
        nil
      else
        expected_type = display_class_name(cls)
        received_type = display_class_name(args_with_wrong_type.first.class)
        ::Chervil::Error.new("Expected an argument of type #{expected_type} but got #{received_type}")
      end
    end

    def self.arity_check(args, expected_count)
      if args.size != expected_count
        s = expected_count == 1 ? '' : 's'
        Error.new("Expected #{expected_count} argument#{s} but received #{args.size}")
      else
        nil
      end
    end

    def self.eval(source, env)
      lexer = Lexer.new(source)
      tree = Parser.new(lexer).parse

      if tree.is_a?(Error)
        return tree
      end

      interpreter = Interpreter.new(tree, env)
      interpreter.interpret.first
    end

    CORE = {
      "+" => Proc.new { |args| type_check(args, Float) || args.inject(:+) },
      "-" => Proc.new { |args| type_check(args, Float) || args.inject(:-) },
      "*" => Proc.new { |args| type_check(args, Float) || args.inject(:*) },
      "/" => Proc.new { |args| type_check(args, Float) || args.inject(:/) },
      "=" => Proc.new { |args| compare_pairs(args, :==) },
      "<" => Proc.new { |args| type_check(args, Float) || compare_pairs(args, :<) },
      ">" => Proc.new { |args| type_check(args, Float) || compare_pairs(args, :>) },
      "<=" => Proc.new { |args| type_check(args, Float) || compare_pairs(args, :<=) },
      ">=" => Proc.new { |args| type_check(args, Float) || compare_pairs(args, :>=) },
      "and" => Proc.new { |args| !(args.include?(false)) },
      "or" => Proc.new { |args| args.any? { |arg| !!arg == true } },
      "not" => Proc.new do |args|
        error = arity_check(args, 1)
        if error.nil?
          args.first == false ? true : false
        else
          error
        end
      end,
      "car" => Proc.new do |args|
        error = arity_check(args, 1)
        if error.nil?
          error = type_check(args, Array)
          if error.nil?
            if args.first.empty?
              Error.new("`car` expects a non-empty list")
            else
              args.first.first
            end
          else
            error
          end
        else
          error
        end
      end,
      "cdr" => Proc.new do |args|
        error = arity_check(args, 1)
        if error.nil?
          error = type_check(args, Array)
          if error.nil?
            args.first[1..-1]
          else
            error
          end
        else
          error
        end
      end,
      "cons" => Proc.new do |args|
        error = arity_check(args, 2)
        if error.nil?
          el, els = args
          error = type_check([els], Array)
          if error.nil?
            els.prepend(el)
          end
        end
      end,
    }

    NATIVE_CORE = {
      "map" => "(define (map f xs) (if (= xs '()) '() (cons (f (car xs)) (map f (cdr xs)))))"
    }
  end
end