emfrp 0.0.1

data/examples/MostDistantPoint/MostDistantPoint.c

@@ -0,0 +1,199 @@
+#include "MostDistantPoint.h"
+/* Primitive functions (Macros) */
+#define _lt_(a, b) (a < b)
+#define _plus_(a, b) (a + b)
+#define _asterisk_(a, b) (a * b)
+#define _minus_(a, b) (a - b)
+/* Data types */
+struct Tuple2_Int_Int{
+  int mark;
+  union {
+    struct {
+      int member0;
+      int member1;
+    }Tuple2;
+  }value;
+};
+/* Global variables */
+int node_memory_inX[2];
+int node_memory_inY[2];
+struct Tuple2_Int_Int* node_memory_point[2];
+int node_memory_outX[2];
+int node_memory_outY[2];
+struct Tuple2_Int_Int memory_Tuple2_Int_Int[5];
+int size_Tuple2_Int_Int = 5;
+int counter_Tuple2_Int_Int = 0;
+int Counter = 1;
+int NodeSize = 3;
+/* Static prototypes */
+static struct Tuple2_Int_Int* Tuple2_0(int, int);
+static void mark_Tuple2_Int_Int(struct Tuple2_Int_Int*, int);
+static int node_point(int, int, struct Tuple2_Int_Int*, struct Tuple2_Int_Int**);
+static struct Tuple2_Int_Int* init_point();
+static int node_outX(struct Tuple2_Int_Int*, int*);
+static int init_outX();
+static int node_outY(struct Tuple2_Int_Int*, int*);
+static int init_outY();
+static int distant2_0(struct Tuple2_Int_Int*, struct Tuple2_Int_Int*);
+static int snd_0(struct Tuple2_Int_Int*);
+static int fst_0(struct Tuple2_Int_Int*);
+static void refreshMark();
+extern void Input(int*, int*);
+extern void Output(int*, int*);
+/* Functions, Constructors, GCMarkers, etc... */
+static struct Tuple2_Int_Int* Tuple2_0(int member0, int member1) {
+  struct Tuple2_Int_Int* x;
+  while (1) {
+    counter_Tuple2_Int_Int++;
+    counter_Tuple2_Int_Int %= size_Tuple2_Int_Int;
+    if (memory_Tuple2_Int_Int[counter_Tuple2_Int_Int].mark < Counter) { x = memory_Tuple2_Int_Int + counter_Tuple2_Int_Int; break; }
+  }
+  x->value.Tuple2.member0 = member0;
+  x->value.Tuple2.member1 = member1;
+  return x;
+}
+static void mark_Tuple2_Int_Int(struct Tuple2_Int_Int* x, int mark) {
+  x->mark = mark;
+}
+static int node_point(int inX, int inY, struct Tuple2_Int_Int* point_at_last, struct Tuple2_Int_Int** output) {
+  int _tmp001;
+  struct Tuple2_Int_Int* _tmp000;
+  _tmp001 = distant2_0(Tuple2_0(0, 0), point_at_last);
+  if (1) {
+    int _tmp003;
+    int pvar0_d1 = _tmp001;
+    struct Tuple2_Int_Int* _tmp002;
+    _tmp003 = distant2_0(Tuple2_0(0, 0), Tuple2_0(inX, inY));
+    if (1) {
+      int _tmp005;
+      int pvar1_d2 = _tmp003;
+      struct Tuple2_Int_Int* _tmp004;
+      _tmp005 = _lt_(pvar0_d1, pvar1_d2);
+      if (_tmp005 == 1) {
+        _tmp004 = Tuple2_0(inX, inY);
+      }
+      else if (_tmp005 == 0) {
+        _tmp004 = point_at_last;
+      }
+      _tmp002 = _tmp004;
+    }
+    _tmp000 = _tmp002;
+  }
+  *output = _tmp000;
+  return 1;
+}
+static struct Tuple2_Int_Int* init_point() {
+  return Tuple2_0(0, 0);
+}
+static int node_outX(struct Tuple2_Int_Int* point, int* output) {
+  int _tmp006;
+  if (1) {
+    struct Tuple2_Int_Int* pvar2_point = point;
+    int pvar2_outX = point->value.Tuple2.member0;
+    int pvar2_outY = point->value.Tuple2.member1;
+    _tmp006 = pvar2_outX;
+  }
+  *output = _tmp006;
+  return 1;
+}
+static int init_outX() {
+  struct Tuple2_Int_Int* _tmp008;
+  int _tmp007;
+  _tmp008 = Tuple2_0(0, 0);
+  if (1) {
+    struct Tuple2_Int_Int* pvar3_point = _tmp008;
+    int pvar3_outX = _tmp008->value.Tuple2.member0;
+    int pvar3_outY = _tmp008->value.Tuple2.member1;
+    _tmp007 = pvar3_outX;
+  }
+  return _tmp007;
+}
+static int node_outY(struct Tuple2_Int_Int* point, int* output) {
+  int _tmp009;
+  if (1) {
+    struct Tuple2_Int_Int* pvar4_point = point;
+    int pvar4_outX = point->value.Tuple2.member0;
+    int pvar4_outY = point->value.Tuple2.member1;
+    _tmp009 = pvar4_outY;
+  }
+  *output = _tmp009;
+  return 1;
+}
+static int init_outY() {
+  struct Tuple2_Int_Int* _tmp011;
+  int _tmp010;
+  _tmp011 = Tuple2_0(0, 0);
+  if (1) {
+    struct Tuple2_Int_Int* pvar5_point = _tmp011;
+    int pvar5_outX = _tmp011->value.Tuple2.member0;
+    int pvar5_outY = _tmp011->value.Tuple2.member1;
+    _tmp010 = pvar5_outY;
+  }
+  return _tmp010;
+}
+static int distant2_0(struct Tuple2_Int_Int* pointA, struct Tuple2_Int_Int* pointB) {
+  int _tmp013;
+  int _tmp012;
+  _tmp013 = _minus_(fst_0(pointA), fst_0(pointB));
+  if (1) {
+    int _tmp015;
+    int pvar6_dx = _tmp013;
+    int _tmp014;
+    _tmp015 = _minus_(snd_0(pointA), snd_0(pointB));
+    if (1) {
+      int pvar7_dy = _tmp015;
+      _tmp014 = _plus_(_asterisk_(pvar6_dx, pvar6_dx), _asterisk_(pvar7_dy, pvar7_dy));
+    }
+    _tmp012 = _tmp014;
+  }
+  return _tmp012;
+}
+static int snd_0(struct Tuple2_Int_Int* t) {
+  int _tmp016;
+  if (1) {
+    int pvar8_x = t->value.Tuple2.member0;
+    int pvar8_y = t->value.Tuple2.member1;
+    _tmp016 = pvar8_y;
+  }
+  return _tmp016;
+}
+static int fst_0(struct Tuple2_Int_Int* t) {
+  int _tmp017;
+  if (1) {
+    int pvar9_x = t->value.Tuple2.member0;
+    int pvar9_y = t->value.Tuple2.member1;
+    _tmp017 = pvar9_x;
+  }
+  return _tmp017;
+}
+static void refreshMark() {
+  int i;
+  for (i = 0; i < size_Tuple2_Int_Int; i++) {
+    if (memory_Tuple2_Int_Int[i].mark < Counter) memory_Tuple2_Int_Int[i].mark = 0;
+    else memory_Tuple2_Int_Int[i].mark -= Counter - 1;
+  }
+}
+void ActivateMostDistantPoint() {
+  int current_side = 0, last_side = 1;
+  node_memory_point[last_side] = init_point();
+  mark_Tuple2_Int_Int(node_memory_point[last_side], 1 + 3);
+  node_memory_outX[last_side] = init_outX();
+  node_memory_outY[last_side] = init_outY();
+  Counter = NodeSize + 1;
+  refreshMark();
+  while (1) {
+    Counter = 1;
+    Input(&node_memory_inX[current_side], &node_memory_inY[current_side]);
+    node_point(node_memory_inX[current_side], node_memory_inY[current_side], node_memory_point[last_side], &node_memory_point[current_side]);
+    mark_Tuple2_Int_Int(node_memory_point[current_side], Counter + 3);
+    Counter++;
+    node_outX(node_memory_point[current_side], &node_memory_outX[current_side]);
+    Counter++;
+    node_outY(node_memory_point[current_side], &node_memory_outY[current_side]);
+    Counter++;
+    Output(&node_memory_outX[current_side], &node_memory_outY[current_side]);
+    refreshMark();
+    current_side ^= 1;
+    last_side ^= 1;
+  }
+}

data/examples/MostDistantPoint/MostDistantPoint.h

@@ -0,0 +1,6 @@
+#ifndef MOSTDISTANTPOINT_H
+#define MOSTDISTANTPOINT_H
+
+void ActivateMostDistantPoint();
+
+#endif /* end of include guard */

data/examples/MostDistantPoint/MostDistantPoint.mfrp

@@ -0,0 +1,25 @@
+module MostDistantPoint
+in
+  inX : Int,  inY : Int
+out
+  outX, outY
+use
+  Std
+
+#@ :assert-equals 2, distant2((1, 1), (2, 2))
+func distant2(pointA, pointB) = {
+  dx = pointA.fst - pointB.fst
+  dy = pointA.snd - pointB.snd
+  dx * dx + dy * dy
+}
+
+node init[(0, 0)] (outX, outY) as point = {
+  d1 = distant2((0, 0), point@last)
+  d2 = distant2((0, 0), (inX, inY))
+  if d1 < d2 then (inX, inY) else point@last
+}
+
+#@ :assert-module
+#-   0, 0 => 0, 0
+#@ : 1, 1 => 1, 1
+#@ : 0, 0 => 1, 1

data/examples/MostDistantPoint/MostDistantPointMain.c

@@ -0,0 +1,14 @@
+#include "MostDistantPoint.h"
+#include <stdio.h>
+
+void Input(int* inX, int* inY) {
+  scanf("%d %d", inX, inY);
+}
+
+void Output(int* outX, int* outY) {
+  printf("%d %d\n", *outX, *outY);
+}
+
+int main() {
+  ActivateMostDistantPoint();
+}

data/examples/MostDistantPoint/graph.dot

@@ -0,0 +1,12 @@
+digraph MostDistantPoint {
+  inX [label = "inX : Int", shape = "invhouse"];
+  inY [label = "inY : Int", shape = "invhouse"];
+  point [label = "point : Tuple2[Int, Int]"];
+  outX [label = "outX : Int", style = filled, fillcolor = "#e4e4e4"];
+  outY [label = "outY : Int", style = filled, fillcolor = "#e4e4e4"];
+  point -> outX;
+  inX -> point;
+  inY -> point;
+  point -> point [style = dashed];
+  point -> outY;
+}

data/lib/emfrp/compile/c/alloc.rb

@@ -0,0 +1,200 @@
+module Emfrp
+  class AllocRequirement
+    def initialize(top)
+      @top = top
+      @alloc_table = AllocTable.new(top)
+      @sorted_nodes = @top[:dict][:sorted_nodes].map{|x| x.get}
+    end
+
+    def requirement
+      sorted_datas = @top[:dict][:sorted_datas].map{|x| x.get}
+      init_nodes = @sorted_nodes.select{|n| n[:init_exp]}
+      max_amount = Alloc.empty
+      max_amount = data_requirement(sorted_datas, max_amount)
+      max_amount = node_init_requirement(init_nodes, max_amount, sorted_datas)
+      max_amount = node_loop_requirement(max_amount, init_nodes, sorted_datas)
+      return max_amount
+    end
+
+    def data_requirement(sorted_datas, max_amount)
+      retains = []
+      sorted_datas.each do |d|
+        max_amount |= type_alloc_sum(retains) & exp_alloc(d[:exp])
+      end
+      return max_amount
+    end
+
+    def node_init_requirement(init_nodes, max_amount, datas)
+      retains = datas.clone
+      init_nodes.each do |n|
+        max_amount |= type_alloc_sum(retains) & exp_alloc(n[:init_exp])
+        retains << n
+      end
+      return max_amount
+    end
+
+    def node_loop_requirement(max_amount, init_nodes, datas)
+      lrefs = init_nodes
+      crefs = []
+      @sorted_nodes.each_with_index do |n, i|
+        max_amount |= type_alloc_sum(datas + lrefs + crefs) & exp_alloc(n[:exp])
+        crefs << n
+        lrefs.reject! do |x|
+          i >= ref_pos_last(x)
+        end
+        crefs.reject! do |x|
+          i >= ref_pos_current(x)
+        end
+      end
+      return max_amount
+    end
+
+    def ref_pos_last(node)
+      res = -1
+      @sorted_nodes.each_with_index do |n, i|
+        if n[:params].any?{|param| param[:last] && param[:name] == node[:name]}
+          res = i
+        end
+      end
+      return res
+    end
+
+    def ref_pos_current(node)
+      res = -1
+      @sorted_nodes.each_with_index do |n, i|
+        if n[:params].any?{|param| !param[:last] && param[:name] == node[:name]}
+          res = i
+        end
+      end
+      return res
+    end
+
+    def life_point(node)
+      self_position = @sorted_nodes.index{|x| x == node}
+      distance_to_end = @sorted_nodes.size - self_position
+      res = []
+      @sorted_nodes.each_with_index do |x, i|
+        x[:params].each do |param|
+          if param[:name] == node[:name]
+            if param[:last]
+              res << distance_to_end + i
+            else
+              res << i - self_position
+            end
+          end
+        end
+      end
+      if res == []
+        raise "Assertion error"
+      else
+        return res.max
+      end
+    end
+
+    def type_alloc_sum(defs)
+      defs.inject(Alloc.empty) do |acc, d|
+        type_def = @alloc_table.utype_to_type_def(d[:typing])
+        acc & @alloc_table.type_alloc(type_def)
+      end
+    end
+
+    def exp_alloc(exp)
+      @alloc_table.exp_alloc(exp)
+    end
+  end
+
+  class AllocTable
+    def initialize(top)
+      @top = top
+      @tbl = {}
+      @type_tbl = {}
+    end
+
+    def utype_to_type_def(utype)
+      if t = @top[:dict][:itype_space][utype.to_uniq_str]
+        t.get
+      elsif t = @top[:dict][:type_space][utype.typename]
+        t.get
+      else
+        raise "Assertion error"
+      end
+    end
+
+    def type_alloc(type_def)
+      return @type_tbl[type_def] if @type_tbl[type_def]
+      case type_def
+      when TypeDef
+        tvalue_type_max_allocs = type_def[:tvalues].map do |tval|
+          param_type_max_allocs = tval[:params].map do |param|
+            type_alloc(utype_to_type_def(param[:typing]))
+          end
+          param_type_max_allocs.inject(Alloc.empty, &:&)
+        end
+        self_type_alloc = type_def[:static] ? Alloc.empty : Alloc.one(Link.new(type_def))
+        @type_tbl[type_def] = tvalue_type_max_allocs.inject(&:|) & self_type_alloc
+      when PrimTypeDef
+        @type_tbl[type_def] = Alloc.empty
+      end
+    end
+
+    def exp_alloc(exp)
+      return @tbl[exp] if @tbl[exp]
+      case exp
+      when MatchExp
+        @tbl[exp] = exp[:cases].map{|c| exp_alloc(c[:exp])}.inject(&:|) & exp_alloc(exp[:exp])
+      when FuncCall
+        args_alloc = exp[:args].map{|x| exp_alloc(x)}.inject(&:&)
+        key = ([exp] + exp[:args]).map{|x| x[:typing].to_uniq_str} + [exp[:name][:desc]]
+        if @top[:dict][:ifunc_space][key]
+          f = @top[:dict][:ifunc_space][key].get
+          @tbl[exp] = args_alloc & exp_alloc(f[:exp])
+        elsif f = @top[:dict][:func_space][exp[:name][:desc]]
+          if f.get.is_a?(PrimFuncDef)
+            @tbl[exp] = args_alloc
+          else
+            raise "Assertion error"
+          end
+        else
+          raise "Assertion error"
+        end
+      when ValueConst
+        args_alloc = exp[:args].map{|x| exp_alloc(x)}.inject(Alloc.empty, &:&)
+        key = exp[:typing].to_uniq_str
+        raise "Assertion error" unless @top[:dict][:itype_space][key]
+        type_def = @top[:dict][:itype_space][key].get
+        @tbl[exp] = args_alloc & Alloc.one(Link.new(type_def))
+      when Syntax
+        @tbl[exp] = Alloc.empty
+      else
+        raise "Assertion error"
+      end
+    end
+  end
+
+  class Alloc
+    attr_reader :h
+    def initialize(hash)
+      @h = hash
+    end
+
+    def self.empty
+      self.new({})
+    end
+
+    def self.one(k)
+      self.new(k => 1)
+    end
+
+    def |(other)
+      Alloc.new self.h.merge(other.h){|k, v1, v2| [v1, v2].max}
+    end
+
+    def &(other)
+      Alloc.new self.h.merge(other.h){|k, v1, v2| v1 + v2}
+    end
+
+    def each(&block)
+      @h.each(&block)
+    end
+  end
+end

data/lib/emfrp/compile/c/codegen.rb

@@ -0,0 +1,18 @@
+require 'emfrp/compile/c/monofy'
+require 'emfrp/compile/c/alloc'
+require 'emfrp/compile/c/codegen_context'
+require 'emfrp/compile/c/syntax_codegen'
+
+module Emfrp
+  module Codegen
+    extend self
+
+    def codegen(top, c_output, h_output, main_output, name)
+      Monofy.monofy(top)
+      ct = CodegenContext.new(top)
+      ar = AllocRequirement.new(top)
+      top.codegen(ct, ar)
+      ct.code_generate(c_output, h_output, main_output, name)
+    end
+  end
+end

data/lib/emfrp/compile/c/codegen_context.rb

@@ -0,0 +1,215 @@
+module Emfrp
+  class CodegenContext
+    SymbolToStr = {
+      "!" => "_exclamation_",
+      "#" => "_hash_",
+      "$" => "_dollar_",
+      "%" => "_parcent_",
+      "&" => "_anpersand",
+      "*" => "_asterisk_",
+      "+" => "_plus_",
+      "." => "_dot_",
+      "/" => "_slash_",
+      "<" => "_lt_",
+      "=" => "_eq_",
+      ">" => "_gt_",
+      "?" => "_question_",
+      "@" => "_at_",
+      "\\" => "_backslash_",
+      "^" => "_caret_",
+      "|" => "_vertial_",
+      "-" => "_minus_",
+      "~" => "_tilde_"
+    }
+
+    def initialize(top)
+      @top = top
+      @global_vars = []
+      @funcs = []
+      @structs = []
+      @protos = []
+      @static_protos = []
+      @macros = []
+      @init_stmts = []
+      @templates = []
+    end
+
+    def code_generate(c_output, h_output, main_output, name)
+      #  generate header-file
+      h_output << "#ifndef #{name.upcase}_H\n"
+      h_output << "#define #{name.upcase}_H\n\n"
+      @protos.each do |x|
+        h_output.puts x.to_s
+      end
+      h_output << "\n#endif /* end of include guard */\n"
+      # generate library-file
+      c_output.puts "#include \"#{name}.h\""
+      c_output.puts "/* Primitive functions (Macros) */"
+      @macros.each do |x|
+        c_output.puts x.to_s
+      end
+      c_output.puts "/* Data types */"
+      @structs.each do |x|
+        c_output.puts x.to_s
+      end
+      c_output.puts "/* Global variables */"
+      @global_vars.each do |x|
+        c_output.puts x.to_s
+      end
+      c_output.puts "/* Static prototypes */"
+      @static_protos.each do |x|
+        c_output.puts x.to_s
+      end
+      c_output.puts "/* Functions, Constructors, GCMarkers, etc... */"
+      @funcs.each do |x|
+        c_output.puts x.to_s
+      end
+      # generate main-file
+      main_output << "#include \"#{name}.h\"\n\n"
+      main_output << "void Input(#{@top[:inputs].map{|x| "#{tref(x)}* #{x[:name][:desc]}"}.join(", ")}) {\n  /* Your code goes here... */\n}\n"
+      main_output << "void Output(#{@top[:outputs].map{|x| "#{tref(x)}* #{x[:name][:desc]}"}.join(", ")}) {\n  /* Your code goes here... */\n}\n"
+      main_output << "int main() {\n  Activate#{@top[:module_name][:desc]}();\n}\n"
+    end
+
+    def init_stmts
+      @init_stmts
+    end
+
+    def func_name(name, ret_utype, arg_utypes)
+      case f = @top[:dict][:func_space][name].get
+      when PrimFuncDef
+        f.func_name(self)
+      when FuncDef
+        key = [ret_utype, *arg_utypes].map(&:to_uniq_str) + [name]
+        @top[:dict][:ifunc_space][key].get.func_name(self)
+      else
+        raise "Assertion error: unexpected func type #{f.class}"
+      end
+    end
+
+    def constructor_name(name, utype)
+      @top[:dict][:itype_space][utype.to_uniq_str].get[:tvalues].each do |tval|
+        if tval[:name][:desc] == name
+          return tval.constructor_name(self)
+        end
+      end
+      raise "Assertion error: #{name} is not found"
+    end
+
+    def escape_name(name)
+      rexp = Regexp.new("[" + Regexp.escape(SymbolToStr.keys.join) + "]")
+      name.gsub(rexp, SymbolToStr)
+    end
+
+    def tdef(x)
+      case x
+      when Typing::UnionType
+        key = x.to_uniq_str
+        if @top[:dict][:type_space][key] && @top[:dict][:type_space][key].get.is_a?(PrimTypeDef)
+          @top[:dict][:type_space][key].get
+        elsif @top[:dict][:itype_space][key]
+          @top[:dict][:itype_space][key].get
+        else
+          raise "Assertion error: itype #{x.to_uniq_str} is undefined"
+        end
+      when Syntax
+        tdef(x[:typing])
+      else
+        raise "Assertion error"
+      end
+    end
+
+    def tref(x)
+      tdef(x).ref_name(self)
+    end
+
+    def serial(key, id)
+      @serials ||= Hash.new{|h, k| h[k] = []}
+      @serials[key] << id unless @serials[key].find{|x| x == id}
+      return @serials[key].index{|x| x == id}
+    end
+
+    def uniq_id_gen
+      @uniq_ids ||= (0..1000).to_a
+      @uniq_ids.shift
+    end
+
+    def define_global_var(type_str, name_str, initial_value_str=nil)
+      @global_vars << "#{type_str} #{name_str}" + (initial_value_str ? " = #{initial_value_str}" : "") + ";"
+    end
+
+    def define_macro(name_str, params, body_str)
+      @macros << "#define #{name_str}(#{params.join(", ")}) (#{body_str})"
+    end
+
+    def define_func(type_str, name_str, params, accessor=:static, with_proto=true, &block)
+      elements = []
+      proc.call(elements)
+      case accessor
+      when :none then deco = ""
+      when :static then deco = "static "
+      end
+      define_proto(type_str, name_str, params.map(&:first), accessor) if with_proto
+      @funcs << Block.new("#{deco}#{type_str} #{name_str}(#{params.map{|a, b| "#{a} #{b}"}.join(", ")}) {", elements, "}")
+      return nil
+    end
+
+    def define_proto(type_str, name_str, param_types, accessor=:static)
+      case accessor
+      when :none then deco = ""
+      when :static then deco = "static "
+      when :extern then deco = "extern "
+      end
+      proto = "#{deco}#{type_str} #{name_str}(#{param_types.join(", ")});"
+      if accessor == :static || accessor == :extern
+        @static_protos << proto
+      else
+        @protos << proto
+      end
+      return nil
+    end
+
+    def define_init_stmt(stmt)
+      @init_stmts << stmt
+    end
+
+    def define_struct(kind_str, name_str, var_name_str)
+      elements = []
+      proc.call(elements)
+      x = Block.new("#{kind_str} #{name_str}{", elements, "}#{var_name_str};")
+      if name_str
+        @structs << x
+        return nil
+      else
+        return x
+      end
+    end
+
+    def make_block(head_str, elements, foot_str)
+      Block.new(head_str, elements, foot_str)
+    end
+
+    class Block
+      T = (0..20).map{|i| "  " * i}
+      def initialize(head_str, elements, foot_str)
+        @head_str = head_str
+        @elements = elements
+        @foot_str = foot_str
+      end
+
+      def to_s(t=0)
+        res = ""
+        res << T[t] + @head_str + "\n"
+        @elements.each do |e|
+          case e
+          when Block
+            res << e.to_s(t+1) + "\n"
+          when String
+            res << T[t+1] + e + "\n"
+          end
+        end
+        res << T[t] + @foot_str
+      end
+    end
+  end
+end