ruby-dcl 1.7.1 → 1.8.0

data/GenWrapper/util.rb

@@ -1,9 +0,0 @@
-# util.rb
-#   $Id: util.rb,v 1.1.1.1 2011/02/23 07:21:28 horinout Exp $
-
-class String
-  def <<(str)
-    self.concat str.to_s
-    self
-  end
-end

data/GenWrapper/variable.rb

@@ -1,671 +0,0 @@
-# variable.rb - Attribute specific modules
-# $Id: variable.rb,v 1.1.1.1 2011/02/23 07:21:28 horinout Exp $
-
-require "./util"
-require "./def"
-
-module Input
-  PREFIX = "i_"
-  def input?; true; end
-end
-
-module Output
-  PREFIX = "o_"
-  def output?; true; end
-end
-
-module Working
-  PREFIX = "w_"
-  def work?; true; end
-end
-
-module InputOutput
-  PREFIX = "io_"
-  def input?; true; end
-  def output?; true; end
-end
-
-def Variable(name, vtype, attr, ary, charlen)
-  vt = vtype.capitalize
-  at = case attr
-       when "i"
-	 "Input"
-       when "o"
-	 "Output"
-       when "io"
-	 "InputOutput"
-       when "t"
-	 "Working"
-       end
-  ar = ary ? "Array" : ""
-  klass = eval(vt + at + ar + "Variable")
-  klass.new(name, ary, charlen)
-end
-
-class Variable
-  def initialize(name, ary, *arg)
-    @name = name
-    @ary = ary
-    @arysize = nil
-    @aryrank = nil
-  end
-
-  attr_reader :name;
-  attr_reader :ary;
-  attr_reader :aryrank;
-
-  def prefix
-    self.class::PREFIX
-  end
-
-  def vartype
-    self.class::VARTYPE
-  end
-
-  def arg_name
-    "&" + prefix + name
-  end
-
-  def localvariable
-    [vartype, prefix+name]
-  end
-
-  def ftnlen
-    nil
-  end
-
-  def checktype
-    "/* checktype: not implemented for #{name} (#{self.class}) */\n"
-  end
-
-  def initialization
-    "/* initialization: not implemented for #{name} (#{self.class}) */\n"
-  end
-
-  def allocworkingarea
-    nil
-  end
-
-  def getresult
-    "/* getresult: not implemented for #{name} (#{self.class}) */\n"
-  end
-
-  def freecary
-    nil
-  end
-
-  def freeworkingarea
-    nil
-  end
-
-  def input?;  false; end
-  def output?; false; end
-  def work?;   false; end
-
-end
-
-## Type specific modules
-
-module DefaultType
-  def basic_r2c(r, c)
-    "/* not implemented */"
-  end
-
-  def basic_c2r(r, c)
-    "/* not implemented */"
-  end
-end
-
-module CharacterType
-  include DefaultType
-
-  VARTYPE = "char *"
-
-  def initialize(name, ary, *arg)
-    super
-    if arg[0]
-      @charlen = (arg[0] == "*") ? "DFLT_SIZE" : arg[0]
-    else
-      @charlen = "1"
-    end
-  end
-
-  def basic_r2c(r, c)
-    %Q$#{c} = StringValuePtr(#{r});\n$
-  end
-
-  def basic_r2c_copy(r, c)
-    type = self.vartype.gsub(/\s+\*$/, "")
-    %Q$#{c} = ALLOCA_N(#{type}, strlen(StringValuePtr(#{r}))+1);\n$ +
-    %Q$strcpy(#{c}, StringValuePtr(#{r}));\n$
-  end
-
-  def basic_c2r(r, c)
-    %Q$#{r} = rb_str_new2(#{c});\n$
-  end
-end
-
-module IntegerType
-  include DefaultType
-
-  VARTYPE = "integer"
-
-  def basic_r2c(r, c)
-    %Q$#{c} = NUM2INT(#{r});\n$
-  end
-
-  def basic_c2r(r, c)
-    %Q$#{r} = INT2NUM(#{c});\n$
-  end
-end
-
-module RealType
-  include DefaultType
-
-  VARTYPE = "real"
-
-  def basic_r2c(r, c)
-    %Q$#{c} = (#{VARTYPE})NUM2DBL(#{r});\n$
-  end
-
-  def basic_c2r(r, c)
-    %Q$#{r} = rb_float_new((double)#{c});\n$
-  end
-end
-
-module ComplexType
-  include DefaultType
-
-  VARTYPE = "complex"
-end
-
-module LogicalType
-  include DefaultType
-
-  VARTYPE = "logical"
-
-  def basic_r2c(r, c)
-    %Q$#{c} = ((#{r} == Qnil)||(#{r} == Qfalse)) ? FALSE_ : TRUE_;\n$
-  end
-
-  def basic_c2r(r, c)
-    %Q$#{r} = (#{c} == FALSE_) ? Qfalse : Qtrue;\n$
-  end
-end
-
-## Basic Variables
-
-class CharacterVariable < Variable
-  include CharacterType
-
-  def arg_name
-    "" + prefix + name
-  end
-
-  def ftnlen
-    if self.input?
-      "(ftnlen)strlen(#{prefix+name})"
-    else
-      "(ftnlen)#{@charlen}"
-    end
-  end
-
-  def checktype
-    "" +
-      %Q$if (TYPE(#{name}) != T_STRING) {\n$ +
-      %Q$  #{name} = rb_funcall(#{name}, rb_intern("to_str"), 0);\n$ +
-      %Q$}\n$
-  end
-
-  def initialization
-    if self.input? && self.output?
-      basic_r2c_copy(name, prefix+name)
-    else
-      basic_r2c(name, prefix+name)
-    end
-  end
-
-  def allocworkingarea                  # kuro: +1 need ?
-    type = vartype.gsub(/\s+\*$/, "")
-    len = (@charlen + "+1").gsub(/^1[+]1/,"2")
-    %Q$#{prefix+name}= ALLOCA_N(#{type}, (#{len}));\n$ +
-    %Q$memset(#{prefix+name}, '\\0', #{len});\n$
-  end
-
-  def getresult
-    basic_c2r(name, prefix+name)
-  end
-
-  def freeworkingarea
-    nil
-  end
-end
-
-class IntegerVariable < Variable
-  include IntegerType
-
-  def checktype
-    "" +
-      %Q$if ((TYPE(#{name}) != T_BIGNUM) || (TYPE(#{name}) != T_FIXNUM)) {\n$ +
-      %Q$  #{name} = rb_funcall(#{name}, rb_intern("to_i"), 0);\n$ +
-      %Q$}\n$
-  end
-
-  def initialization
-    basic_r2c(name, prefix+name)
-  end
-
-  def getresult
-    basic_c2r(name, prefix+name)
-  end
-end
-
-class RealVariable < Variable
-  include RealType
-
-  def checktype
-    "" +
-      %Q$if (TYPE(#{name}) != T_FLOAT) {\n$ +
-      %Q$  #{name} = rb_funcall(#{name}, rb_intern("to_f"), 0);\n$ +
-      %Q$}\n$
-  end
-
-  def initialization
-    basic_r2c(name, prefix+name)
-  end
-
-  def getresult
-    basic_c2r(name, prefix+name)
-  end
-end
-
-class ComplexVariable < Variable
-  include ComplexType
-
-end
-
-class LogicalVariable < Variable
-  include LogicalType
-
-  def checktype
-    nil
-  end
-
-  def initialization
-    basic_r2c(name, prefix+name)
-  end
-
-  def getresult
-    basic_c2r(name, prefix+name)
-  end
-end
-
-### Character
-class CharacterInputVariable < CharacterVariable
-  include Input
-end
-
-class CharacterOutputVariable < CharacterVariable
-  include Output
-end
-
-class CharacterInputOutputVariable < CharacterVariable
-  include InputOutput
-end
-
-class CharacterWorkingVariable < CharacterVariable
-  include Working
-end
-
-### Integer
-class IntegerInputVariable < IntegerVariable
-  include Input
-end
-
-class IntegerOutputVariable < IntegerVariable
-  include Output
-end
-
-class IntegerInputOutputVariable < IntegerVariable
-  include InputOutput
-end
-
-class IntegerWorkingVariable < IntegerVariable
-  include Working
-end
-
-### Real
-class RealInputVariable < RealVariable
-  include Input
-end
-
-class RealOutputVariable < RealVariable
-  include Output
-end
-
-class RealInputOutputVariable < RealVariable
-  include InputOutput
-end
-
-class RealWorkingVariable < RealVariable
-  include Working
-end
-
-### Complex
-class ComplexInputVariable < ComplexVariable
-  include Input
-end
-
-class ComplexOutputVariable < ComplexVariable
-  include Output
-end
-
-class ComplexInputOutputVariable < ComplexVariable
-  include InputOutput
-end
-
-class ComplexWorkingVariable < ComplexVariable
-  include Working
-end
-
-### Logical
-class LogicalInputVariable < LogicalVariable
-  include Input
-end
-
-class LogicalOutputVariable < LogicalVariable
-  include Output
-end
-
-class LogicalInputOutputVariable < LogicalVariable
-  include InputOutput
-end
-
-class LogicalWorkingVariable < LogicalVariable
-  include Working
-end
-
-## Array Variables
-
-class ArrayVariable < Variable
-
-  def setarysize(size)
-    @arysize = size
-    @aryrank = size.size
-  end
-
-  def arysize
-    if (@aryrank == 1)
-      if (@arysize[0].to_s !~ /\(/)
-        "(" + @arysize[0].to_s + ")" 
-      else
-	@arysize[0].to_s
-      end
-    else
-      "(" + @arysize.join("*").gsub(/\*1/, "") + ")"
-    end
-  end
-
-  def aryshape
-#    if (@aryrank == 1)
-#      if (@arysize[0].to_s !~ /\(/)
-#        "(" + @arysize[0].to_s + ")" 
-#      else
-#	@arysize[0].to_s
-#      end
-#    else
-    "{"+ @arysize.join(", ").gsub(/\*1/, "")+"}"
-#    end
-  end
-
-  def arg_name
-    "" + prefix + name
-  end
-
-  def allocworkingarea
-    type = vartype.gsub(/\s+\*$/, "")
-    %Q$#{prefix+name}= ALLOCA_N(#{type}, #{arysize});\n$
-  end
-
-end
-
-class CharacterArrayVariable < ArrayVariable
-  include CharacterType
-
-  def arysize
-    "(" + (@arysize.join("*") + "*" + @charlen).gsub(/\*1/, "") + ")"
-  end
-
-  def ftnlen
-    "(ftnlen)#{@charlen}"
-  end
-
-  def checktype
-    "" +
-      %Q$if (TYPE(#{name}) == T_STRING) {\n$ +
-      %Q$  #{name} = rb_Array(#{name});\n$ +
-      %Q$}\n$ +
-      %Q$if (TYPE(#{name}) != T_ARRAY) {\n$ +
-      %Q$  rb_raise(rb_eTypeError, "invalid type");\n$ +
-      %Q$}\n$
-  end
-
-  def initialization
-    %Q$#{prefix+name} = #{OBJ2CCHARARY}(#{name}, #{arysize}, #{@charlen});\n$
-  end
-
-  def allocworkingarea
-    type = vartype.gsub(/\s+\*$/, "")
-    %Q$#{prefix+name}= ALLOCA_N(#{type}, #{arysize});\n$ +
-    %Q$memset(#{prefix+name}, '\\0', #{arysize});\n$
-  end
-
-  def getresult
-    %Q$#{name} = #{CCHARARY2OBJ}(#{prefix+name}, #{arysize}, #{@charlen});\n$
-  end
-
-  def freecary
-    %Q$#{FREECCHARARY}(#{prefix+name});\n$
-  end
-
-end
-
-class IntegerArrayVariable < ArrayVariable
-  include IntegerType
-
-  VARTYPE += " *"
-
-  def checktype
-    "" +
-      %Q$if ((TYPE(#{name}) == T_BIGNUM) || (TYPE(#{name}) == T_FIXNUM)) {\n$ +
-      %Q$  #{name} = rb_Array(#{name});\n$ +
-      %Q$}\n$ +
-      %Q$/* if ((TYPE(#{name}) != T_ARRAY) && \n$ +
-      %Q$       (rb_obj_is_kind_of(#{name}, cNArray) != Qtrue)) {\n$ +
-      %Q$     rb_raise(rb_eTypeError, "invalid type");\n$ +
-      %Q$   }  -- no check since obj2c*ary will do that */\n$
-  end
-
-  def initialization
-    %Q$#{prefix+name} = #{OBJ2CINTEGERARY}(#{name});\n$
-  end
-
-  def getresult
-    %Q${int array_shape[#{aryrank}] = #{aryshape};\n$ +
-    %Q$     #{name} = #{CINTEGERARY2OBJ}(#{prefix+name}, #{arysize}, #{aryrank}, array_shape);\n$ +
-    %Q$    }\n$
-  end
-
-  def freecary
-    %Q$#{FREECINTEGERARY}(#{prefix+name});\n$
-  end
-end
-
-class RealArrayVariable < ArrayVariable
-  include RealType
-  VARTYPE += " *"
-
-  def checktype
-    "" +
-      %Q$if (TYPE(#{name}) == T_FLOAT) {\n$ +
-      %Q$  #{name} = rb_Array(#{name});\n$ +
-      %Q$}\n$ +
-      %Q$/* if ((TYPE(#{name}) != T_ARRAY) && \n$ +
-      %Q$       (rb_obj_is_kind_of(#{name}, cNArray) != Qtrue)) {\n$ +
-      %Q$     rb_raise(rb_eTypeError, "invalid type");\n$ +
-      %Q$   }  -- no check since obj2c*ary will do that */\n$
-  end
-
-  def initialization
-    %Q$#{prefix+name} = #{OBJ2CREALARY}(#{name});\n$
-  end
-
-  def getresult
-    %Q${int array_shape[#{aryrank}] = #{aryshape};\n$ +
-    %Q$     #{name} = #{CREALARY2OBJ}(#{prefix+name}, #{arysize}, #{aryrank}, array_shape);\n$ +
-    %Q$    }\n$
-  end
-
-  def freecary
-    %Q$#{FREECREALARY}(#{prefix+name});\n$
-  end
-end
-
-class ComplexArrayVariable < ArrayVariable
-  include ComplexType
-
-  VARTYPE += " *"
-
-#  def checktype
-#    "" +
-#      %Q$if (TYPE(#{name}) == T_XXXXX) {\n$ +
-#      %Q$  #{name} = rb_Array(#{name});\n$ +
-#      %Q$}\n$ +
-#      %Q$if (TYPE(#{name}) != T_ARRAY) {\n$ +
-#      %Q$  rb_raise(rb_eTypeError, "invalid type");\n$ +
-#      %Q$}\n$
-#  end
-
-#  def initialization
-#    %Q$#{prefix+name} = #{OBJ2CCOMPLEXARY}(#{name});\n$
-#  end
-
-#  def getresult
-#    %Q$#{name} = #{CCOMPLEXARY2OBJ}(#{prefix+name}, #{arysize}, "");\n$
-#  end
-
-#  def freecary
-#    %Q$ #{FREECCOMPLEXARY}(#{prefix+name});\n$
-#  end
-end
-
-class LogicalArrayVariable < ArrayVariable
-  include LogicalType
-
-  VARTYPE += " *"
-
-  def checktype
-    "" +
-      %Q$#{name} = rb_Array(#{name});\n$
-  end
-
-  def initialization
-    %Q$#{prefix+name} = #{OBJ2CLOGICALARY}(#{name});\n$
-  end
-
-  def getresult
-    %Q${int array_shape[#{aryrank}] = #{aryshape};\n$ +
-    %Q$     #{name} = #{CLOGICALARY2OBJ}(#{prefix+name}, #{arysize}, #{aryrank}, array_shape);\n$ +
-    %Q$    }\n$
-  end
-
-  def freecary
-    %Q$#{FREECLOGICALARY2}(#{prefix+name});\n$
-  end
-end
-
-### Character
-class CharacterInputArrayVariable < CharacterArrayVariable
-  include Input
-end
-
-class CharacterOutputArrayVariable < CharacterArrayVariable
-  include Output
-end
-
-class CharacterInputOutputArrayVariable < CharacterArrayVariable
-  include InputOutput
-end
-
-class CharacterWorkingArrayVariable < CharacterArrayVariable
-  include Working
-end
-
-### Integer
-class IntegerInputArrayVariable < IntegerArrayVariable
-  include Input
-end
-
-class IntegerOutputArrayVariable < IntegerArrayVariable
-  include Output
-end
-
-class IntegerInputOutputArrayVariable < IntegerArrayVariable
-  include InputOutput
-end
-
-class IntegerWorkingArrayVariable < IntegerArrayVariable
-  include Working
-end
-
-### Real
-class RealInputArrayVariable < RealArrayVariable
-  include Input
-end
-
-class RealOutputArrayVariable < RealArrayVariable
-  include Output
-end
-
-class RealInputOutputArrayVariable < RealArrayVariable
-  include InputOutput
-end
-
-class RealWorkingArrayVariable < RealArrayVariable
-  include Working
-end
-
-### Complex
-class ComplexInputArrayVariable < ComplexArrayVariable
-  include Input
-end
-
-class ComplexOutputArrayVariable < ComplexArrayVariable
-  include Output
-end
-
-class ComplexInputOutputArrayVariable < ComplexArrayVariable
-  include InputOutput
-end
-
-class ComplexWorkingArrayVariable < ComplexArrayVariable
-  include Working
-end
-
-### Logical
-class LogicalInputArrayVariable < LogicalArrayVariable
-  include Input
-end
-
-class LogicalOutputArrayVariable < LogicalArrayVariable
-  include Output
-end
-
-class LogicalInputOutputArrayVariable < LogicalArrayVariable
-  include InputOutput
-end
-
-class LogicalWorkingArrayVariable < LogicalArrayVariable
-  include Working
-end
-