sfrp 1.1.0

data/lib/sfrp/mono/node.rb

@@ -0,0 +1,125 @@
+module SFRP
+  module Mono
+    class Node
+      NodeRef = Struct.new(:node_str, :last)
+
+      attr_reader :str
+
+      def initialize(
+        str, type_str, node_refs, eval_func_str, init_func_str = nil
+      )
+        @str = str
+        @type_str = type_str
+        @node_refs = node_refs
+        @eval_func_str = eval_func_str
+        @init_func_str = init_func_str
+      end
+
+      def comp
+        [@str, @type_str, @node_refs, @eval_func_str, @init_func_str]
+      end
+
+      def ==(other)
+        comp == other.comp
+      end
+
+      # Is this node initialized?
+      def initialized?
+        @init_func_str
+      end
+
+      # Name of variable to hold current and last evaluated value of this node.
+      def low_node_str
+        @str
+      end
+
+      def memory_used_to_eval_node(set)
+        set.func(@eval_func_str).memory(set)
+      end
+
+      def memory_used_to_init_node(set)
+        return Memory.empty unless initialized?
+        set.func(@init_func_str).memory(set)
+      end
+
+      def memory_used_to_hold_node(set)
+        set.type(@type_str).memory(set)
+      end
+
+      # Return referrence name of current evaluated value of this node.
+      def low_node_ref_current_str
+        index = (initialized? ? 'c' : '0')
+        "#{low_node_str}[#{index}]"
+      end
+
+      # Return referrence name of last evaluated value of this node.
+      def low_node_ref_last_str
+        "#{low_node_str}[l]"
+      end
+
+      # Return a list of nodes sorted by evaluation-order including this node.
+      # The list includes only nodes (recursively) depended by this node.
+      # So if you want to get a list including all nodes, you must call this
+      # method for an output node.
+      def sorted_node_strs(set)
+        cur = current_referred_node_strs(set)
+        last = last_referred_node_strs(set)
+        cur + (last - cur)
+      end
+
+      # Generate a statement of initialization if needed.
+      def gen_initialize_stmt(set, stmts)
+        return unless initialized?
+        call_exp = set.func(@init_func_str).low_call_exp([])
+        stmts << L.stmt("#{low_node_str}[l] = #{call_exp}")
+      end
+
+      # Generate declaration for variable to hold value of node.
+      def gen_node_var_declaration(set, stmts)
+        type = set.type(@type_str)
+        size = (initialized? ? '2' : '1')
+        stmts << L.stmt("#{type.low_type_str} #{low_node_str}[#{size}]")
+      end
+
+      # Generate ststement to evaluate this node.
+      def gen_evaluate_stmt(set, stmts)
+        arg_exps = @node_refs.map do |node_ref|
+          n = set.node(node_ref.node_str)
+          node_ref.last ? n.low_node_ref_last_str : n.low_node_ref_current_str
+        end
+        call_exp = set.func(@eval_func_str).low_call_exp(arg_exps)
+        stmts << L.stmt("#{low_node_ref_current_str} = #{call_exp}")
+      end
+
+      # Generate statement to mark node[l].
+      def gen_node_var_mark_stmt(set, stmts)
+        return unless initialized?
+        return unless set.type(@type_str).need_mark?(set)
+        mark_func_str = set.type(@type_str).low_mark_func_str
+        stmts << L.stmt("#{mark_func_str}(#{low_node_str}[l])")
+      end
+
+      protected
+
+      # Return a list of (recursively) current-referred nodes including myself.
+      def current_referred_node_strs(set, visited = {})
+        return [] if visited.key?(@str)
+        visited[@str] = true
+        prereq_node_strs = @node_refs.reject(&:last).flat_map do |r|
+          set.node(r.node_str).current_referred_node_strs(set, visited)
+        end
+        prereq_node_strs + [@str]
+      end
+
+      # Return a list of (recursively) last-referred nodes.
+      def last_referred_node_strs(set, visited = {})
+        return [] if visited.key?(@str)
+        visited[@str] = true
+        rec = @node_refs.reject(&:last).flat_map do |r|
+          set.node(r.node_str).last_referred_node_strs(set, visited)
+        end
+        (@node_refs.select(&:last).map(&:node_str) + rec).uniq
+      end
+    end
+  end
+end

data/lib/sfrp/mono/pattern.rb

@@ -0,0 +1,69 @@
+module SFRP
+  module Mono
+    class Pattern
+      PatternExample = Struct.new(:vconst_str, :args)
+
+      def initialize(type_str, vconst_str, ref_var_str, arg_patterns)
+        @type_str = type_str
+        @vconst_str = vconst_str
+        @ref_var_str = ref_var_str
+        @arg_patterns = arg_patterns
+      end
+
+      def comp
+        [@type_str, @vconst_str, @ref_var_str, @arg_patterns]
+      end
+
+      def ==(other)
+        comp == other.comp
+      end
+
+      def any?
+        @vconst_str.nil?
+      end
+
+      def named?
+        @ref_var_str
+      end
+
+      def accept?(pattern_example)
+        return true if any?
+        return false unless pattern_example.vconst_str == @vconst_str
+        @arg_patterns.zip(pattern_example.args).all? do |pat, pat_exam|
+          pat.accept?(pat_exam)
+        end
+      end
+
+      # Return whole conditional-low-exps for the pattern-matching.
+      def low_cond_exps(set, receiver_exp)
+        return [] if any?
+        vconst = set.vconst(@vconst_str)
+        children = @arg_patterns.each_with_index.flat_map do |pat, mem_id|
+          new_receiver = child_receiver_exp(set, receiver_exp, mem_id)
+          pat.low_cond_exps(set, new_receiver)
+        end
+        vconst.low_compare_exps(set, receiver_exp) + children
+      end
+
+      # Return whole let-low-exps for the pattern-matching.
+      def low_let_exps(set, receiver_exp, env)
+        env.add_var(@ref_var_str, @type_str) if named?
+        lets = (named? ? ["#{@ref_var_str} = (#{receiver_exp})"] : [])
+        return lets if any?
+        children = @arg_patterns.each_with_index.flat_map do |pat, mem_id|
+          new_receiver = child_receiver_exp(set, receiver_exp, mem_id)
+          pat.low_let_exps(set, new_receiver, env)
+        end
+        lets + children
+      end
+
+      private
+
+      def child_receiver_exp(set, parent_receiver_exp, member_id)
+        type = set.type(@type_str)
+        terms_str = type.terms_access_str(parent_receiver_exp)
+        "#{terms_str}.term#{type.term_id(@vconst_str)}.member#{member_id}"
+      end
+    end
+  end
+end

data/lib/sfrp/mono/set.rb

@@ -0,0 +1,151 @@
+require 'sfrp/mono/environment'
+require 'sfrp/mono/expression'
+require 'sfrp/mono/function'
+require 'sfrp/mono/memory'
+require 'sfrp/mono/node'
+require 'sfrp/mono/pattern'
+require 'sfrp/mono/type'
+require 'sfrp/mono/vconst'
+require 'sfrp/mono/dsl'
+
+module SFRP
+  module Mono
+    class Set
+      def initialize(&block)
+        @func_h = {}
+        @node_h = {}
+        @type_h = {}
+        @vconst_h = {}
+        @output_node_strs = []
+        @init_func_strs = []
+        @type_alias_h = {}
+        @constructor_alias_h = {}
+        block.call(self) if block
+      end
+
+      def to_low(include_file_strs = [])
+        Low::Set.new do |low_set|
+          include_file_strs.each { |s| low_set << L.include_dq(s) }
+          @type_alias_h.each do |alias_str, original_str|
+            low_set << type(original_str).low_typedef_for_alias(alias_str)
+          end
+          @constructor_alias_h.each do |alias_str, original_str|
+            low_set << vconst(original_str).low_macro_for_alias(alias_str)
+          end
+          @func_h.values.each { |func| func.gen(self, low_set) }
+          @type_h.values.each { |type| type.gen(self, low_set) }
+          gen_main_func(low_set)
+        end
+      end
+
+      def check
+        # TODO: Check that all init_func does not waste any memory.
+        # TODO: Check completeness of pattern matchings.
+      end
+
+      def memory(type_str)
+        @memory ||= begin
+          to_init_nodes = nodes.reduce(Memory.empty) do |m, node|
+            m.and(node.memory_used_to_init_node(self))
+          end
+          to_hold_memoized_nodes = nodes.reduce(Memory.empty) do |m, node|
+            node.initialized? ? m.and(node.memory_used_to_hold_node(self)) : m
+          end
+          to_eval_nodes = nodes.reduce(Memory.empty) do |m, node|
+            m.and(node.memory_used_to_eval_node(self))
+          end
+          to_hold_memoized_nodes.and(to_eval_nodes).or(to_init_nodes)
+        end
+        @memory.count(type_str)
+      end
+
+      def <<(element)
+        case element
+        when Function
+          @func_h[element.str] = element
+        when Node
+          @node_h[element.str] = element
+        when Type
+          @type_h[element.str] = element
+        when VConst
+          @vconst_h[element.str] = element
+        else
+          raise
+        end
+      end
+
+      def append_output_node_str(output_node_str)
+        @output_node_strs << output_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 type(type_str)
+        raise type_str unless @type_h.key?(type_str)
+        @type_h[type_str]
+      end
+
+      def vconst(vconst_str)
+        raise vconst_str unless @vconst_h.key?(vconst_str)
+        @vconst_h[vconst_str]
+      end
+
+      def funcs
+        @func_h.values
+      end
+
+      def nodes
+        @node_h.values
+      end
+
+      def types
+        @type_h.values
+      end
+
+      def vconsts
+        @vconst_h.values
+      end
+
+      private
+
+      # All used nodes.
+      def used_nodes
+        node_strs = @output_node_strs.flat_map do |node_str|
+          node(node_str).sorted_node_strs(self)
+        end
+        node_strs.uniq.map { |node_str| node(node_str) }
+      end
+
+      # Generate the main-function.
+      def gen_main_func(dest_set)
+        dest_set << L.function('main', 'int') do |f|
+          f << L.stmt('int c = 0, l = 1')
+          used_nodes.each { |node| node.gen_node_var_declaration(self, f) }
+          @init_func_strs.each do |func_str|
+            f << L.stmt(func(func_str).low_call_exp([]))
+          end
+          used_nodes.each { |node| node.gen_initialize_stmt(self, f) }
+          f << L.while('1') do |wh|
+            @type_h.values.each { |type| type.gen_mark_cleanup_stmt(self, wh) }
+            used_nodes.each { |node| node.gen_node_var_mark_stmt(self, wh) }
+            used_nodes.each { |node| node.gen_evaluate_stmt(self, wh) }
+            wh << L.stmt('c ^= 1, l ^= 1')
+          end
+          f << L.stmt('return 0')
+        end
+      end
+    end
+  end
+end

data/lib/sfrp/mono/type.rb

@@ -0,0 +1,210 @@
+module SFRP
+  module Mono
+    class Type
+      attr_reader :str
+
+      def initialize(str, vconst_strs = nil, static = false, native_str = nil)
+        @str = str
+        @vconst_strs = vconst_strs
+        @static = static
+        @native_str = native_str
+      end
+
+      def comp
+        [@str, @vconst_strs, @static, @native_str]
+      end
+
+      def ==(other)
+        comp == other.comp
+      end
+
+      # Are objects of this type passed through value?
+      # Defalut is passing through referrence.
+      def static?
+        @static
+      end
+
+      # Does this type has infinite amount of vconsts?
+      def infinite?
+        @vconst_strs.nil?
+      end
+
+      # Is this type native type?
+      def native?
+        @native_str
+      end
+
+      # Does this type has single vconst of native type parameters
+      # e.g. Tuple3(Int, Int, Int)
+      def linear?(set)
+        single_vconst? && set.vconst(@vconst_strs[0]).native_args?(set)
+      end
+
+      # Does this type has only one vconst?
+      def single_vconst?
+        !infinite? && @vconst_strs.size == 1
+      end
+
+      # Do objects of this type need to be passed to mark-function?
+      def need_mark?(set)
+        return true unless static?
+        return false if infinite?
+        @vconst_strs.any? { |v_str| set.vconst(v_str).param_needing_mark?(set) }
+      end
+
+      def has_meta_in_struct?
+        !(static? && single_vconst?)
+      end
+
+      def all_pattern_examples(set)
+        return [Pattern::PatternExample.new(nil, [])] if infinite?
+        @vconst_strs.flat_map do |vc_str|
+          set.vconst(vc_str).all_pattern_examples(set)
+        end
+      end
+
+      # Return max memory size to hold an instance of this type.
+      def memory(set)
+        return Memory.one(@str) if infinite?
+        x = @vconst_strs.reduce(Memory.empty) do |m, v_str|
+          m.or(set.vconst(v_str).memory(set))
+        end
+        Memory.one(@str).and(x)
+      end
+
+      def low_typedef_for_alias(alias_str)
+        L.typedef("#{low_type_str} #{alias_str}")
+      end
+
+      def low_type_str
+        @native_str ? @native_str : @str
+      end
+
+      def low_allocator_str
+        "alloc_#{@str}"
+      end
+
+      def low_mark_func_str
+        "mark_#{@str}"
+      end
+
+      def meta_access_str(receiver_str)
+        "#{receiver_str}#{static? ? '.' : '->'}meta"
+      end
+
+      def terms_access_str(receiver_str)
+        "#{receiver_str}#{static? ? '.' : '->'}terms"
+      end
+
+      # Return term-id of given vconst of this type.
+      def term_id(vconst_str)
+        raise "#{@str} is infinite" if infinite?
+        res = @vconst_strs.index(vconst_str)
+        raise "#{vconst_str} is not a vconst of #{@str}" unless res
+        res
+      end
+
+      def low_member_pointers_for_single_vconst(set, receiver_str)
+        raise unless single_vconst?
+        set.vconst(@vconst_strs[0]).low_member_pointers(self, receiver_str)
+      end
+
+      # Generate C's elements for this type.
+      def gen(src_set, dest_set)
+        gen_struct(src_set, dest_set)
+        gen_typedef(src_set, dest_set)
+        gen_constructor(src_set, dest_set)
+        gen_allocator(src_set, dest_set)
+        gen_mark_function(src_set, dest_set)
+      end
+
+      # Generate statement to clean up objects of this types.
+      def gen_mark_cleanup_stmt(src_set, stmts)
+        return unless need_mark?(src_set)
+        return if src_set.memory(@str) == 0
+        stmts << L.stmt("#{low_allocator_str}(1)")
+      end
+
+      private
+
+      # Generate struct for this type.
+      def gen_struct(src_set, dest_set)
+        return if native? || infinite?
+        dest_set << L.struct(@str) do |top|
+          if has_meta_in_struct?
+            top << L.member_structure('struct', 'meta') do |meta|
+              meta << L.member('unsigned char term_id : 7')
+              meta << L.member('unsigned char mark : 1')
+            end
+          end
+          top << L.member_structure('union', 'terms') do |terms|
+            @vconst_strs.each_with_index do |v_str, term_id|
+              vconst = src_set.vconst(v_str)
+              vconst.gen_term_definition(src_set, term_id, terms)
+            end
+          end
+        end
+      end
+
+      # Generate typedef for this type.
+      def gen_typedef(_src_set, dest_set)
+        return if native?
+        asta = static? ? '' : '*'
+        dest_set << L.typedef("struct #{@str}#{asta} #{@str}")
+      end
+
+      # Generate constructor-functions for vconsts.
+      def gen_constructor(src_set, dest_set)
+        return if infinite?
+        @vconst_strs.each_with_index do |v_str, term_id|
+          src_set.vconst(v_str).gen_constructor(src_set, term_id, dest_set)
+        end
+      end
+
+      # Generate allocator-function for type.
+      def gen_allocator(src_set, dest_set)
+        return if static?
+        count = src_set.memory(@str)
+        memory_var = "memory_#{low_type_str}"
+        dest_set << L.function(low_allocator_str, low_type_str) do |f|
+          f.append_param('int', 'clean_up')
+          f << L.stmt('static int i = 0')
+          f << L.stmt("static struct #{low_type_str} #{memory_var}[#{count}]")
+          f << L.if_stmt('clean_up') do |if_stmts|
+            e = "#{memory_var}[i].meta.mark = 0"
+            if_stmts << L.stmt("for (i = 0; i < #{count}; i++) #{e}")
+            if_stmts << L.stmt('i = 0')
+            if_stmts << L.stmt('return 0')
+          end
+          f << L.stmt("while (#{memory_var}[i++].meta.mark)")
+          f << L.stmt("return #{memory_var} + (i - 1)")
+        end
+      end
+
+      # Generate mark function for this type.
+      def gen_mark_function(src_set, dest_set)
+        return unless need_mark?(src_set)
+        dest_set << L.function(low_mark_func_str, 'int') do |f|
+          f.append_param(low_type_str, 'target')
+          f << L.stmt("#{meta_access_str('target')}.mark = 1") unless static?
+          @vconst_strs.each_with_index do |v_str, term_id|
+            vconst = src_set.vconst(v_str)
+            cond_exps = vconst.low_compare_exps(src_set, 'target')
+            mark_exps = vconst.low_mark_element_exps(src_set, term_id, 'target')
+            next if mark_exps.empty?
+            mark_stmt = L.stmt(mark_exps.join(', '))
+            if cond_exps.empty?
+              f << mark_stmt
+            else
+              cond_exp = cond_exps.reduce { |a, e| "#{a} && #{e}" }
+              f << L.if_stmt(cond_exp) do |i|
+                i << mark_stmt
+              end
+            end
+          end
+          f << L.stmt('return 0')
+        end
+      end
+    end
+  end
+end