emfrp 0.0.1

data/lib/emfrp/compile/graphviz/graphviz.rb

@@ -0,0 +1,49 @@
+module Emfrp
+  module Graphviz
+    extend self
+
+    def compile(top, output_io)
+      node_stmts, edge_stmts = [], []
+      visited = {}
+      top[:outputs].each do |n|
+        node = top[:dict][:node_space][n[:name][:desc]].get
+        traverse(top, node, node_stmts, edge_stmts, visited)
+      end
+      output_io << "digraph #{top[:module_name][:desc]} {\n"
+      node_stmts.each do |s|
+        output_io << "  #{s}\n"
+      end
+      edge_stmts.each do |s|
+        output_io << "  #{s}\n"
+      end
+      output_io << "}\n"
+    end
+
+    def traverse(top, node, node_stmts, edge_stmts, visited)
+      return if visited[node]
+      visited[node] = true
+      name = node[:name][:desc]
+      type = node[:typing].to_uniq_str
+      node_attrs = ["label = \"#{name} : #{type}\""]
+      case node
+      when NodeDef
+        if top[:outputs].find{|o| o[:name] == node[:name]}
+          node_attrs += ["style = filled", "fillcolor = \"#e4e4e4\""]
+        end
+        node[:params].each do |n|
+          ch_name = n[:name][:desc]
+          if n[:last]
+            edge_stmts << "#{ch_name} -> #{name} [style = dashed];"
+          else
+            edge_stmts << "#{ch_name} -> #{name};"
+          end
+          ch_node = top[:dict][:node_space][ch_name].get
+          traverse(top, ch_node, node_stmts, edge_stmts, visited)
+        end
+      when InputDef
+        node_attrs << "shape = \"invhouse\""
+      end
+      node_stmts << "#{name} [#{node_attrs.join(", ")}];"
+    end
+  end
+end

data/lib/emfrp/compile_error.rb

@@ -0,0 +1,95 @@
+require 'colorize'
+
+module Emfrp
+  class CompileError < RuntimeError
+    attr_reader :message, :factors
+
+    def initialize(message, code, *factors)
+      @message = message
+      @code = message
+      @factors = factors
+    end
+
+    def code
+      @code
+    end
+
+    def tag_comp(a, b)
+      [a[:line_number], a[:column_number]] <=> [b[:line_number], b[:column_number]]
+    end
+
+    def collect_factor_tags(factor)
+      case factor
+      when Syntax
+        if factor.has_key?(:start_pos)
+          collect_factor_tags(factor.values) + [[factor[:start_pos], factor[:end_pos]]]
+        else
+          collect_factor_tags(factor.values)
+        end
+      when Array
+        factor.flat_map{|x| collect_factor_tags(x)}
+      else
+        []
+      end
+    end
+
+    def find_factor_file_name(factor)
+      case factor
+      when Syntax
+        if factor.has_key?(:start_pos)
+          return factor[:start_pos][:document_name]
+        else
+          return find_factor_file_name(factor.values)
+        end
+      when Array
+        factor.each do |x|
+          if res = find_factor_file_name(x)
+            return res
+          end
+        end
+      end
+      nil
+    end
+
+    def factor_name(factor)
+      klass = factor.class.name.split("::").last
+      if factor.is_a?(Syntax)
+        name = factor.has_key?(:name) ? "`#{factor[:name][:desc]}`" : ""
+      else
+        name = factor.inspect
+      end
+      klass + " " + name
+    end
+
+    def print_lexical_factor(factor, output_io, file_loader)
+      src_lines = nil
+      unless factor_file_name = find_factor_file_name(factor)
+        raise "assertion error: cannot detect file_name"
+      end
+      src_str = file_loader.get_src_from_full_path(factor_file_name)
+      src_lines = src_str.each_line.to_a
+      tags = collect_factor_tags(factor)
+      spos = tags.map{|x| x[0]}.min{|a, b| tag_comp(a, b)}
+      epos = tags.map{|x| x[1]}.max{|a, b| tag_comp(a, b)}
+      line_nums = (spos[:line_number]..epos[:line_number]).to_a
+      if line_nums.size == 1
+        output_io << "#{factor_file_name}:#{line_nums[0]}:\n"
+        output_io << "> " + src_lines[line_nums[0] - 1].chomp + "\n"
+        output_io << "  " + " " * (spos[:column_number] - 1)
+        output_io << ("^" * (epos[:column_number] - spos[:column_number] + 1)).colorize(:green) + "\n"
+      else
+        output_io << "#{factor_file_name}:#{line_nums.first}-#{line_nums.last}:\n"
+        line_nums.each do |line_num|
+          output_io << "> " + src_lines[line_num - 1]
+        end
+      end
+    end
+
+    def print_error(output_io, file_loader)
+      output_io << "\e[31m[Error]\e[m: #{@message}"
+      @factors.each do |factor|
+        print_lexical_factor(factor, output_io, file_loader)
+      end
+    end
+  end
+end

data/lib/emfrp/interpreter/command_manager.rb

@@ -0,0 +1,367 @@
+require 'emfrp/compile/graphviz/graphviz'
+
+module Emfrp
+  class Interpreter
+    class CommandManager
+      def initialize(interpreter, &proc)
+        @interpreter = interpreter
+        @command_names = []
+        @command_tbl = {}
+        @command_desc_tbl = {}
+        @command_usage_tbl = {}
+        @command_example_tbl = {}
+        @command_desc_buf = []
+        @command_usage_buf = []
+        @command_example_buf = []
+        instance_exec(&proc)
+      end
+
+      def command(*names, &proc)
+        names.each do |name|
+          @command_names << ":" + name
+          @command_tbl[name] = proc
+          @command_desc_tbl[name] = @command_desc_buf
+          @command_usage_tbl[name] = @command_usage_buf
+          @command_example_tbl[name] = @command_example_buf
+          @command_desc_buf, @command_usage_buf, @command_example_buf = [], [], []
+        end
+      end
+
+      def desc(str)
+        @command_desc_buf << str
+      end
+
+      def usage(str)
+        @command_usage_buf << str
+      end
+
+      def example(str)
+        @command_example_buf << str
+      end
+
+      def print_usage(command_name, output_io)
+        if @command_tbl[command_name]
+          output_io.puts ":#{command_name}".colorize(:light_blue)
+          output_io.puts @command_desc_tbl[command_name].map{|x| "  " + x}.join("\n")
+          if @command_usage_tbl[command_name].size > 0
+            output_io.puts "  Usage:".colorize(:green)
+            output_io.puts @command_usage_tbl[command_name].map{|x| "    " + x}.join("\n")
+          end
+          if @command_example_tbl[command_name].size > 0
+            output_io.puts "  Example:".colorize(:green)
+            output_io.puts @command_example_tbl[command_name].map{|x| "    " + x}.join("\n")
+          end
+          return nil
+        else
+          return :command_not_found
+        end
+      end
+
+      def print_all_usages(output_io)
+        @command_tbl.keys.sort.each do |name|
+          print_usage(name, output_io)
+        end
+        return nil
+      end
+
+      def exec(command_name, arg, readline_id)
+        if @command_tbl[command_name]
+          @interpreter.instance_exec(arg, command_name, readline_id, &@command_tbl[command_name])
+        else
+          @interpreter.puts "Error: undefined command `#{command_name}'"
+          return :exec_error
+        end
+      end
+
+      def completion_proc
+        proc do |s|
+          @command_names.select{|name| name.index(s) == 0}
+        end
+      end
+
+      def self.make(interpreter)
+        CommandManager.new(interpreter) do
+
+          desc "Showing object type by specifying it's name."
+          example "data x = 1"
+          example ":t x"
+          command "t" do |arg|
+            name = arg.strip
+            if f = @top[:dict][:func_space][name]
+              puts "func #{name} : " + f.get[:params].map{|x| x[:typing].inspect}.join(", ") +
+              " -> " + f.get[:typing].inspect
+            end
+            if d = @top[:dict][:data_space][name]
+              puts "data #{name} : " + d.get[:typing].inspect
+            end
+            if t = @top[:dict][:type_space][name]
+              case t.get
+              when TypeDef
+                puts "Type #{name} : " + t.get[:tvalues][0][:typing].inspect
+              when PrimTypeDef
+                puts "PrimType #{name} : " + name
+              end
+            end
+            if c = @top[:dict][:const_space][name]
+              puts "constructor #{name} : " + c.get[:params].map{|x| x[:typing].inspect}.join(", ") +
+              " -> " + c.get[:typing].inspect
+            end
+            if n = @top[:dict][:node_space][name]
+              puts "node #{name} : " + n.get[:typing].inspect
+            end
+            next nil
+          end
+
+          desc "Showing internal AST by specifying element's name."
+          command "ast" do |arg|
+            name = arg.strip
+            if f = @top[:dict][:func_space][name]
+              pp f.get
+            elsif d = @top[:dict][:data_space][name]
+              pp d.get
+            elsif t = @top[:dict][:type_space][name]
+              pp t.get
+            elsif c = @top[:dict][:const_space][name]
+              pp c.get
+            elsif n = @top[:dict][:node_space][name]
+              pp n.get
+            elsif name == "top"
+              pp @top
+            elsif name == "ifuncs"
+              pp @top[:dict][:ifuncs_space].keys
+            elsif name == "itypes"
+              pp @top[:dict][:itypes_space].keys
+            else
+              puts "Error: `#{name}' is not found"
+              next :target_not_found
+            end
+            next nil
+          end
+
+          desc "Testing two expression's equality."
+          usage ":assert-equals <expected-exp>, <testing-exp>"
+          command "assert-equals" do |arg, c, rid|
+            if exp = str_to_exp("Pair(#{arg})")
+              val1 = Evaluater.eval_exp(@top, exp[:args][0])
+              val2 = Evaluater.eval_exp(@top, exp[:args][1])
+              if val1 == val2
+                nil
+              else
+                puts "Assertion failed".colorize(:red)
+                puts "Description: #{arg}"
+                puts "Type: #{exp[:args][0][:typing].inspect.colorize(:green)}"
+                puts "Expected: #{Evaluater.value_to_s(val1)}"
+                puts "Actual:   #{Evaluater.value_to_s(val2)}"
+                :assertion_error
+              end
+            else
+              :command_format_error
+            end
+          end
+
+          desc "Executing all commands embeded on source-files."
+          command "exec-embeded-commands" do
+            exec_embeded_commands()
+          end
+
+          desc "Define documentation about function. (in preparation)"
+          command "set-func-doc" do |arg|
+            nil
+          end
+
+          desc "Testing node as function."
+          usage ":assert-node <node-name> <input-exp>* => <expected-output-exp>"
+          example ":assert-node mynode 1, 2 => 3"
+          command "assert-node" do |arg|
+            if arg =~ /^\s*([a-z][a-zA-Z0-9]*)\s+(.*)=>(.*)$/
+              n = @top[:dict][:node_space][$1]
+              if n && n.get.is_a?(NodeDef)
+                node_def = n.get
+                types = ["Unit", "Unit"] + node_def[:params].map{|x| x[:typing].to_uniq_str}
+                exp_str = ($2.strip == "" ? "(Unit, Unit)" : "(Unit, Unit, #{$2.strip})")
+                if a_exp = str_to_exp(exp_str, "(#{types.join(", ")})")
+                  v1 = Evaluater.eval_node_as_func(@top, node_def, a_exp[:args].drop(2))
+                  if $3.strip == "skip"
+                    v2 = :skip
+                  elsif r_exp = str_to_exp($3.strip, "#{node_def[:typing].to_uniq_str}")
+                    v2 = Evaluater.eval_exp(@top, r_exp)
+                  else
+                    puts "Error: invalid expected-return-expression"
+                    next :assert_node_error1
+                  end
+                  if v1 == v2
+                    next nil
+                  else
+                    puts "Node Assertion failed".colorize(:red)
+                    puts "Description: #{arg}"
+                    puts "Expected: #{Evaluater.value_to_s(v2)}"
+                    puts "Actual:   #{Evaluater.value_to_s(v1)}"
+                    next :assertion_error
+                  end
+                else
+                  puts "Error: invalid node-argument-expression"
+                  next :assert_node_error2
+                end
+              else
+                puts "Error: invalid node name #{$1}"
+                next :assert_node_error3
+              end
+            else
+              next :command_format_error
+            end
+          end
+
+          desc "Testing whole-module by feeding inputs."
+          usage ":assert-module <input-exp>* => <expected-ouput-exp>*"
+          example ":assert-module 1, 2 => 2, 4"
+          command "assert-module" do |arg|
+            if arg =~ /^(.*)=>(.*)$/
+              input_types = ["Unit", "Unit"] + @top[:inputs].map{|x| x[:typing].to_uniq_str}
+              exp_str = ($1.strip == "" ? "(Unit, Unit)" : "(Unit, Unit, #{$1.strip})")
+              input_exps = str_to_exp(exp_str, "(#{input_types.join(", ")})")
+              output_types = @top[:outputs].map{|x| x[:typing].to_uniq_str}
+              output_exps = str_to_exp("(Unit, #{$2})", "(Unit, #{output_types.join(", ")})")
+              if input_exps == nil || output_exps == nil
+                puts "Error: invalid expression"
+                next :assert_module_error1
+              end
+              # evaluate
+              last_state = @current_state ? @current_state.clone : nil
+              @current_state = {}
+              @node_replacement ||= {}
+              output_vals = Evaluater.eval_module(@top, input_exps[:args].drop(2),
+                @current_state, last_state, @node_replacement)
+              expected_output_vals = output_exps[:args].drop(1).map{|x| Evaluater.eval_exp(@top, x)}
+              # assert
+              if expected_output_vals != output_vals
+                puts "Module Assertion failed".colorize(:red)
+                puts "Description: #{arg}"
+                puts "Expected: #{expected_output_vals.map{|x| Evaluater.value_to_s(x)}.join(", ")}"
+                puts "Actual:   #{output_vals.map{|x| Evaluater.value_to_s(x)}.join(", ")}"
+                :assertion_error
+              else
+                nil
+              end
+            else
+              :command_format_error
+            end
+          end
+
+          desc "Testing expression's type."
+          usage ":assert-type: <exp> => <type>"
+          command "assert-type" do |arg|
+            if arg =~ /^(.*)=>(.*)$/
+              if exp = str_to_exp($1.strip)
+                if exp[:typing].to_uniq_str == $2.strip
+                  next nil
+                else
+                  puts "Type Assertion failed".colorize(:red)
+                  puts "Description: #{$1.strip}"
+                  puts "Expected: #{$2.strip}"
+                  puts "Actual:   #{exp[:typing].to_uniq_str}"
+                  next :assertion_error
+                end
+              end
+            end
+            next :command_format_error
+          end
+
+          desc "Testing that specified command finishes with specified error-code"
+          usage ":assert-error <expected-error-code> => <testing-command>"
+          example ":assert-error assertion_error => :assert-type 1 => Double"
+          command "assert-error" do |arg|
+            if arg =~ /^\s*([a-z][a-zA-Z0-9_]*)\s*=>\s*(.*)$/
+              expected_error_code = $1
+              res = disable_io{ process_repl_line($2) }
+              if res.to_s == expected_error_code
+                next nil
+              else
+                puts "Error-Assertion error"
+                puts "Expected error-code: #{expected_error_code}"
+                puts "Actual error-code: #{res}"
+                next :assertion_error
+              end
+            else
+              next :command_format_error
+            end
+          end
+
+          desc "Replace one node to another like Stab."
+          desc "currently, this is only for testing (command-line assertion)."
+          usage ":replace-node <replaced-node-name> => <alternative-node-name>"
+          command "replace-node" do |arg|
+            if arg =~ /^\s*([a-z][a-zA-Z0-9]*)\s*=>\s*([a-z][a-zA-Z0-9]*)\s*$/
+              real_n_ln, dummy_n_ln = @top[:dict][:node_space][$1], @top[:dict][:node_space][$2]
+              unless real_n_ln
+                puts "Error: Node `#{$1}' is undefined"
+                next :replace_node_err1
+              end
+              unless dummy_n_ln
+                puts "Error: Node `#{$2}' is undefined"
+                next :replace_node_err2
+              end
+              unless real_n_ln.get[:typing].to_uniq_str == dummy_n_ln.get[:typing].to_uniq_str
+                puts "Error: Types of Real-Node `#{$1}' and Dummy-Node `#{$2}' are different"
+                puts "#{$1} : #{real_n_ln.get[:typing].to_uniq_str}"
+                puts "#{$2} : #{dummy_n_ln.get[:typing].to_uniq_str}"
+                next :replace_node_err3
+              end
+              collect_deps = proc do |node|
+                if node.is_a?(NodeDef)
+                  [node] + node[:params].reject{|x| x[:last]}.map{|p|
+                    collect_deps.call(@top[:dict][:node_space][p[:name][:desc]].get)
+                  }.flatten
+                else
+                  [node]
+                end
+              end
+              c1 = collect_deps.call(dummy_n_ln.get).find{|x| x[:name] == real_n_ln.get[:name]}
+              c2 = collect_deps.call(real_n_ln.get).find{|x| x[:name] == dummy_n_ln.get[:name]}
+              unless c1 == nil && c2 == nil
+                puts "Error: Real-Node `#{$1}' and Dummy-Node `#{$2}' are on depending relation"
+                next :replace_node_err4
+              end
+              if real_n_ln.get[:init_exp] && !dummy_n_ln.get[:init_exp]
+                puts "Error: Dummy-Node `#{$2}' should have init-exp"
+                next :replace_node_err5
+              end
+              @node_replacement ||= {}
+              @node_replacement[$1] = dummy_n_ln.get
+              next nil
+            else
+              next :command_format_error
+            end
+          end
+
+          desc "Compiling module-file into c-program code."
+          desc "Target file-name is currently fixed..."
+          desc "(module-name is used and files are dumped on current-dir)"
+          usage ":compile"
+          command "compile" do
+            next compile_default()
+          end
+
+          desc "Compiling module-file into graphviz-source code (.dot file)."
+          desc "If file-name is given as a command-argument, the code is output to it."
+          desc "Otherwise, the code is output on console."
+          example ":compile-dot graph.dot"
+          command "compile-dot" do |arg|
+            if arg.strip != ""
+              File.open(arg, "w") do |f|
+                Graphviz.compile(@top, f)
+              end
+            else
+              Graphviz.compile(@top, @output_io)
+            end
+          end
+
+          desc "Showing usage of all commands."
+          command "commands" do
+            @command_manager.print_all_usages(@output_io)
+          end
+
+        end
+      end
+    end
+  end
+end

data/lib/emfrp/interpreter/evaluater.rb

@@ -0,0 +1,146 @@
+module Emfrp
+  class Interpreter
+    module Evaluater
+      extend self
+
+      def eval_exp(top, exp, env={})
+        case exp
+        when FuncCall
+          case f = top[:dict][:func_space][exp[:name][:desc]].get
+          when PrimFuncDef
+            if ruby_exp = f[:foreigns].find{|x| x[:language][:desc] == "ruby"}
+              proc_str = "proc{|#{f[:params].map{|x| x[:name][:desc]}.join(",")}| #{ruby_exp[:desc]}}"
+              return eval(proc_str).call(*exp[:args].map{|e| eval_exp(top, e, env)})
+            else
+              raise "Primitive Function `#{f[:name][:desc]}` is not defined for ruby"
+            end
+          when FuncDef
+            f[:params].map{|param| [param[:name], Link.new(f)]}.zip(exp[:args]).each do |key, arg|
+              env[key] = eval_exp(top, arg, env)
+            end
+            return eval_exp(top, f[:exp], env)
+          end
+        when ValueConst
+          return [exp[:name][:desc].to_sym] + exp[:args].map{|e| eval_exp(top, e, env)}
+        when LiteralIntegral
+          return exp[:entity][:desc].to_i
+        when LiteralChar
+          return exp[:entity].ord
+        when LiteralFloating
+          return exp[:entity][:desc].to_f
+        when VarRef
+          key = [exp[:name], exp[:binder]]
+          unless env[key]
+            if exp[:binder].get.is_a?(DataDef)
+              env[key] = eval_exp(top, exp[:binder].get[:exp], env)
+            else
+              raise "Assertion error: #{key} is unbound"
+            end
+          end
+          return env[key]
+        when ParenthExp
+          return eval_exp(top, exp[:exp], env)
+        when MatchExp
+          left_val = eval_exp(top, exp[:exp], env)
+          exp[:cases].each do |c|
+            if match_result = pattern_match(c, left_val)
+              return eval_exp(top, c[:exp], env.merge(match_result))
+            end
+          end
+          raise "pattern match fail"
+        when SkipExp
+          throw :skip, :skip
+        else
+          raise "Unexpected expression type #{exp.class} (bug)"
+        end
+      end
+
+      def eval_node_as_func(top, node_def, exps)
+        env = {}
+        if node_def[:params].size != exps.size
+          raise "Assertion error: invalid length of args"
+        end
+        node_def[:params].map{|param| [param[:as], Link.new(node_def)]}.zip(exps).each do |key, arg|
+          env[key] = eval_exp(top, arg, env)
+        end
+        return catch(:skip) do
+          return eval_exp(top, node_def[:exp], env)
+        end
+      end
+
+      def eval_module(top, input_exps, current_state, last_state, replacement)
+        top[:inputs].zip(input_exps).each do |i, e|
+          current_state[i] = eval_exp(top, e)
+        end
+        unless last_state
+          last_state = {}
+          (top[:inputs] + top[:nodes]).each do |d|
+            last_state[d] = eval_exp(top, d[:init_exp]) if d[:init_exp]
+          end
+        end
+        (top[:inputs] + top[:nodes]).each do |d|
+          eval_node(top, d, current_state, last_state, replacement)
+        end
+        return top[:outputs].map do |x|
+          eval_node(top, top[:dict][:node_space][x[:name][:desc]].get, current_state, last_state, replacement)
+        end
+      end
+
+      def eval_node(top, node_def, current_state, last_state, replacement)
+        if replacement[node_def[:name][:desc]]
+          rep_node = replacement[node_def[:name][:desc]]
+          return eval_node(top, rep_node, current_state, last_state, replacement)
+        end
+        return current_state[node_def] if current_state[node_def]
+        env = {}
+        node_def[:params].each do |param|
+          key = [param[:as], Link.new(node_def)]
+          pn = top[:dict][:node_space][param[:name][:desc]].get
+          if param[:last]
+            raise "Assertion error" unless last_state[pn]
+            if rep_node = replacement[param[:name][:desc]]
+              env[key] = last_state[rep_node]
+            else
+              env[key] = last_state[pn]
+            end
+          else
+            env[key] = eval_node(top, pn, current_state, last_state, replacement)
+          end
+        end
+        res = catch(:skip){ eval_exp(top, node_def[:exp], env) }
+        return current_state[node_def] = res == :skip ? last_state[node_def] : res
+      end
+
+      def pattern_match(c, v, pattern=c[:pattern], vars={})
+        if pattern[:ref]
+          key = [pattern[:ref], Link.new(c)]
+          vars[key] = v
+        end
+        case pattern
+        when ValuePattern
+          if v.is_a?(Array) && pattern[:name][:desc].to_sym == v[0]
+            res = v.drop(1).zip(pattern[:args]).all? do |ch_v, ch_p|
+              pattern_match(c, ch_v, ch_p, vars)
+            end
+            return vars if res
+          end
+        when IntegralPattern
+          if v.is_a?(Integer) && pattern[:val][:entity][:desc].to_i == v
+            return vars
+          end
+        when AnyPattern
+          return vars
+        end
+        return nil
+      end
+
+      def value_to_s(val)
+        if val.is_a?(Array) && val.first.is_a?(Symbol)
+          "#{val.first}" + (val.size > 1 ? "(#{val.drop(1).map{|x| value_to_s(x)}.join(", ")})" : "")
+        else
+          val.to_s
+        end
+      end
+    end
+  end
+end