# Eliminate array size arguments
#  May 13, 2002   T. Horinouchi  
#
# Usage:
# % ruby generate_new_rbdcl.rb proto_files
# where files are grph2_uvpack.fp math2_fftlib.fb etc (in the proto directory)

class Variable
  def initialize(decl)
    name, *tmp = decl.split.reverse
    tmp.reverse!
    attr = (tmp[-1] =~ /^[a-z]+$/ ? tmp.pop : "i")
    ary =  (tmp[-1] =~ /^\((.*)\)/ ? (tmp.pop; $1.downcase) : false)
    vtype = tmp.pop
    if (/(\d+)|\*\((.*)\)/ =~ vtype)
      charlen = ($1||$2).downcase   # may be charcter length
      vtype = vtype.scan(/\w+/)[0]
    else
      charlen = nil
    end
    @name = name.downcase
    @attr = attr
    @ary = ary
    @vtype = vtype.downcase
  end

  attr_reader(:name, :attr, :ary, :vtype)
end

def pre_filter(decl)
  case $method_name
  when /(^ud|^ue)/
    # replace MX with NX
    decl.gsub!('MX','NX')
  when /^ug/
    # replace MU & MV with NX
    decl.gsub!(/(MU|MV)/,'NX')
  end
  decl
end

def extract_args(proto)
  args_org = []
  while ( decl = proto.gets )
    break if decl =~ /^ *\)$/
    decl = pre_filter(decl)
    if ( decl !~ /^\s*$/ )
      print decl if $DEBUG
      var = Variable.new(decl)
      p var if var.ary if $DEBUG
      if var.attr != "o" && var.attr != "t"
	args_org.push(var)
      else
      end
    end
  end
  args_org
end

def has_array?( args )
  args.each do |v|
    return true if v.ary
  end
  false
end

def new_args( args_org )
  del_argname = []
  args_org.each do |v|
    if ( (shape = v.ary) )
      shape = shape.split(',')
      shape.each do |lendef|
	lpos = lendef.index(/([a-z]\w*)/)
	m = $1
	if ( lpos )
	  lpos2 = lendef.index(/([a-z]\w*)/,lpos+m.length)
	  if (!lpos2)
	    # to be deleted only when unambiguous
	    del_argname.push(m) if m && !del_argname.include?(m)
	  end
	end
      end
    end
  end
  args_new = args_org.clone
  del_argname.each do |nm|
    args_new.delete_if {|v| 
	v.name == nm
    }
  end
  print "  ORG: ", args_org.collect{|i| i.name}.join(','),"\n" if $DEBUG
  print "  NEW: ", args_new.collect{|i| i.name}.join(','),"\n" if $DEBUG
  print "  args deleted: ",del_argname.join(','),"\n" if $DEBUG
  [args_new, del_argname]
end


def new_def( args_org, args_new, del_argname )
  method_def = <<-EOS
      alias __#{$method_name} #{$method_name} 
      def #{$method_name}( #{args_new.collect{|i| i.name}.join(',')} )
  EOS
  method_def.concat( del_arg_deriv( args_new, del_argname ) )
  args_org_names = args_org.collect{|arg| arg.name}
  method_def.concat( check_array_size( args_new, args_org_names ) )
  method_def.concat( <<-EOS

        #< call the original method >
        __#{$method_name}( #{args_org.collect{|i| i.name}.join(',')} )
      end
      module_function :#{$method_name}, :__#{$method_name} 
      private_class_method :__#{$method_name}

  EOS
  )

  #print '*** ',method_def
  method_def
end

#def wrap_in_rundef_rescue(
#        if ( #{v.name}.is_a(Float) && x == glrget("RMISS") )
#end

def del_arg_deriv( args_new, del_argname )
  deriv = ""
  first = true
  del_argname.each do |nm|
    ary = []
    args_new.each do |v|
      if v.ary && v.ary =~ /\W*#{nm}\W*/
	ary.push( [ v.name, inv_deriv(nm, v.ary, v.name) ] )
	if (!possibly_rundef?(nm, v.name))
	  break
	end
      end
    end
    if(first)
      deriv = <<-EOS

        #< extract array size(s) (which was(were) formerly an argument(s)) >
      EOS
      first = false
    end
    deriv.concat( recursive_join( ary ) )
  end
  deriv
end

def possibly_rundef?(argname, varname)
  case $method_name
  when /(^usgrph|^usspnt)/
    if( argname == 'n' && varname == 'x' )
      return true
    elsif ( argname == nil )
      return true
    end
  when /(^uulin|^uumrk|^uv|^uh)/
    if ( argname == 'n' && 
	( varname == 'upx'  || varname == 'upy'  ||
	  varname == 'upx1' || varname == 'upx2' || 
	  varname == 'upy1' || varname == 'upy2' ) )
      return true
    elsif ( argname == nil )
      return true
    end
  end
  false
end

def recursive_join( ary )
  first = ary.shift
  if( ary.length > 0)
    str = <<-EOS
        if ! ( #{first[0]} == nil || #{first[0]}.is_a?(Float) && lreq( #{first[0]}, glrget("RUNDEF") ) )
#{first[1].gsub(/^/,"  ").chop}
        else
    EOS
    str += <<-EOS
          #{first[0]} = glrget("RUNDEF") if ( #{first[0]} == nil )
#{recursive_join(ary).gsub(/^/,"  ").chop}
        end
    EOS
  else
    first[1]
  end
end


def inv_arithm(lendef, varname)
  case lendef
  when varname
    form = "LEN"
  when /^(\w+) *\* *#{varname}$/
    form = "LEN / #{$1}"
  when /^#{varname} *\/ *(\w+)$/
    form = "LEN * #{$1}"
  when /^#{varname} *\+ *(\w+)$/
    form = "LEN - #{$1}"
  when /^\(*(\w+) *\* *#{varname} *\+ *(\w+)\)*$/
    form = "( LEN - #{$2} ) / #{$1}"
  else
    raise 'unsuppoerted dimension specification : '+lendef
  end
  form
end

def inv_deriv(argname, shape, aryname)
  deriv = ""
  shape = shape.split(',')
  multiD = ( shape.length > 1 )
  shape.each_index do |i|
    if (lendef=shape[i]) =~ /\W*#{argname}\W*/
      idim = i
      form = inv_arithm( lendef, argname )
      form.sub!('LEN',"len_#{aryname}_#{idim}")
      if multiD
	deriv = <<-EOS
        if ( not_nary(#{aryname}) || (#{aryname}.rank < #{idim+1}) )
          raise "#{aryname} must be a NArray of rank == #{shape.length}"
        end
        len_#{aryname}_#{idim} = #{aryname}.shape[#{idim}]
	EOS
      else
	deriv = <<-EOS
        len_#{aryname}_#{idim} = #{aryname}.length
	EOS
      end
      deriv.concat( <<-EOS
        #{argname} = #{form}
      EOS
      )
      print deriv if $DEBUG
      break
    end
  end
  deriv
end

def aster2dimlen_if_possible( varname, dimlen ) 
  if $method_name =~ /(^rvmax|^rvmin)/ && varname == 'rx'
    dimlen.replace('(len=1; ns.each{|i| len*=i}; len)')
    true
  else
    raise $!
  end
end

def consist_of_names?(str, names)
  ary = str.split(/\W/).uniq     
  names.each{|str| ary.delete(str)}
  ary.each do |str| 
    return false if (/^\d*$/ !~ str)
  end
  true
end

def check_array_size( args_new, args_org_names )
  body = <<-EOS

        #< check array size(s) >
  EOS
  args_new.each do |v|
    if ( v.ary )
      shape = v.ary.split(',')
      if ( shape.length == 1 )
	arylen_replaced = false
	if ( shape[0] == '*' )
	  begin
	    raise "Array #{v.name} is declared using *"
	  rescue
	    arylen_replaced = aster2dimlen_if_possible( v.name, shape[0] ) 
	  end
	end
	if possibly_rundef?(nil, v.name)
	  ins = "\\\n            #{v.name}!=nil && !( #{v.name}.is_a?(Float) && lreq(#{v.name},glrget(\"RUNDEF\")) ) && "
	else
	  ins = ""
	end
	if arylen_replaced || consist_of_names?(shape[0], args_org_names )
	body.concat( <<-EOS
        raise "Invalid array length: #{v.name}.length != #{shape[0]}" if #{ins}#{v.name}.length != (#{shape[0]})
	EOS
	)
	end
      else
	shape.each_index do |i|
 	  if ( shape[i] == '*' )
	    raise "Array #{v.name}'s #{i}-th dim is declared using *"
          end
          body.concat( <<-EOS
        raise "Invalid array shape: #{v.name}.shape[#{i}] != #{shape[i]}" if #{v.name}.shape[#{i}] != (#{shape[i]})
	  EOS
          )
        end
      end
    end
  end
  body
end

def head
  f = File.open('dcl_rb_heading')
  heading = f .readlines
  f.close
  heading
end

def close
  return <<-EOS
    end
end
  EOS
end

def post_filter( ndf )
  if $method_name == 'udcntz'
    ndf.sub!(/,nbr2/,'')
    add = <<-EOS
        # derivation of nbr2 is provied aditionally in the method post_filter:
        nbr2 = (nx+2)*(ny+2)*6/32+4

    EOS
    ndf =~ /(^ *\#.*check array size.*$)/
    ndf[$1] = add + $1
  end
end

def delete_comment(src) # [ruby-list:32030] [ruby-list:32049]
  src.gsub(%r@ ([\'\"])(\\.|.)*?\1
               | (/\*.*?\*/)      
               | (//)[^\n]*$      
               @mx) {
    if $3
      s = $3.delete("^\n")
      s = ' ' if s.empty?
      s
    elsif $4
      ''
    else
      $&
    end
  }
end

#####################  (main) ###########################
require "tempfile"
files = ARGV
ofilename = "src/lib/dcl.rb"
ofile = open( ofilename, "w+" )
ofile.puts( head() )
for f in files
  print "processing file #{f}\n"
  #proto = open("| cat #{f} | gcc -E -", "r+")
  #proto.close_write
  fl = File.open(f)
  proto = Tempfile.new('proto', '.')
  proto.print( delete_comment(fl.read) )
  proto.sync
  proto.rewind
  fl.close
  while ( line = proto.gets )
    case line
    when /^ *SUBROUTINE *(\w+)|^ *\w+ *FUNCTION *(\w+)/
      $method_name = ( $1 || $2 ).downcase
      print $method_name+"\n" if $DEBUG
      args_org = extract_args(proto)
      if ( has_array?(args_org) )
	# redefine the method
	args_new, del_argname = new_args( args_org )
	ndf = new_def( args_org, args_new, del_argname )
	post_filter( ndf )
	ofile.puts( ndf )
      end
    when /^#if *DCLVER *([<=>]+) *(\d\d)/
      op = $1
      ver = "'"+$2[0..0]+'.'+$2[1..1]+"'"   # "'5.2'" etc
      ofile.print("      if DCLVERSION #{op} #{ver}\n")
    when /^#endif/
      ofile.print("      end\n\n")
    end
  end
  proto.close
end

ofile.puts( close() )
ofile.close

print "generated the DCL module file #{ofilename}\n"