sfrp 1.1.0

data/lib/sfrp/poly/exception.rb

@@ -0,0 +1,42 @@
+require 'sfrp/error'
+
+module SFRP
+  module Poly
+    class UndeterminableTypeError < CompileError
+      def initialize(identifier, typing)
+        @identifier = identifier
+        @typing = typing
+      end
+
+      def message
+        "undeterminable type #{@typing}"
+      end
+    end
+
+    class UnifyError < CompileError
+      def initialize(typing1, typing2)
+        @typing1 = typing1
+        @typing2 = typing2
+      end
+
+      def message
+        vars = @typing1.variables + @typing2.variables
+        "cannot unify #{@typing1.to_s(vars)} and #{@typing2.to_s(vars)}"
+      end
+    end
+
+    class RecursiveError < CompileError
+      def initialize(node_strs)
+        @node_strs = node_strs
+      end
+
+      def chain_str
+        [*@node_strs, @node_strs[0]].join(' -> ')
+      end
+
+      def message
+        "recursive node/function path: #{chain_str}"
+      end
+    end
+  end
+end

data/lib/sfrp/poly/expression.rb

@@ -0,0 +1,170 @@
+module SFRP
+  module Poly
+    class MatchExp
+      Case = Struct.new(:pattern, :exp)
+
+      def initialize(left_exp, cases, id = nil)
+        @left_exp = left_exp
+        @cases = cases
+        @id = id
+      end
+
+      def typing(set, var_env)
+        raise if @typing
+        left_exp_typing = @left_exp.typing(set, var_env)
+        @typing = Typing.new do |t|
+          @cases.each do |c|
+            new_var_env = var_env.dup
+            left_exp_typing.unify(c.pattern.typing(set, new_var_env))
+            t.unify(c.exp.typing(set, new_var_env))
+          end
+        end
+      end
+
+      def clone
+        cloned_cases = @cases.map { |c| Case.new(c.pattern.clone, c.exp.clone) }
+        MatchExp.new(@left_exp.clone, cloned_cases, @id)
+      end
+
+      def called_func_strs
+        [@left_exp, *@cases.map(&:exp)].flat_map(&:called_func_strs)
+      end
+
+      def to_mono(monofier)
+        raise UndeterminableTypeError.new(@id, @typing) unless @typing.mono?
+        mono_type_str = monofier.use_type(@typing)
+        M.match_e(mono_type_str, @left_exp.to_mono(monofier)) do |m|
+          @cases.each do |c|
+            m.case(c.pattern.to_mono(monofier)) { c.exp.to_mono(monofier) }
+          end
+        end
+      end
+    end
+
+    class FuncCallExp
+      def initialize(func_str, arg_exps, id = nil)
+        @func_str = func_str
+        @arg_exps = arg_exps
+        @id = id
+      end
+
+      def typing(set, var_env)
+        raise if @typing
+        @ftyping = set.func(@func_str).ftyping(set).instance do |ft|
+          ft.params.zip(@arg_exps) { |t, e| e.typing(set, var_env).unify(t) }
+        end
+        @typing = @ftyping.body
+      end
+
+      def clone
+        FuncCallExp.new(@func_str, @arg_exps.map(&:clone), @id)
+      end
+
+      def called_func_strs
+        [@func_str, *@arg_exps.flat_map(&:called_func_strs)]
+      end
+
+      def to_mono(monofier)
+        raise UndeterminableTypeError.new(@id, @typing) unless @typing.mono?
+        mono_func_str = monofier.use_func(@func_str, @ftyping)
+        args = @arg_exps.map { |e| e.to_mono(monofier) }
+        M.call_e(monofier.use_type(@typing), mono_func_str, *args)
+      end
+    end
+
+    class VConstCallExp
+      def initialize(vconst_str, arg_exps, id = nil)
+        @vconst_str = vconst_str
+        @arg_exps = arg_exps
+        @id = id
+      end
+
+      def typing(set, var_env)
+        raise if @typing
+        @ftyping = set.vconst(@vconst_str).ftyping.instance do |ft|
+          ft.params.zip(@arg_exps) { |t, e| e.typing(set, var_env).unify(t) }
+        end
+        @typing = @ftyping.body
+      end
+
+      def clone
+        VConstCallExp.new(@vconst_str, @arg_exps.map(&:clone), @id)
+      end
+
+      def called_func_strs
+        @arg_exps.flat_map(&:called_func_strs)
+      end
+
+      def to_mono(monofier)
+        raise UndeterminableTypeError.new(@id, @typing) unless @typing.mono?
+        mono_vconst_str = monofier.use_vconst(@vconst_str, @typing)
+        args = @arg_exps.map { |e| e.to_mono(monofier) }
+        M.vc_call_e(monofier.use_type(@typing), mono_vconst_str, *args)
+      end
+    end
+
+    class VarRefExp
+      def initialize(var_str, id = nil)
+        @var_str = var_str
+        @id = id
+      end
+
+      def typing(_set, var_env)
+        @typing = var_env[@var_str]
+      end
+
+      def clone
+        VarRefExp.new(@var_str, @id)
+      end
+
+      def called_func_strs
+        []
+      end
+
+      def to_mono(monofier)
+        raise UndeterminableTypeError.new(@id, @typing) unless @typing.mono?
+        M.v_e(monofier.use_type(@typing), @var_str)
+      end
+    end
+
+    class Pattern
+      def initialize(vconst_str, ref_var_str, patterns, id = nil)
+        @vconst_str = vconst_str
+        @ref_var_str = ref_var_str
+        @patterns = patterns
+        @id = id
+      end
+
+      def typing(set, var_env)
+        raise if @typing
+        @typing = Typing.new do |t|
+          var_env[@ref_var_str] = t if @ref_var_str
+          if @vconst_str
+            set.vconst(@vconst_str).ftyping.instance do |ft|
+              @patterns.zip(ft.params) do |pat, param_typing|
+                pat.typing(set, var_env).unify(param_typing)
+              end
+              ft.body.unify(t)
+            end
+          end
+        end
+      end
+
+      def clone
+        Pattern.new(@vconst_str, @ref_var_str, @patterns.map(&:clone), @id)
+      end
+
+      def to_mono(monofier)
+        raise UndeterminableTypeError.new(@id, @typing) unless @typing.mono?
+        mono_type_str = monofier.use_type(@typing)
+        if @vconst_str
+          mono_vconst_str = monofier.use_vconst(@vconst_str, @typing)
+          ch = @patterns.map { |pat| pat.to_mono(monofier) }
+          M.pref(mono_type_str, mono_vconst_str, @ref_var_str, *ch)
+        else
+          M.pany(mono_type_str, @ref_var_str)
+        end
+      end
+    end
+  end
+end

data/lib/sfrp/poly/monofier.rb

@@ -0,0 +1,73 @@
+module SFRP
+  module Poly
+    class Monofier
+      def initialize(src_set, dest_set, &block)
+        @src_set = src_set
+        @dest_set = dest_set
+        @type_str = {}
+        @func_str = {}
+        @vconst_str = {}
+        @node_str = {}
+        block.call(self) if block
+      end
+
+      def use_type(typing)
+        unique_type_str = typing.tconst_str + '/TYPE/' + typing.unique_str
+        if @type_str.key?(unique_type_str)
+          @type_str[unique_type_str]
+        else
+          @type_str[unique_type_str] = 'T' + md5(unique_type_str)
+          new_tconst = @src_set.tconst(typing.tconst_str).clone
+          new_tconst.typing.unify(typing)
+          @dest_set << new_tconst.to_mono(self)
+          @type_str[unique_type_str]
+        end
+      end
+
+      def use_func(func_str, ftyping)
+        unique_func_str = func_str + '/FUNC/' + ftyping.unique_str
+        if @func_str.key?(unique_func_str)
+          @func_str[unique_func_str]
+        else
+          new_func = @src_set.func(func_str).clone
+          mono_func_str = 'F' + md5(unique_func_str)
+          new_func.ftyping(@src_set).unify(ftyping)
+          @dest_set << new_func.to_mono(self, mono_func_str)
+          @func_str[unique_func_str] = mono_func_str
+        end
+      end
+
+      def use_vconst(vconst_str, typing)
+        unique_vconst_str = vconst_str + '/VCONST/' + typing.unique_str
+        if @vconst_str.key?(unique_vconst_str)
+          @vconst_str[unique_vconst_str]
+        else
+          @vconst_str[unique_vconst_str] = 'V' + md5(unique_vconst_str)
+          new_vconst = @src_set.vconst(vconst_str).clone
+          new_vconst.ftyping.body.unify(typing)
+          @dest_set << new_vconst.to_mono(self)
+          @vconst_str[unique_vconst_str]
+        end
+      end
+
+      def use_node(node_str)
+        unique_node_str = node_str + '/NODE/'
+        if @node_str.key?(unique_node_str)
+          @node_str[unique_node_str]
+        else
+          @node_str[unique_node_str] = 'N' + md5(unique_node_str)
+        end
+      end
+
+      private
+
+      def md5(str)
+        require 'digest/md5'
+        @record ||= {}
+        hash_val = Digest::MD5.hexdigest(str).to_i(16).to_s(36)[0, 20]
+        raise "MD5: #{@record[hash_val]} and #{str}" if @record.key?(hash_val)
+        hash_val
+      end
+    end
+  end
+end

data/lib/sfrp/poly/set.rb

@@ -0,0 +1,90 @@
+require 'sfrp/poly/exception'
+require 'sfrp/poly/typing'
+require 'sfrp/poly/elements'
+require 'sfrp/poly/expression'
+require 'sfrp/poly/monofier'
+require 'sfrp/poly/dsl'
+
+module SFRP
+  module Poly
+    class Set
+      def initialize(&block)
+        @func_h = {}
+        @node_h = {}
+        @tconst_h = {}
+        @vconst_h = {}
+        @output_node_strs = []
+        @init_func_strs = []
+        block.call(self) if block
+      end
+
+      def to_mono
+        Mono::Set.new do |dest_set|
+          @func_h.values.each do |f|
+            f.check_recursion(self)
+            f.ftyping(self)
+          end
+          @node_h.values.each do |n|
+            n.check_recursion(self)
+            n.typing(self)
+          end
+          Monofier.new(self, dest_set) do |m|
+            @init_func_strs.each do |func_str|
+              mono_func_str = m.use_func(func_str, func(func_str).ftyping(self))
+              dest_set.append_init_func_str(mono_func_str)
+            end
+            @node_h.values.each do |node|
+              dest_set << node.to_mono(m)
+            end
+            @output_node_strs.each do |node_str|
+              dest_set.append_output_node_str(m.use_node(node_str))
+            end
+          end
+        end
+      end
+
+      def <<(element)
+        case element
+        when Function
+          @func_h[element.str] = element
+        when Node
+          @node_h[element.str] = element
+        when TConst
+          @tconst_h[element.str] = element
+        when VConst
+          @vconst_h[element.str] = element
+        else
+          raise
+        end
+      end
+
+      def append_output_node_str(node_str)
+        @output_node_strs << node_str
+      end
+
+      def append_init_func_str(init_func_str)
+        @init_func_strs << init_func_str
+      end
+
+      def func(func_str)
+        raise func_str unless @func_h.key?(func_str)
+        @func_h[func_str]
+      end
+
+      def node(node_str)
+        raise node_str unless @node_h.key?(node_str)
+        @node_h[node_str]
+      end
+
+      def tconst(tconst_str)
+        raise tconst_str unless @tconst_h.key?(tconst_str )
+        @tconst_h[tconst_str ]
+      end
+
+      def vconst(vconst_str)
+        raise vconst_str unless @vconst_h.key?(vconst_str)
+        @vconst_h[vconst_str]
+      end
+    end
+  end
+end

data/lib/sfrp/poly/typing.rb

@@ -0,0 +1,197 @@
+module SFRP
+  module Poly
+    class Typing
+      def initialize(tconst_str = nil, arg_typings = [], &block)
+        @tconst_str = tconst_str
+        @arg_typings = arg_typings
+        @parent = nil
+        block.call(self) if block
+      end
+
+      def tconst_str
+        root == self ? @tconst_str : root.tconst_str
+      end
+
+      def unify(other)
+        return self if same?(other)
+        return root.unify(other) unless root == self
+        if variable? && other.variable?
+          @parent = other
+        elsif variable? && !other.variable?
+          raise UnifyError.new(self, other) if occur?(other)
+          @parent = other
+        elsif !variable? && other.variable?
+          other.unify(self)
+        else
+          unless tconst_str == other.tconst_str && argc == other.argc
+            raise UnifyError.new(self, other)
+          end
+          arg_typings.zip(other.arg_typings) { |a, b| a.unify(b) }
+          @parent = other
+        end
+      end
+
+      def unique_str
+        raise unless mono?
+        "#{tconst_str}[#{arg_typings.map(&:unique_str).join(', ')}]"
+      end
+
+      def mono?
+        !variable? && arg_typings.all?(&:mono?)
+      end
+
+      def variables
+        return [self] if variable?
+        arg_typings.flat_map(&:variables)
+      end
+
+      def to_type_annot(vars)
+        if variable?
+          idx = vars.index { |v| v.same?(self) }
+          raise unless idx
+          TypeAnnotationVar.new('a' + idx.to_s)
+        else
+          args = arg_typings.map { |t| t.to_type_annot(vars) }
+          TypeAnnotationType.new(tconst_str, args)
+        end
+      end
+
+      def to_s(vars = nil)
+        vars ||= variables
+        to_type_annot(vars).to_s
+      end
+
+      protected
+
+      def root
+        @parent ? (@parent = @parent.root) : self
+      end
+
+      def argc
+        arg_typings.size
+      end
+
+      def arg_typings
+        root == self ? @arg_typings : root.arg_typings
+      end
+
+      def variable?
+        tconst_str.nil?
+      end
+
+      def same?(other)
+        return true if root == other.root
+        return false if variable? || other.variable?
+        return false unless tconst_str == other.tconst_str && argc == other.argc
+        arg_typings.zip(other.arg_typings).all? { |a, b| a.same?(b) }
+      end
+
+      def occur?(other)
+        raise unless variable?
+        return true if same?(other)
+        arg_typings.any? { |t| occur?(t) }
+      end
+    end
+
+    class FuncTyping
+      attr_reader :params, :body
+
+      def initialize(param_size, &block)
+        @params = Array.new(param_size) { Typing.new }
+        @body = Typing.new
+        block.call(self) if block
+      end
+
+      def to_ftype_annot
+        vars = @body.variables + @params.flat_map(&:variables)
+        args = @params.map { |t| t.to_type_annot(vars) }
+        FuncTypeAnnotation.new(@body.to_type_annot(vars), args)
+      end
+
+      def unify(other)
+        raise unless @params.size == other.params.size
+        @params.zip(other.params) { |a, b| a.unify(b) }
+        @body.unify(other.body)
+        self
+      end
+
+      def instance(&block)
+        instance = to_ftype_annot.to_ftyping
+        block.call(instance) if block
+        instance
+      end
+
+      def unique_str
+        args = @params + [@body]
+        "Func#{@params.size}[#{args.map(&:unique_str).join(', ')}]"
+      end
+
+      def mono?
+        [@body, *@params].all?(&:mono?)
+      end
+
+      def to_s
+        to_ftype_annot.to_s
+      end
+    end
+
+    class FuncTypeAnnotation
+      def initialize(ret_type_annot, arg_type_annots)
+        @ret_type_annot = ret_type_annot
+        @arg_type_annots = arg_type_annots
+      end
+
+      def to_ftyping(var_strs = nil)
+        var_strs ||= [@ret_type_annot, *@arg_type_annots].flat_map(&:var_strs)
+        tbl = Hash[var_strs.uniq.map { |s| [s, Typing.new] }]
+        FuncTyping.new(@arg_type_annots.size) do |ft|
+          ft.params.zip(@arg_type_annots) { |t, at| t.unify(at.to_typing(tbl)) }
+          ft.body.unify(@ret_type_annot.to_typing(tbl))
+        end
+      end
+
+      def to_s
+        "(#{@arg_type_annots.map(&:to_s).join(', ')}) -> #{@ret_type_annot}"
+      end
+    end
+
+    class TypeAnnotationType
+      def initialize(tconst_str, arg_type_annots)
+        @tconst_str = tconst_str
+        @arg_type_annots = arg_type_annots
+      end
+
+      def to_typing(tbl)
+        Typing.new(@tconst_str, @arg_type_annots.map { |ta| ta.to_typing(tbl) })
+      end
+
+      def var_strs
+        @arg_type_annots.flat_map(&:var_strs)
+      end
+
+      def to_s
+        return @tconst_str if @arg_type_annots.empty?
+        "#{@tconst_str}[#{@arg_type_annots.map(&:to_s).join(', ')}]"
+      end
+    end
+
+    class TypeAnnotationVar
+      def initialize(var_str)
+        @var_str = var_str
+      end
+
+      def to_typing(tbl)
+        raise var_str unless tbl.key?(@var_str)
+        tbl[@var_str]
+      end
+
+      def var_strs
+        [@var_str]
+      end
+
+      def to_s
+        @var_str
+      end
+    end
+  end
+end