Crystal spike of Haskell like data

.gitignore

.crystal

datatype.cr

macro data(data_ast)
  {{ run "./datatype_data", data_ast.stringify }}
end

macro pattern(def_ast)
  {{ run "./datatype_pattern_def", def_ast.stringify }}
end

class PatternMatchingException < Exception
end

datatype_data.cr

require "compiler/crystal/**"
include Crystal

# code = ARGV[0].gsub("\\n","\n")
code = "List { Empty, Cons[Int32, List] }"

parser = Parser.new(code)
ast = parser.parse as ArrayLiteral
ctor_names = [] of String

ast.elements.each do |ctor_def|
  case ctor_def
  when Path
    ctor_names << ctor_def.to_s

    puts %{
class #{ctor_def.to_s}
  def initialize
  end

  def self.match(obj)
    if obj.is_a?(self)
      yield
    end
  end
    }
  when Call
    ctor_names << ctor_def.obj.to_s

    puts %{
class #{ctor_def.obj}
}

    ctor_def.args.each_with_index do |arg, index|
    puts %{
  getter p#{index} :: #{arg.to_s}
}
    end

    initialize_args = ctor_def.args.map_with_index { |arg, index|
      "@p#{index} : #{arg.to_s}"
    }.join(", ")

    match_args = ctor_def.args.map_with_index { |arg, index|
      "obj.p#{index}"
    }.join(", ")

    puts %{
  def initialize(#{initialize_args})
  end

  def self.match(obj)
    if obj.is_a?(self)
      yield #{match_args}
    end
  end
}
  end

  puts "end"
end

puts "alias #{ast.name.to_s} = #{ctor_names.join(" | ")}"

datatype_pattern_def.cr

require "compiler/crystal/**"

code = ARGV[0].gsub("\\n","\n")

parser = Crystal::Parser.new(code)
ast = parser.parse as Crystal::Def

pattern, pieces = case arg = ast.args.first.default_value
  when Crystal::Path
    {arg, nil}
  when Crystal::Call
    p = arg.args.map { |a| (a as Crystal::Call).name }.join(", ")
    {arg.obj, p}
  else
    puts "not implemented #{arg.class}"
    exit 1
end

puts "def #{ast.name}(#{ast.args.first.name} : #{pattern})
  #{pattern}.match(#{ast.args.first.name}) do #{pieces ? "|#{pieces}|" : ""}
    return begin
      #{ast.body}
    end
  end
  raise PatternMatchingException.new
end"

list.cr

require "./datatype"

data List { Empty, Cons[Int32, List] }

pattern def length(l = Empty)
  0
end

pattern def length(l = Cons[x, xs])
  1 + length(xs)
end

puts length(Empty.new)
puts length(Cons.new(1, Empty.new))
puts length(Cons.new(2, Cons.new(1, Empty.new)))
puts length(Cons.new(3, Cons.new(2, Cons.new(1, Empty.new))))


pattern def empty?(l = Empty)
  true
end

pattern def empty?(l = Cons)
  false
end

puts empty?(Empty.new)
puts empty?(Cons.new(1, Empty.new))
puts empty?(Cons.new(2, Cons.new(1, Empty.new)))
puts empty?(Cons.new(3, Cons.new(2, Cons.new(1, Empty.new))))