1#!/usr/bin/env ruby
2#===========================================================================
3#  Filename : check_declare_func_typo.rb
4#
5#  Copyright (C) 2005-2006 Kazuki Ohta <mover at hct.zaq.ne.jp>
6#  Copyright (c) 2007-2008 SigScheme Project <uim-en AT googlegroups.com>
7#
8#  All rights reserved.
9#
10#  Redistribution and use in source and binary forms, with or without
11#  modification, are permitted provided that the following conditions
12#  are met:
13#
14#  1. Redistributions of source code must retain the above copyright
15#     notice, this list of conditions and the following disclaimer.
16#  2. Redistributions in binary form must reproduce the above copyright
17#     notice, this list of conditions and the following disclaimer in the
18#     documentation and/or other materials provided with the distribution.
19#  3. Neither the name of authors nor the names of its contributors
20#     may be used to endorse or promote products derived from this software
21#     without specific prior written permission.
22#
23#  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
24#  IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
25#  THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
26#  PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
27#  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
28#  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
29#  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
30#  OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
31#  WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
32#  OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
33#  ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
34#===========================================================================
35$orig_info     = {}
36$declare_info  = {}
37$orig_info2    = {}
38$declare_info2 = {}
39
40############################################################################
41# Pickup raw Scm_Register*
42############################################################################
43
44def build_orig_info
45  files = ["sigscheme.c", "operations-srfi1.c",
46           "operations-srfi2.c", "operations-srfi6.c", "operations-srfi8.c",
47           "operations-srfi23.c", "operations-srfi34.c", "operations-srfi38.c",
48           "operations-srfi60.c", "operations-siod.c"]
49
50  files.each { |file|
51    IO.readlines(file).each { |line|
52      if (!line.include?("\""))
53        next
54      end
55
56      if (/Scm_Register(Procedure|Syntax)*\(*/ =~ line.split("\"")[0])
57        regfunc = line.split("\"")[0].strip[0..-2]
58        scmname = line.split("\"")[1].strip
59
60
61        $orig_info[scmname] = regfunc
62        $orig_info2[regfunc] = scmname
63      end
64    }
65  }
66end
67
68############################################################################
69# Pickup DECLARE_FUNCTION
70############################################################################
71FUNC_TYPE_INVALID   = 0
72FUNC_TYPE_SYNTAX    = 1
73FUNC_TYPE_PROCEDURE = 2
74FUNC_TYPE_REDUCTION = 3
75
76TYPE2PREFIX = {
77  FUNC_TYPE_SYNTAX    => "ScmExp",
78  FUNC_TYPE_PROCEDURE => "ScmOp",
79  FUNC_TYPE_REDUCTION => "ScmOp",
80}
81
82SCM2C_FUNCNAME_RULE = [
83  # prefix
84  [/^\+/,        "add"],
85  [/^\*/,        "multiply"],
86  [/^-/,         "subtract"],
87  [/^\//,        "divide"],
88  [/^<=/,         "less_eq"],
89  [/^</,          "less"],
90  [/^>=/,         "greater_eq"],
91  [/^>/,          "greater"],
92  [/^\=/,         "equal"],
93  [/^%%/,         "sscm_"],
94
95  # suffix
96  [/\?$/,  "p"],
97  [/!$/,   "d"],
98
99  # suffix or intermediate
100  [/->/,  "2"],
101  [/-/,   "_"],
102  [/\?/,  "_"],
103  [/!/,   "_"],
104  [/\=/,  "equal"],
105  [/\*/,  "star"],
106  [/\+/,  "plus"],
107]
108
109def guess_c_funcname(prefix, scm_funcname, type)
110  # guess prefix
111  c_prefix = TYPE2PREFIX[type] || "";
112  if (prefix.length != 0)
113    c_prefix += prefix
114  else
115    c_prefix += "_"
116  end
117
118  # apply replace rule
119  c_funcname = scm_funcname
120  SCM2C_FUNCNAME_RULE.each { |rule|
121    c_funcname = c_funcname.gsub(rule[0], rule[1])
122  }
123
124  return c_prefix + c_funcname
125end
126
127def search_declare_function(prefix, filename)
128#  puts "    /* #{filename} */"
129  IO.readlines(filename).each{ |line|
130    if line.strip =~ /DECLARE_FUNCTION\(\"(\S+)\",\s*((Syntax|Procedure|Reduction)\S+)\);/
131      scm_func = $1
132      reg_func = "Scm_Register" + $2
133
134      type = if reg_func.index("Syntax")
135               FUNC_TYPE_SYNTAX
136             elsif reg_func.index("Procedure")
137               FUNC_TYPE_PROCEDURE
138             elsif reg_func.index("Reduction")
139               FUNC_TYPE_REDUCTION
140             else
141               FUNC_TYPE_INVALID
142             end
143
144      c_func = guess_c_funcname(prefix, scm_func, type)
145
146      $declare_info[scm_func] = reg_func;
147      $declare_info2[reg_func] = scm_func;
148
149#      puts "    { \"#{scm_func}\", (ScmFuncType)#{c_func}, (ScmRegisterFunc)#{reg_func} },"
150    end
151  }
152end
153
154def build_table(prefix, filename)
155  search_declare_function(prefix, filename)
156end
157
158def null_entry()
159#  puts "    {NULL, NULL, NULL}"
160end
161
162def print_tableheader(tablename)
163#  puts "struct builtin_func_info #{tablename}[] = {"
164end
165
166def print_tablefooter()
167#  puts "};"
168#  puts ""
169end
170
171def build_functable(prefix, tablename, filelist)
172  print_tableheader(tablename)
173  filelist.each { |filename|
174    build_table(prefix, filename)
175  }
176  null_entry()
177  print_tablefooter
178end
179
180def print_header()
181  IO.readlines("./script/functable-header.txt").each { |line|
182#    puts line
183  }
184end
185
186def print_footer()
187  IO.readlines("script/functable-footer.txt").each { |line|
188#    puts line
189  }
190end
191
192######################################################################
193
194# Header
195print_header
196
197# R5RS
198build_functable("",
199                "r5rs_func_info_table",
200                ["eval.c", "io.c", "operations.c", "sigscheme.c"])
201
202# SRFI-1
203build_functable("_SRFI1_",
204                "srfi1_func_info_table",
205                ["operations-srfi1.c"])
206
207# SRFI-2
208build_functable("_SRFI2_",
209                "srfi2_func_info_table",
210                ["operations-srfi2.c"])
211
212# SRFI-6
213build_functable("_SRFI6_",
214                "srfi6_func_info_table",
215                ["operations-srfi6.c"])
216
217# SRFI-8
218build_functable("_SRFI8_",
219                "srfi8_func_info_table",
220                ["operations-srfi8.c"])
221
222# SRFI-23
223build_functable("_SRFI23_",
224                "srfi23_func_info_table",
225                ["operations-srfi23.c"])
226
227# SRFI-34
228build_functable("_SRFI34_",
229                "srfi34_func_info_table",
230                ["operations-srfi34.c"])
231
232# SRFI-38
233build_functable("_SRFI38_",
234                "srfi38_func_info_table",
235                ["operations-srfi38.c"])
236
237# SRFI-60
238build_functable("_SRFI60_",
239                "srfi60_func_info_table",
240                ["operations-srfi60.c"])
241
242# SIOD
243build_functable("",
244                "siod_func_info_table",
245                ["operations-siod.c"])
246
247# Footer
248print_footer
249
250##########################################################
251
252build_orig_info
253
254# check by key
255$orig_info.keys.each { |key|
256  orig_regfunc = $orig_info[key]
257  decl_regfunc = $declare_info[key]
258
259  if (orig_regfunc != decl_regfunc)
260    p key
261    p orig_regfunc
262    p decl_regfunc
263  end
264}
265
266# check by key
267# orig_info2.keys.each { |key|
268#  orig_func = $orig_info2[key]
269#  decl_func = $declare_info2[key]
270#
271#  if (orig_func != decl_func)
272#    p orig_func
273#  end
274#}
275