#################################################################
# f77proto.rb : prototype extraction from FORTRAN77 sources
#
# 2000/05/28    堀之内 武
#
# 使用法:
#    ruby [-v] f77proto.rb [files...]
#
#    -v を与えるとC言語の形式のコメントがプリントされる(推奨).
#    [files...] は 0 個以上の fortran77 のソースファイル。0個の場合
#    標準入力から読み込む。
#
# 機能：
#    FORTRAN77のソースプログラム中の副プログラム引用仕様を以下のように
#    書き出す。
#
#    <副プログラム宣言> (
#        <引数宣言>
#        <引数宣言>
#        ...
#    )
#
#   ここで引数宣言は一行一引数で引数の個数分だけある（ゼロの場合もあり）
#
#   <副プログラム宣言> = <副プログラム種類> 副プログラム名
#   <副プログラム種類> = "SUBROUTINE" | <型指定> "FUNCTION"
#
#   備考：ENTRY も上の<副プログラム種類>のいずれか適当な方で宣言される
#
#   <引数宣言> = <型指定> 変数名
#
#   <型指定> = <型> <配列情報>
#            | <型>
#   
#   <型>       = fortranの基本型
#   <配列情報> = "(" <サイズ列> ")"
#   <サイズ列> = <サイズ> <サイズ列> 
#              | <サイズ>
#   <サイズ>   = "*" | <変数名> | <整数>
#
# 制限：
#
#   一つのIMPLICIT文で２つ以上の型を宣言している場合には対応してない
#
#   プリプロセッサー利用の F77 ネイティブでない型宣言には対応してない
#
# 備考：
#
#   大文字・小文字混じりでも大丈夫(なはず)
#   IMPLICIT文は解釈される
#   !から始まるコメントが入っていても大丈夫(なはず)
#   DIMENSION文対応有
#
#################################################################



while gets()
   if /^ *SUBROUTINE/i || /^ *ENTRY/i || /^      .*FUNCTION/i then

      # sdef = subprogram definition 

      sdef = $_
      if sdef =~ '\(' && sdef !~ '\)' then
	 # definition continues
	 while gets()
	    sdef += $_
	    break if $_ =~ '\)'
	 end
	 print sdef if $DEBUG
      end
      sdef.gsub!(/!.*$/,'')       ## delete comments
      
      # dcomposition into subprogram type, name & arguments

      case sdef
      when  /SUBROUTINE/i
	 stype = 'SUBROUTINE'
      when  /(\w.*FUNCTION)/i
	 stype = $1
      when  /ENTRY/i
	 ## function or subroutine
      end
      
      /(\w+) *\( *(.*?) *\)/p =~ sdef

      if $1 != nil then
	 sname = $1             # subprogram name
	 args = $2  # arguments -> will be an array later
      else
	 # has no parentheses:
	 case sdef
	 when  /^ *SUBROUTINE +(\w+)/i
	    sname = $1
	    args = ""
	 when  /^ *ENTRY +(\w+)/i
	    sname = $1
	    args = ""
	 when  /^ *FUNCTION +(\w+)/i
	    sname = $1
	    args = ""
	 end
      end
      
      args.gsub!('^     \S','')         # delete continuation marks
      args = args.split(/,[ \n]*/p)     # -> array
      p args if $DEBUG

      # get variable definition statements & implicit types

      if /^ *ENTRY/i !~ sdef
	 dstat = []
	 impl = []
	 while gets()
	    break if /^ *END/i || /^ *RETURN/i     # def must have completed
	    if /^ *REAL /i || /^ *COMPLEX/i || /^ *LOGICAL/i || \
	         /^ *CHARACTER/i || /^ *INTEGER/i || /^ *DOUBLE/i || \
	         /^ *DIMENSION/i then
	       dstat += $_.sub(/!.*$/,'')
	    elsif /^ *IMPLICIT/i
	       impl += $_.sub(/!.*$/,'')
	    end
	 end
	 # set implicit type rule
	 impltype = [ [/[I-N]/i,'INTEGER'], [/[A-H,O-Z]/i,'REAL'] ]
	 for ip in impl
	    /IMPLICIT +(\S[\S ]*\S)\s*\((.*)\)/i =~ ip
	    impltype = [[ /[#{$2}]/i, $1 ]] + impltype   # supersade defaults
	    p impltype if $DEBUG
	 end
      end


      # argument prototype definitions (prts)

      prts = []
      dsmatched = []    # for verbose output

      for ar in args
	 match = false
	 for ds in dstat
	    if ds =~ /[\W\s]#{ar}[\W\s]/i && ds !~ /\([^\)]*#{ar}[^\(]*\)/i then
	       match = true
	       if $VERBOSE && ! dsmatched.include?(ds)
		  dsmatched += ds
	       end
	       break
	    end
	 end
	 if match then
	    /^ *([\w\*]+).*#{ar}(.*)/i =~ ds
	    type = $1
	    if $2 != nil then
	       s=$2
	       if s =~ /^ *\(/
		  # array shape
		  n=0 ; b=0
		  s.each_byte{ |i|
		     n += 1  if i==?(
		     n -= 1  if i==?)
		     break if n==0
		     b += 1
		  }
		  type += ' '+s[0..b]
		  s = s[(b+1)..-1]
	       end
	       if type =~ /CHARACTER/i && s =~ /^ *(\* *[^,]*)/
		  # character length
		  type.sub!(/CHARACTER( *\*\w*)?/i,'CHARACTER'+$1)
	       end
	       # remeady for the \w+ type matching
	       type.sub!(/DOUBLE/i,'DOUBLE PRECISION')
	       type.sub!(/CHARACTER[ \*]*$/i,'CHARACTER*(*)')
	       # dimension -> implicit type
	       if type =~ /DIMENSION/i
		  for it in impltype
		     if ar[0..0] =~ it[0]
			type.sub!(/DIMENSION/i, it[1])
			break
		     end
		  end
	       end
	    end
	 else
	    # implicit type
	    for it in impltype
	       if ar[0..0] =~ it[0]
		  type = it[1]
		  print ar," matches ",it[0].inspect," -> ",type,"\n" if $DEBUG
		  break
	       end
	    end
	 end
	 prts += type+' '+ar
      end

      # print prototype

      if $VERBOSE
	 print "/* \n",sdef.gsub(/^/,' *')
	 for ip in impl
	    print ip.sub(/^/,' *')
	 end
	 for ds in dsmatched
	    print ds.sub(/^/,' *')
	 end
	 print " */\n" 
      end
      print '      ',stype,' ',sname,"(\n"
      for prt in prts
	 print '          ',prt,"\n"
      end
      print "      )\n\n"
   end
   
end