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