commit 7fd4ac01853765d8f41fcb8dd38ef5b933f21a0e Author: rhysd Date: Thu Jun 4 00:35:19 2015 +0900 import from my Mal implementation diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..d1f2bed --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +.crystal diff --git a/src/core.cr b/src/core.cr new file mode 100644 index 0000000..15f870d --- /dev/null +++ b/src/core.cr @@ -0,0 +1,413 @@ +require "time" + +require "./types" +require "./error" +require "./printer" +require "./reader" +require "./readline" + +module Mal + +macro calc_op(op) + -> (args : Array(Mal::Type)) { + x, y = args[0].unwrap, args[1].unwrap + eval_error "invalid arguments for binary operator {{op.id}}" unless x.is_a?(Int32) && y.is_a?(Int32) + Mal::Type.new(x {{op.id}} y) + } +end + +def self.list(args) + args.to_mal +end + +def self.list?(args) + args.first.unwrap.is_a? Mal::List +end + +def self.empty?(args) + a = args.first.unwrap + a.is_a?(Array) ? a.empty? : false +end + +def self.count(args) + a = args.first.unwrap + case a + when Array + a.size as Int32 + when Nil + 0 + else + eval_error "invalid argument for function 'count'" + end +end + +def self.pr_str_(args) + args.map{|a| pr_str(a)}.join(" ") +end + +def self.str(args) + args.map{|a| pr_str(a, false)}.join +end + +def self.prn(args) + puts self.pr_str_(args) + nil +end + +def self.println(args) + puts args.map{|a| pr_str(a, false)}.join(" ") + nil +end + +def self.read_string(args) + head = args.first.unwrap + eval_error "argument of read-str must be string" unless head.is_a? String + read_str head +end + +def self.slurp(args) + head = args.first.unwrap + eval_error "argument of slurp must be string" unless head.is_a? String + begin + File.read head + rescue e : Errno + eval_error "no such file" + end +end + +def self.cons(args) + head, tail = args[0] as Mal::Type, args[1].unwrap + eval_error "2nd arg of cons must be list" unless tail.is_a? Array + ([head] + tail).to_mal +end + +def self.concat(args) + args.each_with_object(Mal::List.new) do |arg, list| + a = arg.unwrap + eval_error "arguments of concat must be list" unless a.is_a?(Array) + a.each{|e| list << e} + end +end + +def self.nth(args) + a0, a1 = args[0].unwrap, args[1].unwrap + eval_error "1st argument of nth must be list or vector" unless a0.is_a? Array + eval_error "2nd argument of nth must be integer" unless a1.is_a? Int32 + a0[a1] +end + +def self.first(args) + a0 = args[0].unwrap + + return nil if a0.nil? + eval_error "1st argument of first must be list or vector or nil" unless a0.is_a? Array + a0.empty? ? nil : a0.first +end + +def self.rest(args) + a0 = args[0].unwrap + + return Mal::List.new if a0.nil? + eval_error "1st argument of first must be list or vector or nil" unless a0.is_a? Array + return Mal::List.new if a0.empty? + a0[1..-1].to_mal +end + +def self.apply(args) + eval_error "apply must take at least 2 arguments" unless args.size >= 2 + + head = args.first.unwrap + last = args.last.unwrap + + eval_error "last argument of apply must be list or vector" unless last.is_a? Array + + case head + when Mal::Closure + head.fn.call(args[1..-2] + last) + when Mal::Func + head.call(args[1..-2] + last) + else + eval_error "1st argument of apply must be function or closure" + end +end + +def self.map(args) + func = args.first.unwrap + list = args[1].unwrap + + eval_error "2nd argument of map must be list or vector" unless list.is_a? Array + + f = case func + when Mal::Closure then func.fn + when Mal::Func then func + else eval_error "1st argument of map must be function" + end + + list.each_with_object(Mal::List.new) do |elem, mapped| + mapped << f.call([elem]) + end +end + +def self.nil?(args) + args.first.unwrap.nil? +end + +def self.true?(args) + a = args.first.unwrap + a.is_a?(Bool) && a +end + +def self.false?(args) + a = args.first.unwrap + a.is_a?(Bool) && !a +end + +def self.symbol?(args) + args.first.unwrap.is_a?(Mal::Symbol) +end + +def self.symbol(args) + head = args.first.unwrap + eval_error "1st argument of symbol function must be string" unless head.is_a? String + Mal::Symbol.new head +end + +def self.keyword(args) + head = args.first.unwrap + eval_error "1st argument of symbol function must be string" unless head.is_a? String + "\u029e" + head +end + +def self.keyword?(args) + head = args.first.unwrap + head.is_a?(String) && !head.empty? && head[0] == '\u029e' +end + +def self.vector(args) + args.to_mal(Mal::Vector) +end + +def self.vector?(args) + args.first.unwrap.is_a? Mal::Vector +end + +def self.hash_map(args) + eval_error "hash-map must take even number of arguments" unless args.size.even? + map = Mal::HashMap.new + args.each_slice(2) do |kv| + k = kv[0].unwrap + eval_error "key must be string" unless k.is_a? String + map[k] = kv[1] + end + map +end + +def self.map?(args) + args.first.unwrap.is_a? Mal::HashMap +end + +def self.assoc(args) + head = args.first.unwrap + eval_error "1st argument of assoc must be hashmap" unless head.is_a? Mal::HashMap + eval_error "assoc must take a list and even number of arguments" unless (args.size - 1).even? + + map = Mal::HashMap.new + head.each{|k, v| map[k] = v} + + args[1..-1].each_slice(2) do |kv| + k = kv[0].unwrap + eval_error "key must be string" unless k.is_a? String + map[k] = kv[1] + end + + map +end + +def self.dissoc(args) + head = args.first.unwrap + eval_error "1st argument of assoc must be hashmap" unless head.is_a? Mal::HashMap + + map = Mal::HashMap.new + head.each{|k,v| map[k] = v} + + args[1..-1].each do |arg| + key = arg.unwrap + eval_error "key must be string" unless key.is_a? String + map.delete key + end + + map +end + +def self.get(args) + a0, a1 = args[0].unwrap, args[1].unwrap + return nil unless a0.is_a? Mal::HashMap + eval_error "2nd argument of get must be string" unless a1.is_a? String + + # a0[a1]? isn't available because type ofa0[a1] is infered NoReturn + a0.has_key?(a1) ? a0[a1] : nil +end + +def self.contains?(args) + a0, a1 = args[0].unwrap, args[1].unwrap + eval_error "1st argument of get must be hashmap" unless a0.is_a? Mal::HashMap + eval_error "2nd argument of get must be string" unless a1.is_a? String + a0.has_key? a1 +end + +def self.keys(args) + head = args.first.unwrap + eval_error "1st argument of assoc must be hashmap" unless head.is_a? Mal::HashMap + head.keys.each_with_object(Mal::List.new){|e,l| l << Mal::Type.new(e)} +end + +def self.vals(args) + head = args.first.unwrap + eval_error "1st argument of assoc must be hashmap" unless head.is_a? Mal::HashMap + head.values.to_mal +end + +def self.sequential?(args) + args.first.unwrap.is_a? Array +end + +def self.readline(args) + head = args.first.unwrap + eval_error "1st argument of readline must be string" unless head.is_a? String + my_readline head +end + +def self.meta(args) + m = args.first.meta + m.nil? ? nil : m +end + +def self.with_meta(args) + t = args.first.dup + t.meta = args[1] + t +end + +def self.atom(args) + Mal::Atom.new args.first +end + +def self.atom?(args) + args.first.unwrap.is_a? Mal::Atom +end + +def self.deref(args) + head = args.first.unwrap + eval_error "1st argument of deref must be atom" unless head.is_a? Mal::Atom + head.val +end + +def self.reset!(args) + head = args.first.unwrap + eval_error "1st argument of reset! must be atom" unless head.is_a? Mal::Atom + head.val = args[1] +end + +def self.swap!(args) + atom = args.first.unwrap + eval_error "1st argument of swap! must be atom" unless atom.is_a? Mal::Atom + + a = [atom.val] + args[2..-1] + + func = args[1].unwrap + case func + when Mal::Func + atom.val = func.call a + when Mal::Closure + atom.val = func.fn.call a + else + eval_error "2nd argumetn of swap! must be function" + end +end + +def self.conj(args) + seq = args.first.unwrap + case seq + when Mal::List + (args[1..-1].reverse + seq).to_mal + when Mal::Vector + (seq + args[1..-1]).to_mal(Mal::Vector) + else + eval_error "1st argument of conj must be list or vector" + end +end + +def self.time_ms(args) + (Time.now.to_i.to_i32) * 1000 +end + +# Note: +# Simply using ->self.some_func doesn't work +macro func(name) + -> (args : Array(Mal::Type)) { Mal::Type.new self.{{name.id}}(args) } +end + +macro rel_op(op) +-> (args : Array(Mal::Type)) { Mal::Type.new (args[0] {{op.id}} args[1]) } +end + +NS = { + "+" => calc_op(:+) + "-" => calc_op(:-) + "*" => calc_op(:*) + "/" => calc_op(:/) + "list" => func(:list) + "list?" => func(:list?) + "empty?" => func(:empty?) + "count" => func(:count) + "=" => rel_op(:==) + "<" => rel_op(:<) + ">" => rel_op(:>) + "<=" => rel_op(:<=) + ">=" => rel_op(:>=) + "pr-str" => func(:pr_str_) + "str" => func(:str) + "prn" => func(:prn) + "println" => func(:println) + "read-string" => func(:read_string) + "slurp" => func(:slurp) + "cons" => func(:cons) + "concat" => func(:concat) + "nth" => func(:nth) + "first" => func(:first) + "rest" => func(:rest) + "throw" => -> (args : Array(Mal::Type)) { raise Mal::RuntimeException.new args[0] } + "apply" => func(:apply) + "map" => func(:map) + "nil?" => func(:nil?) + "true?" => func(:true?) + "false?" => func(:false?) + "symbol?" => func(:symbol?) + "symbol" => func(:symbol) + "keyword" => func(:keyword) + "keyword?" => func(:keyword?) + "vector" => func(:vector) + "vector?" => func(:vector?) + "hash-map" => func(:hash_map) + "map?" => func(:map?) + "assoc" => func(:assoc) + "dissoc" => func(:dissoc) + "get" => func(:get) + "contains?" => func(:contains?) + "keys" => func(:keys) + "vals" => func(:vals) + "sequential?" => func(:sequential?) + "readline" => func(:readline) + "meta" => func(:meta) + "with-meta" => func(:with_meta) + "atom" => func(:atom) + "atom?" => func(:atom?) + "deref" => func(:deref) + "deref" => func(:deref) + "reset!" => func(:reset!) + "swap!" => func(:swap!) + "conj" => func(:conj) + "time-ms" => func(:time_ms) +} of String => Mal::Func + +end diff --git a/src/env.cr b/src/env.cr new file mode 100644 index 0000000..9f38d68 --- /dev/null +++ b/src/env.cr @@ -0,0 +1,68 @@ +require "./types" +require "./error" + +module Mal + + class Env + property data + + def initialize(@outer) + @data = {} of String => Mal::Type + end + + def initialize(@outer, binds, exprs : Array(Mal::Type)) + @data = {} of String => Mal::Type + + eval_error "binds must be list or vector" unless binds.is_a? Array + + # Note: + # Array#zip() can't be used because overload resolution failed + (0...binds.size).each do |idx| + sym = binds[idx].unwrap + eval_error "bind name must be symbol" unless sym.is_a? Mal::Symbol + + if sym.str == "&" + eval_error "missing variable parameter name" if binds.size == idx + next_param = binds[idx+1].unwrap + eval_error "bind name must be symbol" unless next_param.is_a? Mal::Symbol + var_args = Mal::List.new + exprs[idx..-1].each{|e| var_args << e} if idx < exprs.size + @data[next_param.str] = Mal::Type.new var_args + break + end + + @data[sym.str] = exprs[idx] + end + end + + def dump + puts "ENV BEGIN".colorize.red + @data.each do |k, v| + puts " #{k} -> #{print(v)}".colorize.red + end + puts "ENV END".colorize.red + end + + def set(key, value) + @data[key] = value + end + + def find(key) + return self if @data.has_key? key + + o = @outer + if o + o.find key + else + nil + end + end + + def get(key) + e = find key + eval_error "'#{key}' not found" unless e + e.data[key] + end + end + +end diff --git a/src/error.cr b/src/error.cr new file mode 100644 index 0000000..6df309d --- /dev/null +++ b/src/error.cr @@ -0,0 +1,22 @@ +module Mal + class ParseException < Exception + end + + class EvalException < Exception + end + + class RuntimeException < Exception + getter :thrown + def initialize(@thrown) + super() + end + end +end + +def eval_error(msg) + raise Mal::EvalException.new msg +end + +def parse_error(msg) + raise Mal::ParseException.new msg +end diff --git a/src/printer.cr b/src/printer.cr new file mode 100644 index 0000000..7444cb2 --- /dev/null +++ b/src/printer.cr @@ -0,0 +1,34 @@ +require "./types" + +def pr_str(value, print_readably = true) + case value + when Nil then "nil" + when Bool then value.to_s + when Int32 then value.to_s + when Mal::List then "(#{value.map{|v| pr_str(v, print_readably) as String}.join(" ")})" + when Mal::Vector then "[#{value.map{|v| pr_str(v, print_readably) as String}.join(" ")}]" + when Mal::Symbol then value.str.to_s + when Mal::Func then "" + when Mal::Closure then "" + when Mal::HashMap + # step1_read_print.cr requires specifying type + "{#{value.map{|k, v| "#{pr_str(k, print_readably)} #{pr_str(v, print_readably)}" as String}.join(" ")}}" + when String + case + when value.empty?() + print_readably ? value.inspect : value + when value[0] == '\u029e' + ":#{value[1..-1]}" + else + print_readably ? value.inspect : value + end + when Mal::Atom + "(atom #{pr_str(value.val, print_readably)})" + else + raise "invalid MalType: #{value.to_s}" + end +end + +def pr_str(t : Mal::Type, print_readably = true) + pr_str(t.unwrap, print_readably) + (t.macro? ? " (macro)" : "") +end diff --git a/src/reader.cr b/src/reader.cr new file mode 100644 index 0000000..74a5605 --- /dev/null +++ b/src/reader.cr @@ -0,0 +1,137 @@ +require "./types" +require "./error" + +class Reader + def initialize(@tokens) + @pos = 0 + end + + def current_token + @tokens[@pos] rescue nil + end + + def peek + t = current_token + + if t && t[0] == ';' + @pos += 1 + peek + else + t + end + end + + def next + peek + ensure + @pos += 1 + end + + def read_sequence(init, open, close) + token = self.next + parse_error "expected '#{open}', got EOF" unless token + parse_error "expected '#{open}', got #{token}" unless token[0] == open + + loop do + token = peek + parse_error "expected '#{close}', got EOF" unless token + break if token[0] == close + + init << read_form + peek + end + + self.next + init + end + + def read_list + Mal::Type.new read_sequence(Mal::List.new, '(', ')') + end + + def read_vector + Mal::Type.new read_sequence(Mal::Vector.new, '[', ']') + end + + def read_hashmap + types = read_sequence([] of Mal::Type, '{', '}') + + parse_error "odd number of elements for hash-map: #{types.size}" if types.size.odd? + map = Mal::HashMap.new + + types.each_slice(2) do |kv| + k, v = kv[0].unwrap, kv[1] + case k + when String + map[k] = v + else + parse_error("key of hash-map must be string or keyword") + end + end + + Mal::Type.new map + end + + def read_atom + token = self.next + parse_error "expected Atom but got EOF" unless token + + Mal::Type.new case + when token =~ /^-?\d+$/ then token.to_i + when token == "true" then true + when token == "false" then false + when token == "nil" then nil + when token[0] == '"' then token[1..-2].gsub(/\\"/, "\"") + when token[0] == ':' then "\u029e#{token[1..-1]}" + else Mal::Symbol.new token + end + end + + def list_of(symname) + Mal::List.new << gen_type(Mal::Symbol, symname) << read_form + end + + def read_form + token = peek + + parse_error "unexpected EOF" unless token + parse_error "unexpected comment" if token[0] == ';' + + Mal::Type.new case token + when "(" then read_list + when ")" then parse_error "unexpected ')'" + when "[" then read_vector + when "]" then parse_error "unexpected ']'" + when "{" then read_hashmap + when "}" then parse_error "unexpected '}'" + when "'" then self.next; list_of("quote") + when "`" then self.next; list_of("quasiquote") + when "~" then self.next; list_of("unquote") + when "~@" then self.next; list_of("splice-unquote") + when "@" then self.next; list_of("deref") + when "^" + self.next + meta = read_form + list_of("with-meta") << meta + else read_atom + end + end + +end + +def tokenize(str) + regex = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*)/ + str.scan(regex).map{|m| m[1]}.reject(&.empty?) +end + +def read_str(str) + r = Reader.new(tokenize(str)) + begin + r.read_form + ensure + unless r.peek.nil? + raise Mal::ParseException.new "expected EOF, got #{r.peek.to_s}" + end + end +end + diff --git a/src/readline.cr b/src/readline.cr new file mode 100644 index 0000000..e57099a --- /dev/null +++ b/src/readline.cr @@ -0,0 +1,21 @@ +# Note: +# Crystal already has "readline" library. +# I implemented a subset of it again for practice. + +@[Link("readline")] +lib LibReadline + fun readline(prompt : UInt8*) : UInt8* + fun add_history(line : UInt8*) +end + +def my_readline(prompt = "") + line = LibReadline.readline(prompt) + if line + LibReadline.add_history(line) + String.new(line) + else + nil + end +ensure + LibC.free(line as Void*) if line +end diff --git a/src/step0_repl.cr b/src/step0_repl.cr new file mode 100755 index 0000000..e1fe58a --- /dev/null +++ b/src/step0_repl.cr @@ -0,0 +1,26 @@ +#! /usr/bin/env crystal run + +require "./readline" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +def read(x) + x +end + +def eval(x) + x +end + +def print(x) + x +end + +def rep(x) + read(eval(print(x))) +end + +while line = my_readline("user> ") + puts rep(line) +end diff --git a/src/step1_read_print.cr b/src/step1_read_print.cr new file mode 100755 index 0000000..1f3896d --- /dev/null +++ b/src/step1_read_print.cr @@ -0,0 +1,32 @@ +#! /usr/bin/env crystal run + +require "./readline" +require "./reader" +require "./printer" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +def read(str) + read_str str +end + +def eval(x) + x +end + +def print(result) + pr_str(result, true) +end + +def rep(str) + print(eval(read(str))) +end + +while line = my_readline("user> ") + begin + puts rep(line) + rescue e + STDERR.puts e + end +end diff --git a/src/step2_eval.cr b/src/step2_eval.cr new file mode 100755 index 0000000..a9bf00d --- /dev/null +++ b/src/step2_eval.cr @@ -0,0 +1,90 @@ +#! /usr/bin/env crystal run + +require "./readline" +require "./reader" +require "./printer" +require "./types" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +def eval_error(msg) + raise Mal::EvalException.new msg +end + +def num_func(func) + -> (args : Array(Mal::Type)) { + x, y = args[0].unwrap, args[1].unwrap + eval_error "invalid arguments" unless x.is_a?(Int32) && y.is_a?(Int32) + Mal::Type.new func.call(x, y) + } +end + +$repl_env = { + "+" => num_func(->(x : Int32, y : Int32){ x + y }), + "-" => num_func(->(x : Int32, y : Int32){ x - y }), + "*" => num_func(->(x : Int32, y : Int32){ x * y }), + "/" => num_func(->(x : Int32, y : Int32){ x / y }), +} of String => Mal::Func + +def eval_ast(a, env) + return a.map{|n| eval(n, env) as Mal::Type} if a.is_a? Mal::List + return a unless a + + ast = a.unwrap + case ast + when Mal::Symbol + if env.has_key? ast.str + env[ast.str] + else + eval_error "'#{ast.str}' not found" + end + when Mal::List + ast.each_with_object(Mal::List.new){|n, l| l << eval(n, env)} + when Mal::Vector + ast.each_with_object(Mal::Vector.new){|n, l| l << eval(n, env)} + when Mal::HashMap + ast.each{|k, v| ast[k] = eval(v, env)} + else + ast + end +end + +def read(str) + read_str str +end + +def eval(t, env) + Mal::Type.new case ast = t.unwrap + when Mal::List + eval_error "empty list" if ast.empty? + + f = eval_ast(ast.first, env) + ast.shift(1) + args = eval_ast(ast, env) + + if f.is_a?(Mal::Func) + f.call(args) + else + eval_error "expected function symbol as the first symbol of list" + end + else + eval_ast(t, env) + end +end + +def print(result) + pr_str(result, true) +end + +def rep(str) + print(eval(read(str), $repl_env)) +end + +while line = my_readline("user> ") + begin + puts rep(line) + rescue e + STDERR.puts e + end +end diff --git a/src/step3_env.cr b/src/step3_env.cr new file mode 100755 index 0000000..9c7fc99 --- /dev/null +++ b/src/step3_env.cr @@ -0,0 +1,115 @@ +#! /usr/bin/env crystal run + +require "./readline" +require "./reader" +require "./printer" +require "./types" +require "./env" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +def eval_error(msg) + raise Mal::EvalException.new msg +end + +def num_func(func) + -> (args : Array(Mal::Type)) { + x, y = args[0].unwrap, args[1].unwrap + eval_error "invalid arguments" unless x.is_a?(Int32) && y.is_a?(Int32) + Mal::Type.new func.call(x, y) + } +end + +$repl_env = Mal::Env.new nil +$repl_env.set("+", Mal::Type.new num_func(->(x : Int32, y : Int32){ x + y })) +$repl_env.set("-", Mal::Type.new num_func(->(x : Int32, y : Int32){ x - y })) +$repl_env.set("*", Mal::Type.new num_func(->(x : Int32, y : Int32){ x * y })) +$repl_env.set("/", Mal::Type.new num_func(->(x : Int32, y : Int32){ x / y })) + +def eval_ast(a, env) + return a.map{|n| eval(n, env) } if a.is_a? Array + + Mal::Type.new case ast = a.unwrap + when Mal::Symbol + if e = env.get(ast.str) + e + else + eval_error "'#{ast.str}' not found" + end + when Mal::List + ast.each_with_object(Mal::List.new){|n, l| l << eval(n, env)} + when Mal::Vector + ast.each_with_object(Mal::Vector.new){|n, l| l << eval(n, env)} + when Mal::HashMap + new_map = Mal::HashMap.new + ast.each{|k, v| new_map[k] = eval(v, env)} + new_map + else + ast + end +end + +def read(str) + read_str str +end + +def eval(t, env) + ast = t.unwrap + + return eval_ast(t, env) unless ast.is_a?(Mal::List) + + eval_error "empty list" if ast.empty? + + sym = ast.first.unwrap + eval_error "first element of list must be a symbol" unless sym.is_a?(Mal::Symbol) + + Mal::Type.new case sym.str + when "def!" + eval_error "wrong number of argument for 'def!'" unless ast.size == 3 + a1 = ast[1].unwrap + eval_error "1st argument of 'def!' must be symbol" unless a1.is_a?(Mal::Symbol) + env.set(a1.str, eval(ast[2], env) as Mal::Type) + when "let*" + eval_error "wrong number of argument for 'def!'" unless ast.size == 3 + + bindings = ast[1].unwrap + eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a?(Array) + eval_error "size of binding list must be even" unless bindings.size.even? + + new_env = Mal::Env.new env + bindings.each_slice(2) do |binding| + name, value = binding[0].unwrap, binding[1] + eval_error "name of binding must be specified as symbol" unless name.is_a?(Mal::Symbol) + new_env.set(name.str, eval(value, new_env)) + end + + eval(ast[2], new_env) + else + f = eval_ast(ast.first, env) + ast.shift(1) + args = eval_ast(ast, env) + + if f.is_a?(Mal::Type) && (f2 = f.unwrap).is_a?(Mal::Func) + f2.call(args as Array(Mal::Type)) + else + eval_error "expected function symbol as the first symbol of list" + end + end +end + +def print(result) + pr_str(result, true) +end + +def rep(str) + print(eval(read(str), $repl_env)) +end + +while line = my_readline("user> ") + begin + puts rep(line) + rescue e + STDERR.puts e + end +end diff --git a/src/step4_if_fn_do.cr b/src/step4_if_fn_do.cr new file mode 100755 index 0000000..3dc861c --- /dev/null +++ b/src/step4_if_fn_do.cr @@ -0,0 +1,130 @@ +#! /usr/bin/env crystal run + +require "./readline" +require "./reader" +require "./printer" +require "./types" +require "./env" +require "./core" +require "./error" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +def func_of(env, binds, body) + -> (args : Array(Mal::Type)) { + new_env = Mal::Env.new(env, binds, args) + eval(body, new_env) + } as Mal::Func +end + +def eval_ast(ast, env) + return ast.map{|n| eval(n, env) as Mal::Type} if ast.is_a? Mal::List + + val = ast.unwrap + + Mal::Type.new case val + when Mal::Symbol + if e = env.get(val.str) + e + else + eval_error "'#{val.str}' not found" + end + when Mal::List + val.each_with_object(Mal::List.new){|n, l| l << eval(n, env)} + when Mal::Vector + val.each_with_object(Mal::Vector.new){|n, l| l << eval(n, env)} + when Mal::HashMap + val.each{|k, v| val[k] = eval(v, env)} + val + else + val + end +end + +def eval_invocation(list, env) + f = eval(list.first, env).unwrap + eval_error "expected function symbol as the first symbol of list" unless f.is_a? Mal::Func + f.call eval_ast(list[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, env) +end + +def read(str) + read_str str +end + +def eval(ast, env) + list = ast.unwrap + + return eval_ast(ast, env) unless list.is_a? Mal::List + return gen_type Mal::List if list.empty? + + head = list.first.unwrap + + Mal::Type.new case head + when Mal::Symbol + case head.str + when "def!" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'def!' must be symbol" unless a1.is_a? Mal::Symbol + env.set(a1.str, eval(list[2], env)) + when "let*" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + + bindings = list[1].unwrap + eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array + eval_error "size of binding list must be even" unless bindings.size.even? + + new_env = Mal::Env.new env + bindings.each_slice(2) do |binding| + key, value = binding + name = key.unwrap + eval_error "name of binding must be specified as symbol" unless name.is_a? Mal::Symbol + new_env.set(name.str, eval(value, new_env)) + end + + eval(list[2], new_env) + when "do" + list.shift 1 + eval_ast(list, env).last + when "if" + cond = eval(list[1], env).unwrap + case cond + when Nil + list.size >= 4 ? eval(list[3], env) : nil + when false + list.size >= 4 ? eval(list[3], env) : nil + else + eval(list[2], env) + end + when "fn*" + # Note: + # If writing lambda expression here directly, compiler will fail to infer type of 'list'. (Error 'Nil for empty?') + func_of(env, list[1].unwrap, list[2]) + else + eval_invocation(list, env) + end + else + eval_invocation(list, env) + end +end + +def print(result) + pr_str(result, true) +end + +def rep(str) + print(eval(read(str), $repl_env)) +end + +$repl_env = Mal::Env.new nil +Mal::NS.each{|k,v| $repl_env.set(k, Mal::Type.new(v))} +rep "(def! not (fn* (a) (if a false true)))" + +while line = my_readline("user> ") + begin + puts rep(line) + rescue e + STDERR.puts e + end +end diff --git a/src/step5_tco.cr b/src/step5_tco.cr new file mode 100755 index 0000000..450e399 --- /dev/null +++ b/src/step5_tco.cr @@ -0,0 +1,164 @@ +#! /usr/bin/env crystal run + +require "./readline" +require "./reader" +require "./printer" +require "./types" +require "./env" +require "./core" +require "./error" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +def func_of(env, binds, body) + -> (args : Array(Mal::Type)) { + new_env = Mal::Env.new(env, binds, args) + eval(body, new_env) + } as Mal::Func +end + +def eval_ast(ast, env) + return ast.map{|n| eval(n, env) as Mal::Type} if ast.is_a? Mal::List + + val = ast.unwrap + + Mal::Type.new case val + when Mal::Symbol + if e = env.get(val.str) + e + else + eval_error "'#{val.str}' not found" + end + when Mal::List + val.each_with_object(Mal::List.new){|n, l| l << eval(n, env)} + when Mal::Vector + val.each_with_object(Mal::Vector.new){|n, l| l << eval(n, env)} + when Array(Mal::Type) + val.map{|n| eval(n, env)} + when Mal::HashMap + val.each{|k, v| val[k] = eval(v, env)} + val + else + val + end +end + +def eval_invocation(list, env) + f = eval(list.first, env).unwrap + case f + when Mal::Closure + f.fn.call eval_ast(list[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, env) + when Mal::Func + f.call eval_ast(list[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, env) + else + eval_error "expected function as the first argument" + end +end + +def read(str) + read_str str +end + +macro invoke_list(l) + f = eval({{l}}.first, env).unwrap + args = eval_ast({{l}}[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, env) + case f + when Mal::Closure + ast = f.ast + env = Mal::Env.new(f.env, f.params, args) + next # TCO + when Mal::Func + return f.call args + else + eval_error "expected function as the first argument" + end +end + +def eval(ast, env) + # 'next' in 'do...end' has a bug in crystal 0.7.1 + # https://github.com/manastech/crystal/issues/659 + while true + list = ast.unwrap + + return eval_ast(ast, env) unless list.is_a? Mal::List + return gen_type Mal::List if list.empty? + + head = list.first.unwrap + + unless head.is_a? Mal::Symbol + invoke_list list + end + + return Mal::Type.new case head.str + when "def!" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'def!' must be symbol" unless a1.is_a? Mal::Symbol + env.set(a1.str, eval(list[2], env)) + when "let*" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + + bindings = list[1].unwrap + eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array + eval_error "size of binding list must be even" unless bindings.size.even? + + new_env = Mal::Env.new env + bindings.each_slice(2) do |binding| + key, value = binding + name = key.unwrap + eval_error "name of binding must be specified as symbol" unless name.is_a? Mal::Symbol + new_env.set(name.str, eval(value, new_env)) + end + + ast, env = list[2], new_env + next # TCO + when "do" + if list.empty? + ast = Mal::Type.new nil + next + end + + eval_ast(list[1..-2].each_with_object(Mal::List.new){|i,l| l << i}, env) + ast = list.last + next # TCO + when "if" + ast = unless eval(list[1], env).unwrap + list.size >= 4 ? list[3] : Mal::Type.new(nil) + else + list[2] + end + next # TCO + when "fn*" + # Note: + # If writing lambda expression here directly, compiler will fail to infer type of 'list'. (Error 'Nil for empty?') + params = list[1].unwrap + unless params.is_a?(Mal::List) || params.is_a?(Mal::Vector) + eval_error "'fn*' parameters must be list" + end + Mal::Closure.new(list[2], params, env, func_of(env, list[1].unwrap, list[2])) + else + invoke_list list + end + end +end + +def print(result) + pr_str(result, true) +end + +def rep(str) + print(eval(read(str), $repl_env)) +end + +$repl_env = Mal::Env.new nil +Mal::NS.each{|k,v| $repl_env.set(k, Mal::Type.new(v))} +rep "(def! not (fn* (a) (if a false true)))" + +while line = my_readline("user> ") + begin + puts rep(line) + rescue e + STDERR.puts e + end +end diff --git a/src/step6_file.cr b/src/step6_file.cr new file mode 100755 index 0000000..1ffe493 --- /dev/null +++ b/src/step6_file.cr @@ -0,0 +1,177 @@ +#! /usr/bin/env crystal run + +require "./readline" +require "./reader" +require "./printer" +require "./types" +require "./env" +require "./core" +require "./error" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +def func_of(env, binds, body) + -> (args : Array(Mal::Type)) { + new_env = Mal::Env.new(env, binds, args) + eval(body, new_env) + } as Mal::Func +end + +def eval_ast(ast, env) + return ast.map{|n| eval(n, env) as Mal::Type} if ast.is_a? Mal::List + + val = ast.unwrap + + Mal::Type.new case val + when Mal::Symbol + if e = env.get(val.str) + e + else + eval_error "'#{val.str}' not found" + end + when Mal::List + val.each_with_object(Mal::List.new){|n, l| l << eval(n, env)} + when Mal::Vector + val.each_with_object(Mal::Vector.new){|n, l| l << eval(n, env)} + when Array(Mal::Type) + val.map{|n| eval(n, env)} + when Mal::HashMap + val.each{|k, v| val[k] = eval(v, env)} + val + else + val + end +end + +def eval_invocation(list, env) + f = eval(list.first, env).unwrap + case f + when Mal::Closure + f.fn.call eval_ast(list[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, env) + when Mal::Func + f.call eval_ast(list[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, env) + else + eval_error "expected function as the first argument" + end +end + +def read(str) + read_str str +end + +macro invoke_list(l, env) + f = eval({{l}}.first, {{env}}).unwrap + args = eval_ast({{l}}[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, {{env}}) + case f + when Mal::Closure + ast = f.ast + {{env}} = Mal::Env.new(f.env, f.params, args) + next # TCO + when Mal::Func + return f.call args + else + eval_error "expected function as the first argument" + end +end + +def eval(ast, env) + # 'next' in 'do...end' has a bug in crystal 0.7.1 + # https://github.com/manastech/crystal/issues/659 + while true + list = ast.unwrap + + return eval_ast(ast, env) unless list.is_a? Mal::List + return gen_type Mal::List if list.empty? + + head = list.first.unwrap + + unless head.is_a? Mal::Symbol + invoke_list(list, env) + end + + return Mal::Type.new case head.str + when "def!" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'def!' must be symbol" unless a1.is_a? Mal::Symbol + env.set(a1.str, eval(list[2], env)) + when "let*" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + + bindings = list[1].unwrap + eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array + eval_error "size of binding list must be even" unless bindings.size.even? + + new_env = Mal::Env.new env + bindings.each_slice(2) do |binding| + key, value = binding + name = key.unwrap + eval_error "name of binding must be specified as symbol" unless name.is_a? Mal::Symbol + new_env.set(name.str, eval(value, new_env)) + end + + ast, env = list[2], new_env + next # TCO + when "do" + if list.empty? + ast = Mal::Type.new nil + next + end + + eval_ast(list[1..-2].each_with_object(Mal::List.new){|i,l| l << i}, env) + ast = list.last + next # TCO + when "if" + ast = unless eval(list[1], env).unwrap + list.size >= 4 ? list[3] : Mal::Type.new(nil) + else + list[2] + end + next # TCO + when "fn*" + params = list[1].unwrap + unless params.is_a?(Mal::List) || params.is_a?(Mal::Vector) + eval_error "'fn*' parameters must be list" + end + Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) + else + invoke_list(list, env) + end + end +end + +def print(result) + pr_str(result, true) +end + +def rep(str) + print(eval(read(str), $repl_env)) +end + +$repl_env = Mal::Env.new nil +Mal::NS.each{|k,v| $repl_env.set(k, Mal::Type.new(v))} +$repl_env.set("eval", Mal::Type.new -> (args: Array(Mal::Type)){ eval(args[0], $repl_env) }) +rep "(def! not (fn* (a) (if a false true)))" +rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" +$argv = Mal::List.new +$repl_env.set("*ARGV*", Mal::Type.new $argv) + +unless ARGV.empty? + if ARGV.size > 1 + ARGV[1..-1].each do |a| + $argv << Mal::Type.new(a) + end + end + + rep "(load-file \"#{ARGV[0]}\")" + exit +end + +while line = my_readline("user> ") + begin + puts rep(line) + rescue e + STDERR.puts e + end +end diff --git a/src/step7_quote.cr b/src/step7_quote.cr new file mode 100755 index 0000000..2c43818 --- /dev/null +++ b/src/step7_quote.cr @@ -0,0 +1,207 @@ +#! /usr/bin/env crystal run + +require "./readline" +require "./reader" +require "./printer" +require "./types" +require "./env" +require "./core" +require "./error" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +def func_of(env, binds, body) + -> (args : Array(Mal::Type)) { + new_env = Mal::Env.new(env, binds, args) + eval(body, new_env) + } as Mal::Func +end + +def eval_ast(ast, env) + return ast.map{|n| eval(n, env) as Mal::Type} if ast.is_a? Mal::List + + val = ast.unwrap + + Mal::Type.new case val + when Mal::Symbol + if e = env.get(val.str) + e + else + eval_error "'#{val.str}' not found" + end + when Mal::List + val.each_with_object(Mal::List.new){|n, l| l << eval(n, env)} + when Mal::Vector + val.each_with_object(Mal::Vector.new){|n, l| l << eval(n, env)} + when Array(Mal::Type) + val.map{|n| eval(n, env)} + when Mal::HashMap + val.each{|k, v| val[k] = eval(v, env)} + val + else + val + end +end + +def read(str) + read_str str +end + +macro is_pair(list) + {{list}}.is_a?(Array) && !{{list}}.empty? +end + +def quasiquote(ast) + list = ast.unwrap + + unless is_pair(list) + return Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "quote") << ast + ) + end + + head = list.first.unwrap + + case + # ("unquote" ...) + when head.is_a?(Mal::Symbol) && head.str == "unquote" + list[1] + # (("splice-unquote" ...) ...) + when is_pair(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote" + tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new){|e,l| l << e} + Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail) + ) + else + tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new){|e,l| l << e} + Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail) + ) + end +end + +macro invoke_list(l, env) + f = eval({{l}}.first, {{env}}).unwrap + args = eval_ast({{l}}[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, {{env}}) + case f + when Mal::Closure + ast = f.ast + {{env}} = Mal::Env.new(f.env, f.params, args) + next # TCO + when Mal::Func + return f.call args + else + eval_error "expected function as the first argument" + end +end + +def eval(ast, env) + # 'next' in 'do...end' has a bug in crystal 0.7.1 + # https://github.com/manastech/crystal/issues/659 + while true + list = ast.unwrap + + return eval_ast(ast, env) unless list.is_a? Mal::List + return gen_type Mal::List if list.empty? + + head = list.first.unwrap + + unless head.is_a? Mal::Symbol + return invoke_list(list, env) + end + + return Mal::Type.new case head.str + when "def!" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'def!' must be symbol" unless a1.is_a? Mal::Symbol + env.set(a1.str, eval(list[2], env)) + when "let*" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + + bindings = list[1].unwrap + eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array + eval_error "size of binding list must be even" unless bindings.size.even? + + new_env = Mal::Env.new env + bindings.each_slice(2) do |binding| + key, value = binding + name = key.unwrap + eval_error "name of binding must be specified as symbol" unless name.is_a? Mal::Symbol + new_env.set(name.str, eval(value, new_env)) + end + + ast, env = list[2], new_env + next # TCO + when "do" + if list.empty? + ast = Mal::Type.new nil + next + end + + eval_ast(list[1..-2].each_with_object(Mal::List.new){|i,l| l << i}, env) + ast = list.last + next # TCO + when "if" + ast = unless eval(list[1], env).unwrap + list.size >= 4 ? list[3] : Mal::Type.new(nil) + else + list[2] + end + next # TCO + when "fn*" + params = list[1].unwrap + unless params.is_a?(Mal::List) || params.is_a?(Mal::Vector) + eval_error "'fn*' parameters must be list" + end + Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) + when "quote" + list[1] + when "quasiquote" + ast = quasiquote list[1] + next # TCO + else + invoke_list(list, env) + end + end +end + +def print(result) + pr_str(result, true) +end + +def rep(str) + print(eval(read(str), $repl_env)) +end + +$repl_env = Mal::Env.new nil +Mal::NS.each{|k,v| $repl_env.set(k, Mal::Type.new(v))} +$repl_env.set("eval", Mal::Type.new -> (args: Array(Mal::Type)){ eval(args[0], $repl_env) }) +rep "(def! not (fn* (a) (if a false true)))" +rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" +$argv = Mal::List.new +$repl_env.set("*ARGV*", Mal::Type.new $argv) + +unless ARGV.empty? + if ARGV.size > 1 + ARGV[1..-1].each do |a| + $argv << Mal::Type.new(a) + end + end + + begin + rep "(load-file \"#{ARGV[0]}\")" + rescue e + STDERR.puts e + end + exit +end + +while line = my_readline("user> ") + begin + puts rep(line) + rescue e + STDERR.puts e + end +end diff --git a/src/step8_macros.cr b/src/step8_macros.cr new file mode 100755 index 0000000..73f1470 --- /dev/null +++ b/src/step8_macros.cr @@ -0,0 +1,253 @@ +#! /usr/bin/env crystal run + +require "./readline" +require "./reader" +require "./printer" +require "./types" +require "./env" +require "./core" +require "./error" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +def func_of(env, binds, body) + -> (args : Array(Mal::Type)) { + new_env = Mal::Env.new(env, binds, args) + eval(body, new_env) + } as Mal::Func +end + +def eval_ast(ast, env) + return ast.map{|n| eval(n, env) as Mal::Type} if ast.is_a? Mal::List + + val = ast.unwrap + + Mal::Type.new case val + when Mal::Symbol + if e = env.get(val.str) + e + else + eval_error "'#{val.str}' not found" + end + when Mal::List + val.each_with_object(Mal::List.new){|n, l| l << eval(n, env)} + when Mal::Vector + val.each_with_object(Mal::Vector.new){|n, l| l << eval(n, env)} + when Array(Mal::Type) + val.map{|n| eval(n, env)} + when Mal::HashMap + val.each{|k, v| val[k] = eval(v, env)} + val + else + val + end +end + +def read(str) + read_str str +end + +macro pair?(list) + {{list}}.is_a?(Array) && !{{list}}.empty? +end + +def quasiquote(ast) + list = ast.unwrap + + unless pair?(list) + return Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "quote") << ast + ) + end + + head = list.first.unwrap + + case + # ("unquote" ...) + when head.is_a?(Mal::Symbol) && head.str == "unquote" + list[1] + # (("splice-unquote" ...) ...) + when pair?(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote" + tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new){|e,l| l << e} + Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail) + ) + else + tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new){|e,l| l << e} + Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail) + ) + end +end + +def macro_call?(ast, env) + list = ast.unwrap + return false unless list.is_a? Mal::List + + sym = list.first.unwrap + return false unless sym.is_a? Mal::Symbol + + func = env.find(sym.str).try(&.data[sym.str]) + return false unless func && func.macro? + + true +end + +def macroexpand(ast, env) + while macro_call?(ast, env) + + # Already checked in macro_call? + list = ast.unwrap as Mal::List + func_sym = list[0].unwrap as Mal::Symbol + func = env.get(func_sym.str).unwrap + + case func + when Mal::Func + ast = func.call(list[1..-1]) + when Mal::Closure + ast = func.fn.call(list[1..-1]) + else + eval_error "macro '#{func_sym.str}' must be function: #{ast}" + end + end + + ast +end + +macro invoke_list(l, env) + f = eval({{l}}.first, {{env}}).unwrap + args = eval_ast({{l}}[1..-1].each_with_object(Mal::List.new){|i, l| l << i}, {{env}}) + case f + when Mal::Closure + ast = f.ast + {{env}} = Mal::Env.new(f.env, f.params, args) + next # TCO + when Mal::Func + return f.call args + else + eval_error "expected function as the first argument: #{f}" + end +end + +def eval(ast, env) + # 'next' in 'do...end' has a bug in crystal 0.7.1 + # https://github.com/manastech/crystal/issues/659 + while true + return eval_ast(ast, env) unless ast.unwrap.is_a? Mal::List + + ast = macroexpand(ast, env) + + list = ast.unwrap + + return ast unless list.is_a? Mal::List + return ast if list.empty? + + head = list.first.unwrap + + return invoke_list(list, env) unless head.is_a? Mal::Symbol + + return Mal::Type.new case head.str + when "def!" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol + env.set(a1.str, eval(list[2], env)) + when "let*" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + + bindings = list[1].unwrap + eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array + eval_error "size of binding list must be even" unless bindings.size.even? + + new_env = Mal::Env.new env + bindings.each_slice(2) do |binding| + key, value = binding + name = key.unwrap + eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol + new_env.set(name.str, eval(value, new_env)) + end + + ast, env = list[2], new_env + next # TCO + when "do" + if list.empty? + ast = Mal::Type.new nil + next + end + + eval_ast(list[1..-2].each_with_object(Mal::List.new){|i,l| l << i}, env) + ast = list.last + next # TCO + when "if" + ast = unless eval(list[1], env).unwrap + list.size >= 4 ? list[3] : Mal::Type.new(nil) + else + list[2] + end + next # TCO + when "fn*" + params = list[1].unwrap + unless params.is_a? Array + eval_error "'fn*' parameters must be list or vector: #{params}" + end + Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) + when "quote" + list[1] + when "quasiquote" + ast = quasiquote list[1] + next # TCO + when "defmacro!" + eval_error "wrong number of argument for 'defmacro!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'defmacro!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol + env.set(a1.str, eval(list[2], env).tap{|n| n.is_macro = true}) + when "macroexpand" + macroexpand(list[1], env) + else + invoke_list(list, env) + end + end +end + +def print(result) + pr_str(result, true) +end + +def rep(str) + print(eval(read(str), $repl_env)) +end + +$repl_env = Mal::Env.new nil +Mal::NS.each{|k,v| $repl_env.set(k, Mal::Type.new(v))} +$repl_env.set("eval", Mal::Type.new -> (args: Array(Mal::Type)){ eval(args[0], $repl_env) }) +rep "(def! not (fn* (a) (if a false true)))" +rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" +rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" +rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" + +$argv = Mal::List.new +$repl_env.set("*ARGV*", Mal::Type.new $argv) + +unless ARGV.empty? + if ARGV.size > 1 + ARGV[1..-1].each do |a| + $argv << Mal::Type.new(a) + end + end + + begin + rep "(load-file \"#{ARGV[0]}\")" + rescue e + STDERR.puts e + end + exit +end + +while line = my_readline("user> ") + begin + puts rep(line) + rescue e + STDERR.puts e + end +end diff --git a/src/step9_try.cr b/src/step9_try.cr new file mode 100755 index 0000000..3d2c964 --- /dev/null +++ b/src/step9_try.cr @@ -0,0 +1,270 @@ +#! /usr/bin/env crystal run + +require "./readline" +require "./reader" +require "./printer" +require "./types" +require "./env" +require "./core" +require "./error" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +def func_of(env, binds, body) + -> (args : Array(Mal::Type)) { + new_env = Mal::Env.new(env, binds, args) + eval(body, new_env) + } as Mal::Func +end + +def eval_ast(ast, env) + return ast.map{|n| eval(n, env) as Mal::Type} if ast.is_a? Mal::List + + val = ast.unwrap + + Mal::Type.new case val + when Mal::Symbol + if e = env.get(val.str) + e + else + eval_error "'#{val.str}' not found" + end + when Mal::List + val.each_with_object(Mal::List.new){|n, l| l << eval(n, env)} + when Mal::Vector + val.each_with_object(Mal::Vector.new){|n, l| l << eval(n, env)} + when Array(Mal::Type) + val.map{|n| eval(n, env)} + when Mal::HashMap + val.each{|k, v| val[k] = eval(v, env)} + val + else + val + end +end + +def read(str) + read_str str +end + +macro pair?(list) + {{list}}.is_a?(Array) && !{{list}}.empty? +end + +def quasiquote(ast) + list = ast.unwrap + + unless pair?(list) + return Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "quote") << ast + ) + end + + head = list.first.unwrap + + case + # ("unquote" ...) + when head.is_a?(Mal::Symbol) && head.str == "unquote" + list[1] + # (("splice-unquote" ...) ...) + when pair?(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote" + tail = Mal::Type.new list[1..-1].to_mal + Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail) + ) + else + tail = Mal::Type.new list[1..-1].to_mal + Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail) + ) + end +end + +def macro_call?(ast, env) + list = ast.unwrap + return false unless list.is_a? Mal::List + + sym = list.first.unwrap + return false unless sym.is_a? Mal::Symbol + + func = env.find(sym.str).try(&.data[sym.str]) + return false unless func && func.macro? + + true +end + +def macroexpand(ast, env) + while macro_call?(ast, env) + + # Already checked in macro_call? + list = ast.unwrap as Mal::List + func_sym = list[0].unwrap as Mal::Symbol + func = env.get(func_sym.str).unwrap + + case func + when Mal::Func + ast = func.call(list[1..-1]) + when Mal::Closure + ast = func.fn.call(list[1..-1]) + else + eval_error "macro '#{func_sym.str}' must be function: #{ast}" + end + end + + ast +end + +macro invoke_list(l, env) + f = eval({{l}}.first, {{env}}).unwrap + args = eval_ast({{l}}[1..-1].to_mal, {{env}}) + case f + when Mal::Closure + ast = f.ast + {{env}} = Mal::Env.new(f.env, f.params, args) + next # TCO + when Mal::Func + return f.call args + else + eval_error "expected function as the first argument: #{f}" + end +end + +def eval(ast, env) + # 'next' in 'do...end' has a bug in crystal 0.7.1 + # https://github.com/manastech/crystal/issues/659 + while true + return eval_ast(ast, env) unless ast.unwrap.is_a? Mal::List + + ast = macroexpand(ast, env) + + list = ast.unwrap + + return ast unless list.is_a? Mal::List + return ast if list.empty? + + head = list.first.unwrap + + return invoke_list(list, env) unless head.is_a? Mal::Symbol + + return Mal::Type.new case head.str + when "def!" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol + env.set(a1.str, eval(list[2], env)) + when "let*" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + + bindings = list[1].unwrap + eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array + eval_error "size of binding list must be even" unless bindings.size.even? + + new_env = Mal::Env.new env + bindings.each_slice(2) do |binding| + key, value = binding + name = key.unwrap + eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol + new_env.set(name.str, eval(value, new_env)) + end + + ast, env = list[2], new_env + next # TCO + when "do" + if list.empty? + ast = Mal::Type.new nil + next + end + + eval_ast(list[1..-2].to_mal, env) + ast = list.last + next # TCO + when "if" + ast = unless eval(list[1], env).unwrap + list.size >= 4 ? list[3] : Mal::Type.new(nil) + else + list[2] + end + next # TCO + when "fn*" + params = list[1].unwrap + unless params.is_a? Array + eval_error "'fn*' parameters must be list or vector: #{params}" + end + Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) + when "quote" + list[1] + when "quasiquote" + ast = quasiquote list[1] + next # TCO + when "defmacro!" + eval_error "wrong number of argument for 'defmacro!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'defmacro!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol + env.set(a1.str, eval(list[2], env).tap{|n| n.is_macro = true}) + when "macroexpand" + macroexpand(list[1], env) + when "try*" + catch_list = list[2].unwrap + return eval(list[1], env) unless catch_list.is_a? Mal::List + + catch_head = catch_list.first.unwrap + return eval(list[1], env) unless catch_head.is_a? Mal::Symbol + return eval(list[1], env) unless catch_head.str == "catch*" + + begin + eval(list[1], env) + rescue e : Mal::RuntimeException + new_env = Mal::Env.new(env, [catch_list[1]], [e.thrown]) + eval(catch_list[2], new_env) + rescue e + new_env = Mal::Env.new(env, [catch_list[1]], [Mal::Type.new e.message]) + eval(catch_list[2], new_env) + end + else + invoke_list(list, env) + end + end +end + +def print(result) + pr_str(result, true) +end + +def rep(str) + print(eval(read(str), $repl_env)) +end + +$repl_env = Mal::Env.new nil +Mal::NS.each{|k,v| $repl_env.set(k, Mal::Type.new(v))} +$repl_env.set("eval", Mal::Type.new -> (args: Array(Mal::Type)){ eval(args[0], $repl_env) }) +rep "(def! not (fn* (a) (if a false true)))" +rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" +rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" +rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" + +$argv = Mal::List.new +$repl_env.set("*ARGV*", Mal::Type.new $argv) + +unless ARGV.empty? + if ARGV.size > 1 + ARGV[1..-1].each do |a| + $argv << Mal::Type.new(a) + end + end + + begin + rep "(load-file \"#{ARGV[0]}\")" + rescue e + STDERR.puts e + end + exit +end + +while line = my_readline("user> ") + begin + puts rep(line) + rescue e + STDERR.puts e + end +end diff --git a/src/stepA_mal.cr b/src/stepA_mal.cr new file mode 100755 index 0000000..49361ef --- /dev/null +++ b/src/stepA_mal.cr @@ -0,0 +1,280 @@ +#! /usr/bin/env crystal run + +require "colorize" + +require "./readline" +require "./reader" +require "./printer" +require "./types" +require "./env" +require "./core" +require "./error" + +# Note: +# Employed downcase names because Crystal prohibits uppercase names for methods + +def func_of(env, binds, body) + -> (args : Array(Mal::Type)) { + new_env = Mal::Env.new(env, binds, args) + eval(body, new_env) + } as Mal::Func +end + +def eval_ast(ast, env) + return ast.map{|n| eval(n, env) as Mal::Type} if ast.is_a? Array + + val = ast.unwrap + + Mal::Type.new case val + when Mal::Symbol + if e = env.get(val.str) + e + else + eval_error "'#{val.str}' not found" + end + when Mal::List + val.each_with_object(Mal::List.new){|n, l| l << eval(n, env)} + when Mal::Vector + val.each_with_object(Mal::Vector.new){|n, l| l << eval(n, env)} + when Mal::HashMap + new_map = Mal::HashMap.new + val.each{|k, v| new_map[k] = eval(v, env)} + new_map + else + val + end +end + +def read(str) + read_str str +end + +macro pair?(list) + {{list}}.is_a?(Array) && !{{list}}.empty? +end + +def quasiquote(ast) + list = ast.unwrap + + unless pair?(list) + return Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "quote") << ast + ) + end + + head = list.first.unwrap + + case + # ("unquote" ...) + when head.is_a?(Mal::Symbol) && head.str == "unquote" + list[1] + # (("splice-unquote" ...) ...) + when pair?(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote" + tail = Mal::Type.new list[1..-1].to_mal + Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail) + ) + else + tail = Mal::Type.new list[1..-1].to_mal + Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail) + ) + end +end + +def macro_call?(ast, env) + list = ast.unwrap + return false unless list.is_a? Mal::List + return false if list.empty? + + sym = list.first.unwrap + return false unless sym.is_a? Mal::Symbol + + func = env.find(sym.str).try(&.data[sym.str]) + return false unless func && func.macro? + + true +end + +def macroexpand(ast, env) + while macro_call?(ast, env) + + # Already checked in macro_call? + list = ast.unwrap as Mal::List + func_sym = list[0].unwrap as Mal::Symbol + func = env.get(func_sym.str).unwrap + + case func + when Mal::Func + ast = func.call(list[1..-1]) + when Mal::Closure + ast = func.fn.call(list[1..-1]) + else + eval_error "macro '#{func_sym.str}' must be function: #{ast}" + end + end + + ast +end + +macro invoke_list(l, env) + f = eval({{l}}.first, {{env}}).unwrap + args = eval_ast({{l}}[1..-1], {{env}}) as Array + + case f + when Mal::Closure + ast = f.ast + {{env}} = Mal::Env.new(f.env, f.params, args) + next # TCO + when Mal::Func + return f.call args + else + eval_error "expected function as the first argument: #{f}" + end +end + +def debug(ast) + puts print(ast).colorize.red +end + +def eval(ast, env) + # 'next' in 'do...end' has a bug in crystal 0.7.1 + # https://github.com/manastech/crystal/issues/659 + while true + return eval_ast(ast, env) unless ast.unwrap.is_a? Mal::List + + ast = macroexpand(ast, env) + + list = ast.unwrap + + return ast unless list.is_a? Mal::List + return ast if list.empty? + + head = list.first.unwrap + + return invoke_list(list, env) unless head.is_a? Mal::Symbol + + return Mal::Type.new case head.str + when "def!" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol + env.set(a1.str, eval(list[2], env)) + when "let*" + eval_error "wrong number of argument for 'def!'" unless list.size == 3 + + bindings = list[1].unwrap + eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array + eval_error "size of binding list must be even" unless bindings.size.even? + + new_env = Mal::Env.new env + bindings.each_slice(2) do |binding| + key, value = binding + name = key.unwrap + eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol + new_env.set(name.str, eval(value, new_env)) + end + + ast, env = list[2], new_env + next # TCO + when "do" + if list.empty? + ast = Mal::Type.new nil + next + end + + eval_ast(list[1..-2].to_mal, env) + ast = list.last + next # TCO + when "if" + ast = unless eval(list[1], env).unwrap + list.size >= 4 ? list[3] : Mal::Type.new(nil) + else + list[2] + end + next # TCO + when "fn*" + params = list[1].unwrap + unless params.is_a? Array + eval_error "'fn*' parameters must be list or vector: #{params}" + end + Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) + when "quote" + list[1] + when "quasiquote" + ast = quasiquote list[1] + next # TCO + when "defmacro!" + eval_error "wrong number of argument for 'defmacro!'" unless list.size == 3 + a1 = list[1].unwrap + eval_error "1st argument of 'defmacro!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol + env.set(a1.str, eval(list[2], env).tap{|n| n.is_macro = true}) + when "macroexpand" + macroexpand(list[1], env) + when "try*" + catch_list = list[2].unwrap + return eval(list[1], env) unless catch_list.is_a? Mal::List + + catch_head = catch_list.first.unwrap + return eval(list[1], env) unless catch_head.is_a? Mal::Symbol + return eval(list[1], env) unless catch_head.str == "catch*" + + begin + eval(list[1], env) + rescue e : Mal::RuntimeException + new_env = Mal::Env.new(env, [catch_list[1]], [e.thrown]) + eval(catch_list[2], new_env) + rescue e + new_env = Mal::Env.new(env, [catch_list[1]], [Mal::Type.new e.message]) + eval(catch_list[2], new_env) + end + else + invoke_list(list, env) + end + end +end + +def print(result) + pr_str(result, true) +end + +def rep(str) + print(eval(read(str), $repl_env)) +end + +$repl_env = Mal::Env.new nil +Mal::NS.each{|k,v| $repl_env.set(k, Mal::Type.new(v))} +$repl_env.set("eval", Mal::Type.new -> (args: Array(Mal::Type)){ eval(args[0], $repl_env) }) +rep "(def! not (fn* (a) (if a false true)))" +rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" +rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" +rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" +rep("(def! *host-language* \"crystal\")") + +$argv = Mal::List.new +$repl_env.set("*ARGV*", Mal::Type.new $argv) + +unless ARGV.empty? + if ARGV.size > 1 + ARGV[1..-1].each do |a| + $argv << Mal::Type.new(a) + end + end + + begin + rep "(load-file \"#{ARGV[0]}\")" + rescue e + STDERR.puts e + end + exit +end + +rep("(println (str \"Mal [\" *host-language* \"]\"))") + +while line = my_readline("user> ") + begin + puts rep(line) + rescue e + STDERR.puts e + end +end diff --git a/src/types.cr b/src/types.cr new file mode 100644 index 0000000..af61cb7 --- /dev/null +++ b/src/types.cr @@ -0,0 +1,114 @@ +require "./printer" + +module Mal + class Symbol + property :str + def initialize(@str) + end + + def ==(other : Symbol) + @str == other.str + end + end + + class List < Array(Type) + end + + class Vector < Array(Type) + end + + class HashMap < Hash(String, Type) + end + + class Atom + property :val + def initialize(@val) + end + + def ==(rhs : Atom) + @val == rhs.val + end + end + + class Closure + property :ast, :params, :env, :fn + def initialize(@ast, @params, @env, @fn) + end + end + + class Type + alias Func = (Array(Type) -> Type) + alias ValueType = Nil | Bool | Int32 | String | Symbol | List | Vector | HashMap | Func | Closure | Atom + + is_macro :: Bool + meta :: Type + + property :is_macro, :meta + + def initialize(@val : ValueType) + @is_macro = false + @meta = nil + end + + def initialize(other : Type) + @val = other.unwrap + @is_macro = other.is_macro + @meta = other.meta + end + + def unwrap + @val + end + + def macro? + @is_macro + end + + def to_s + pr_str(self) + end + + def dup + Type.new(@val).tap do |t| + t.is_macro = @is_macro + t.meta = @meta + end + end + + def ==(other : Type) + @val == other.unwrap + end + + macro rel_op(*ops) + {% for op in ops %} + def {{op.id}}(other : Mal::Type) + l, r = @val, other.unwrap + {% for t in [Int32, String] %} + if l.is_a?({{t}}) && r.is_a?({{t}}) + return (l) {{op.id}} (r) + end + {% end %} + if l.is_a?(Symbol) && r.is_a?(Symbol) + return l.str {{op.id}} r.str + end + false + end + {% end %} + end + + rel_op :<, :>, :<=, :>= + end + + alias Func = Type::Func +end + +macro gen_type(t, *args) + Mal::Type.new {{t.id}}.new({{*args}}) +end + +class Array + def to_mal(t = Mal::List) + each_with_object(t.new){|e, l| l << e} + end +end +