sfrp 1.1.0

data/lib/sfrp/mono/vconst.rb

@@ -0,0 +1,134 @@
+module SFRP
+  module Mono
+    class VConst
+      attr_reader :str
+
+      def initialize(str, type_str, arg_type_strs, native_str = nil)
+        @str = str
+        @type_str = type_str
+        @arg_type_strs = arg_type_strs
+        @native_str = native_str
+      end
+
+      def comp
+        [@str, @type_str, @arg_type_strs, @native_str]
+      end
+
+      def ==(other)
+        comp == other.comp
+      end
+
+      # Return max memory size to hold an instance of this vconst.
+      def memory(set)
+        @arg_type_strs.reduce(Memory.empty) do |m, t_str|
+          m.and(set.type(t_str).memory(set))
+        end
+      end
+
+      # Is this vconst expressed in native C value?
+      def native?
+        @native_str
+      end
+
+      def native_args?(set)
+        @arg_type_strs.all? { |s| set.type(s).native? }
+      end
+
+      def all_pattern_examples(set)
+        return [Pattern::PatternExample.new(@str, [])] if @arg_type_strs.empty?
+        head, *tail = @arg_type_strs.map do |type_str|
+          set.type(type_str).all_pattern_examples(set)
+        end
+        head.product(*tail).map do |args|
+          Pattern::PatternExample.new(@str, args)
+        end
+      end
+
+      # Generate a struct-element of term for this vconst.
+      def gen_term_definition(set, term_id, terms)
+        return if native?
+        terms << L.member_structure('struct', "term#{term_id}") do |term|
+          @arg_type_strs.each_with_index do |t_str, idx|
+            low_type_str = set.type(t_str).low_type_str
+            term << L.member("#{low_type_str} member#{idx}")
+          end
+        end
+      end
+
+      # Do elements of this vconst need marking?
+      def param_needing_mark?(set)
+        @arg_type_strs.any? { |type_str| set.type(type_str).need_mark?(set) }
+      end
+
+      # Generate constructor-function in C.
+      def gen_constructor(src_set, term_id, dest_set)
+        return if native?
+        type = src_set.type(@type_str)
+        dest_set << L.function(low_constructor_str, type.low_type_str) do |f|
+          @arg_type_strs.each_with_index.map do |t_str, mem_idx|
+            f.append_param(src_set.type(t_str).low_type_str, "member#{mem_idx}")
+          end
+          if type.static?
+            f << L.stmt("#{type.low_type_str} x")
+          else
+            f << L.stmt("#{type.low_type_str} x = #{type.low_allocator_str}(0)")
+          end
+          if type.has_meta_in_struct?
+            f << L.stmt("#{type.meta_access_str('x')}.term_id = #{term_id}")
+          end
+          @arg_type_strs.size.times do |mem_idx|
+            terms = type.terms_access_str('x')
+            m = "member#{mem_idx}"
+            f << L.stmt("#{terms}.term#{term_id}.#{m} = #{m}")
+          end
+          f << L.stmt('return x')
+        end
+      end
+
+      # return low-expression to make a new instance by this vconst
+      def low_constructor_call_exp(low_arg_exps)
+        return @native_str if native?
+        "#{low_constructor_str}(#{low_arg_exps.join(', ')})"
+      end
+
+      # Return conditional-low-exps to match this vconst and receiver-exp.
+      def low_compare_exps(set, receiver_exp)
+        type = set.type(@type_str)
+        return [] if type.single_vconst?
+        return ["#{receiver_exp} == #{@native_str}"] if native?
+        meta = type.meta_access_str(receiver_exp)
+        term_id = type.term_id(@str)
+        ["#{meta}.term_id == #{term_id}"]
+      end
+
+      # name of constructor-function in C for this vconst
+      def low_constructor_str
+        'VC_' + @str
+      end
+
+      # Return alias of the constructor of this vconst.
+      def low_macro_for_alias(alias_str)
+        arg = ('a'..'z').take(@arg_type_strs.size).join(', ')
+        L.macro("#{alias_str}(#{arg}) #{low_constructor_str}(#{arg})")
+      end
+
+      # Return low-exp to mark elements of this vconst.
+      def low_mark_element_exps(set, term_id, receiver_str)
+        types = @arg_type_strs.map { |t_str| set.type(t_str) }
+        types_needing_mark = types.select { |t| t.need_mark?(set) }
+        types_needing_mark.each_with_index.map do |type, mem_idx|
+          term_access = "#{type.terms_access_str(receiver_str)}.term#{term_id}"
+          "#{type.low_mark_func_str}(#{term_access}.member#{mem_idx})"
+        end
+      end
+
+      def low_member_pointers(type, receiver_str)
+        term_id = type.term_id(@str)
+        terms_access = "#{type.terms_access_str(receiver_str)}.term#{term_id}"
+        @arg_type_strs.each_with_index.map do |_, mem_idx|
+          "&#{terms_access}.member#{mem_idx}"
+        end
+      end
+    end
+  end
+end

data/lib/sfrp/output/set.rb

@@ -0,0 +1,33 @@
+require 'sfrp/file'
+require 'fileutils'
+
+module SFRP
+  module Output
+    class Set
+      attr_reader :virtual_files
+
+      def initialize(&block)
+        @virtual_files = []
+        block.call(self) if block
+      end
+
+      def generate!(output_dir_path, other_virtual_files = [])
+        unless File.directory?(output_dir_path)
+          FileUtils.mkdir_p(output_dir_path)
+        end
+        FileUtils.cd(output_dir_path) do
+          (@virtual_files + other_virtual_files).each do |vf|
+            relative_path = vf.fmodule_uri.gsub('.', '/') + '.' + vf.file_ext
+            dirname = File.dirname(relative_path)
+            FileUtils.mkdir_p(dirname) unless File.directory?(dirname)
+            File.open(relative_path, 'w') { |f| f.write(vf.content) }
+          end
+        end
+      end
+
+      def create_file(relative_position, file_ext, content)
+        @virtual_files << VirtualFile.new(relative_position, file_ext, content)
+      end
+    end
+  end
+end

data/lib/sfrp/poly/dsl.rb

@@ -0,0 +1,171 @@
+module SFRP
+  module Poly
+    module DSL
+      extend SFRP::P = self
+
+      def tconst(tconst_str, var_strs, static, native_str, infinite, &block)
+        tp = TConstProxy.new(tconst_str, var_strs, infinite)
+        block.call(tp) if block
+        argc = var_strs.size
+        TConst.new(tconst_str, argc, tp.vconst_strs, static, native_str)
+      end
+
+      def func(func_str, ret_type_annot = nil, &block)
+        fp = FuncProxy.new(func_str, ret_type_annot)
+        block.call(fp) if block
+        fp.to_func
+      end
+
+      def node(node_str, type_annot = nil, &block)
+        np = NodeProxy.new(node_str, type_annot)
+        block.call(np) if block
+        np.to_node
+      end
+
+      def t(tconst_str, *args)
+        TypeAnnotationType.new(tconst_str, args)
+      end
+
+      def tv(var_str)
+        TypeAnnotationVar.new(var_str)
+      end
+
+      def match_e(left_exp, &block)
+        cp = CaseProxy.new
+        block.call(cp) if block
+        MatchExp.new(left_exp, cp.to_a)
+      end
+
+      def call_e(func_str, *arg_exps)
+        FuncCallExp.new(func_str, arg_exps)
+      end
+
+      def vc_call_e(vconst_str, *arg_exps)
+        VConstCallExp.new(vconst_str, arg_exps)
+      end
+
+      def v_e(var_str)
+        VarRefExp.new(var_str)
+      end
+
+      def pat(vconst_str, *arg_patterns)
+        Pattern.new(vconst_str, nil, arg_patterns)
+      end
+
+      def pref(vconst_str, ref_var_str, *arg_patterns)
+        Pattern.new(vconst_str, ref_var_str, arg_patterns)
+      end
+
+      def pany(ref_var_str = nil)
+        Pattern.new(nil, ref_var_str, [])
+      end
+
+      class TConstProxy
+        def initialize(tconst_str, var_strs, infinite)
+          args = var_strs.map { |v| TypeAnnotationVar.new(v) }
+          @ret_type_annot = TypeAnnotationType.new(tconst_str, args)
+          @var_strs = var_strs
+          @infinite = infinite
+          @vconst_strs = []
+        end
+
+        def vconst(vconst_str, arg_type_annots, native_str = nil)
+          ftype_annot = FuncTypeAnnotation.new(@ret_type_annot, arg_type_annots)
+          @vconst_strs << vconst_str
+          VConst.new(vconst_str, @var_strs, ftype_annot, native_str)
+        end
+
+        def vconst_strs
+          @infinite ? nil : @vconst_strs
+        end
+      end
+
+      class FuncProxy
+        def initialize(func_str, ret_type_annot = nil)
+          @func_str = func_str
+          @ret_type_annot = ret_type_annot || DSL.tv('%a0')
+          @param_strs = []
+          @type_annots = []
+        end
+
+        def param(param_str, type_annot = nil)
+          @param_strs << param_str
+          @type_annots << (type_annot || DSL.tv('%a' + @param_strs.size.to_s))
+        end
+
+        def ffi_str(str)
+          @ffi_str = str
+        end
+
+        def exp(&block)
+          @exp = block.call
+        end
+
+        def to_func
+          ftype_annot = FuncTypeAnnotation.new(@ret_type_annot, @type_annots)
+          Function.new(@func_str, @param_strs, ftype_annot, @exp, @ffi_str)
+        end
+      end
+
+      class NodeProxy
+        def initialize(node_str, type_annot)
+          @node_str = node_str
+          @type_annot = type_annot || TypeAnnotationVar.new('%a0')
+          @node_refs = []
+          @type_annots = []
+        end
+
+        def c(node_str)
+          dep(node_str, false)
+        end
+
+        def l(node_str)
+          dep(node_str, true)
+        end
+
+        def dep(node_str, last)
+          @node_refs << Node::NodeRef.new(node_str, last)
+          @type_annots << TypeAnnotationVar.new('%a' + @node_refs.size.to_s)
+        end
+
+        def eval_func(func_str, ret_type_annot = nil, &block)
+          @eval_func_str = func_str
+          DSL.func(func_str, ret_type_annot, &block)
+        end
+
+        def init_func(func_str, ret_type_annot = nil, &block)
+          @init_func_str = func_str
+          DSL.func(func_str, ret_type_annot, &block)
+        end
+
+        def eval_func_str(func_str)
+          @eval_func_str = func_str
+        end
+
+        def init_func_str(func_str)
+          @init_func_str = func_str
+        end
+
+        def to_node
+          a = @node_refs.size.times.map { |i| TypeAnnotationVar.new("a#{i}") }
+          annot = FuncTypeAnnotation.new(@type_annot, a)
+          Node.new(@node_str, @node_refs, annot, @eval_func_str, @init_func_str)
+        end
+      end
+
+      class CaseProxy
+        def initialize
+          @cases = []
+        end
+
+        def case(pattern, &exp_block)
+          @cases << MatchExp::Case.new(pattern, exp_block.call)
+        end
+
+        def to_a
+          @cases
+        end
+      end
+    end
+  end
+end

data/lib/sfrp/poly/elements.rb

@@ -0,0 +1,168 @@
+module SFRP
+  module Poly
+    class Function
+      attr_reader :str
+
+      def initialize(str, param_strs, ftype_annot, exp = nil, ffi_str = nil)
+        raise ArgumentError if exp.nil? && ffi_str.nil?
+        @str = str
+        @param_strs = param_strs
+        @ftype_annot = ftype_annot
+        @exp = exp
+        @ffi_str = ffi_str
+      end
+
+      def ftyping(set)
+        @ftyping ||= @ftype_annot.to_ftyping.instance do |ft|
+          var_env = {}
+          @param_strs.zip(ft.params) { |str, typing| var_env[str] = typing }
+          ft.body.unify(@exp.typing(set, var_env)) if @exp
+        end
+      end
+
+      def clone
+        exp = (@exp ? @exp.clone : nil)
+        Function.new(@str, @param_strs, @ftype_annot, exp, @ffi_str)
+      end
+
+      def check_recursion(set, path = [])
+        return if @exp == nil
+        if path.include?(@str)
+          raise RecursiveError.new(path.drop_while { |s| s != @str })
+        end
+        @exp.called_func_strs.each do |str|
+          set.func(str).check_recursion(set, path + [@str])
+        end
+      end
+
+      def to_mono(monofier, mono_func_str)
+        raise UndeterminableTypeError.new(@str, @ftyping) unless @ftyping.mono?
+        mono_type_str = monofier.use_type(@ftyping.body)
+        M.func(mono_type_str, mono_func_str) do |f|
+          @param_strs.zip(@ftyping.params) do |str, typing|
+            f.param(monofier.use_type(typing), str)
+          end
+          f.exp { @exp.to_mono(monofier) } if @exp
+          f.ffi_str(@ffi_str) if @ffi_str
+        end
+      end
+    end
+
+    class Node
+      attr_reader :str
+
+      NodeRef = Struct.new(:node_str, :last)
+
+      def initialize(
+        str, node_refs, ftype_annot, eval_func_str, init_func_str = nil
+      )
+        @str = str
+        @node_refs = node_refs
+        @ftype_annot = ftype_annot
+        @eval_func_str = eval_func_str
+        @init_func_str = init_func_str
+      end
+
+      def typing(set)
+        return @typing if @typing
+        @typing = Typing.new
+        @ftyping = set.func(@eval_func_str).ftyping(set).instance do |eval_ft|
+          @node_refs.zip(eval_ft.params) do |node_ref, typing|
+            set.node(node_ref.node_str).typing(set).unify(typing)
+          end
+          next unless @init_func_str
+          @init_ftyping = set.func(@init_func_str).ftyping(set).instance do |ft|
+            raise unless ft.params.empty?
+            ft.body.unify(eval_ft.body)
+          end
+        end
+        @ftyping.unify(@ftype_annot.to_ftyping).body.unify(@typing)
+      end
+
+      def check_recursion(set, path = [])
+        if path.include?(@str)
+          raise RecursiveError.new(path.drop_while { |s| s != @str })
+        end
+        @node_refs.each do |nr|
+          next if nr.last
+          set.node(nr.node_str).check_recursion(set, path + [@str])
+        end
+      end
+
+      def to_mono(monofier)
+        raise UndeterminableTypeError.new(@str, @typing) unless @typing.mono?
+        type_str = monofier.use_type(@typing)
+        node_str = monofier.use_node(@str)
+        eval_func_str = monofier.use_func(@eval_func_str, @ftyping)
+        if @init_func_str
+          init_func_str = monofier.use_func(@init_func_str, @init_ftyping)
+        else
+          init_func_str = nil
+        end
+        M.node(type_str, node_str, eval_func_str, init_func_str) do |n|
+          @node_refs.each do |node_ref|
+            node_str = monofier.use_node(node_ref.node_str)
+            node_ref.last ? n.l(node_str) : n.c(node_str)
+          end
+        end
+      end
+    end
+
+    class TConst
+      attr_reader :str
+
+      def initialize(
+        str, paramc, vconst_strs = nil, static = false, native_str = nil
+      )
+        @str = str
+        @paramc = paramc
+        @vconst_strs = vconst_strs
+        @static = static
+        @native_str = native_str
+      end
+
+      def typing
+        @typing ||= Typing.new(@str, Array.new(@paramc) { Typing.new })
+      end
+
+      def clone
+        TConst.new(@str, @paramc, @vconst_strs, @static, @native_str)
+      end
+
+      def to_mono(monofier)
+        raise UndeterminableTypeError.new(@str, @typing) unless @typing.mono?
+        type_str = monofier.use_type(@typing)
+        return M.type(type_str, nil, @static, @native_str) unless @vconst_strs
+        vconst_strs = @vconst_strs.map { |s| monofier.use_vconst(s, @typing) }
+        M.type(type_str, vconst_strs, @static, @native_str)
+      end
+    end
+
+    class VConst
+      attr_reader :str
+
+      def initialize(str, annot_vars, ftype_annot, native_str = nil)
+        @str = str
+        @annot_vars = annot_vars
+        @ftype_annot = ftype_annot
+        @native_str = native_str
+      end
+
+      def ftyping
+        @ftyping ||= @ftype_annot.to_ftyping(@annot_vars)
+      end
+
+      def clone
+        VConst.new(@str, @annot_vars, @ftype_annot, @native_str)
+      end
+
+      def to_mono(monofier)
+        raise UndeterminableTypeError.new(@str, @ftyping) unless @ftyping.mono?
+        type_str = monofier.use_type(@ftyping.body)
+        vconst_str = monofier.use_vconst(@str, @ftyping.body)
+        arg_type_strs = @ftyping.params.map { |t| monofier.use_type(t) }
+        M.vconst(type_str, vconst_str, arg_type_strs, @native_str)
+      end
+    end
+  end
+end