nendo 0.3.2 → 0.3.3

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
data/lib/nendo.rb CHANGED
@@ -34,1953 +34,2089 @@
34
34
  #
35
35
  # $Id:
36
36
  #
37
- require 'stringio'
38
- require 'digest/sha1'
39
- #require 'profile'
40
37
 
41
- class Nil
42
- include Enumerable
43
- def each() end
44
- def to_arr() [] end
45
- def length() 0 end
46
- def isNull() true end
47
- def isDotted() false end
48
- def lastAtom() nil end
49
- def to_s() "" end
50
- def car()
51
- raise "Error: pair required, but got ()"
52
- end
53
- def cdr()
54
- raise "Error: pair required, but got ()"
55
- end
56
- end
57
-
58
- class LispString < String
59
- def LispString.escape( str )
60
- if str.is_a? String
61
- str.gsub( /\\/, "\\\\\\\\" ).gsub( /["]/, "\\\"" ).gsub( /[\r]/, "\\r" ).gsub( /[\t]/, "\\t" )
62
- else
63
- raise TypeError
38
+ module Nendo
39
+ require 'stringio'
40
+ require 'digest/sha1'
41
+ #require 'profile'
42
+
43
+ class Nil
44
+ include Enumerable
45
+ def each() end
46
+ def to_arr() [] end
47
+ def length() 0 end
48
+ def isNull() true end
49
+ def isDotted() false end
50
+ def lastAtom() false end
51
+ def getLastAtom()
52
+ raise RuntimeError, "Error: Nil#getLastAtom method: this cell is not dotted list."
53
+ end
54
+ def to_s() "" end
55
+ def car()
56
+ raise "Error: Nil#car method: pair required, but got ()"
57
+ end
58
+ def cdr()
59
+ raise "Error: Nil#cdr method: pair required, but got ()"
64
60
  end
65
61
  end
66
- end
67
-
68
- class LispMacro < Proc
69
- end
70
-
71
- class Symbol
72
- def setLispToken( token )
73
- @token = token
74
- end
75
- def sourcefile
76
- @token ? @token.sourcefile : ""
77
- end
78
- def lineno
79
- @token ? @token.lineno : 1
62
+
63
+ class LispString < String
64
+ def LispString.escape( str )
65
+ if str.is_a? String
66
+ str.gsub( /\\/, "\\\\\\\\" ).gsub( /["]/, "\\\"" ).gsub( /[\r]/, "\\r" ).gsub( /[\t]/, "\\t" )
67
+ else
68
+ raise TypeError
69
+ end
70
+ end
80
71
  end
81
- end
82
-
83
- class Cell
84
- include Enumerable
85
-
86
- def initialize( car = Nil.new, cdr = Nil.new )
87
- @car = car
88
- @cdr = cdr
72
+
73
+ class LispMacro < Proc
89
74
  end
90
- attr_accessor :car, :cdr
91
-
92
- def each # Supporting iterator
93
- if not isNull
94
- it = self
95
- while Nil != it.class
96
- yield it
97
- if it.cdr.is_a? Cell
98
- it = it.cdr
99
- else
100
- it = Nil.new
75
+
76
+ class Cell
77
+ include Enumerable
78
+
79
+ def initialize( car = Nil.new, cdr = Nil.new )
80
+ @car = car
81
+ @cdr = cdr
82
+ end
83
+ attr_accessor :car, :cdr
84
+
85
+ def each # Supporting iterator
86
+ h = {}
87
+ if not isNull
88
+ it = self
89
+ while Nil != it.class
90
+ h[ it.hash ] = true
91
+ # printf( "%s : %s\n", it.car, it.hash )
92
+ yield it
93
+ if it.cdr.is_a? Cell
94
+ it = it.cdr
95
+ if h.has_key?( it.hash )
96
+ # found circular-list.
97
+ it = Nil.new
98
+ end
99
+ else
100
+ it = Nil.new
101
+ end
101
102
  end
102
103
  end
103
104
  end
104
- end
105
-
106
- def length() self.to_arr.length end
107
- def size() self.length end # alias of length
108
-
109
- def isDotted
110
- ((Cell != @cdr.class) and (Nil != @cdr.class))
111
- end
112
-
113
- def isNull
114
- ((Nil == @car.class) and (Nil == @cdr.class))
115
- end
116
-
117
- def lastCell
118
- lastOne = self
119
- self.each { |x| lastOne = x }
120
- lastOne
121
- end
122
-
123
- def lastAtom
124
- lastOne = self.lastCell
125
- if lastOne.isDotted
126
- lastOne.cdr
127
- else
128
- nil
105
+
106
+ def length() self.to_arr.length end
107
+ def size() self.length end # alias of length
108
+
109
+ def isDotted
110
+ ((Cell != @cdr.class) and (Nil != @cdr.class))
129
111
  end
130
- end
131
-
132
- def to_arr
133
- if isNull
134
- []
135
- else
136
- self.map {|x| x.car}
112
+
113
+ def isNull
114
+ ((Nil == @car.class) and (Nil == @cdr.class))
137
115
  end
138
- end
139
- end
140
-
141
- class Array
142
- def to_list( lastAtom = nil )
143
- if 0 == self.length
144
- Nil.new
145
- else
146
- cells = self.map { |x|
147
- Cell.new( x )
148
- }
149
- ptr = cells.pop
150
- ptr.cdr = lastAtom if lastAtom
151
- cells.reverse.each { |x|
152
- x.cdr = ptr
153
- ptr = x
154
- }
155
- return ptr
116
+
117
+ def lastCell
118
+ lastOne = self
119
+ self.each { |x| lastOne = x }
120
+ lastOne
156
121
  end
157
- end
158
- end
159
-
160
- class Hash
161
- def to_list
162
- arr = Array.new
163
- self.each_pair { |key,val|
164
- arr << Cell.new( key, val )
165
- }
166
- arr.to_list
167
- end
168
- end
169
-
170
- class LispValues
171
- def initialize( arr )
172
- if 1 == arr.size
173
- raise ArgumentError, "Error: LispValues object expects 0 or 2+ length of array"
174
- else
175
- @values = arr
122
+
123
+ def lastAtom
124
+ lastOne = self.lastCell
125
+ lastOne.isDotted
126
+ end
127
+
128
+ def getLastAtom
129
+ if self.lastAtom
130
+ self.lastCell.cdr
131
+ else
132
+ Nendo::Nil.new
133
+ end
176
134
  end
177
- end
178
- attr_reader :values
179
- end
180
-
181
- class LispKeyword
182
- def initialize( str )
183
- @key = str.intern
184
- end
185
-
186
- def ==(other)
187
- if other.is_a? LispKeyword
188
- self.key == other.key
189
- else
190
- false
135
+
136
+ def to_arr
137
+ if isNull
138
+ []
139
+ else
140
+ self.map {|x| x.car}
141
+ end
191
142
  end
192
143
  end
193
-
194
- def ===(other)
195
- self.==(other)
196
- end
197
-
198
- def to_s
199
- self.key.to_s
200
- end
201
-
202
- attr_reader :key
203
- end
204
-
205
- class Token
206
- def initialize( kind, str, sourcefile, lineno = nil, column = nil )
207
- @kind = kind
208
- @str = str
209
- @sourcefile = sourcefile
210
- @lineno = lineno
211
- @column = column
212
- end
213
- attr_accessor :kind, :str, :sourcefile, :lineno, :column
214
- end
215
-
216
-
217
- class CharReader
218
- def initialize( inport, sourcefile )
219
- @inport = inport
220
- @sourcefile = sourcefile
221
- self.reset
222
- end
223
-
224
- def reset
225
- @lineno = 1
226
- @column = 1
227
- end
228
-
229
- def getc
230
- @undo_lineno = @lineno
231
- @undo_column = @column
232
- ch = @inport.getc
233
- if nil != ch
234
- if ch.chr.match( /[\r\n]/ )
235
- @lineno += 1
144
+
145
+ class LispValues
146
+ def initialize( arr )
147
+ if 1 == arr.size
148
+ raise ArgumentError, "Error: LispValues object expects 0 or 2+ length of array"
149
+ else
150
+ @values = arr
236
151
  end
237
- @column += 1
238
152
  end
239
- ch
240
- end
241
-
242
- def ungetc( ch )
243
- @lineno = @undo_lineno
244
- @column = @undo_column
245
- @inport.ungetc( ch )
246
- end
247
-
248
- def sourcefile
249
- @sourcefile
153
+ attr_reader :values
250
154
  end
251
-
252
- def lineno
253
- @lineno
254
- end
255
-
256
- def column
257
- @column
258
- end
259
- end
260
-
261
- class Reader
262
- ## tokens
263
- T_EOF = :t_eof
264
- T_LPAREN = :t_lparen
265
- T_RPAREN = :t_rparen
266
- T_LVECTOR = :t_lvector
267
- T_SYMBOL = :t_symbol
268
- T_KEYWORD = :t_keyword
269
- T_NUM = :t_num
270
- T_STRING = :t_string
271
- T_QUOTE = :t_quote
272
- T_QUASIQUOTE = :t_quasiquote
273
- T_UNQUOTE = :t_unquote
274
- T_UNQUOTE_SPLICING = :t_unquote_splicing
275
- T_FEEDTO = :t_feedto
276
- T_DOT = :t_dot
277
- T_LINEFEED = :t_linefeed
278
- T_COMMENT = :t_comment
279
- T_DEBUG_PRINT = :t_debug_print
280
-
281
- # inport is IO class
282
- def initialize( inport, sourcefile, debug = false )
283
- @chReader = CharReader.new( inport, sourcefile )
284
- @curtoken = nil
285
- @debug = debug
286
- end
287
-
288
- def reset
289
- @chReader.reset
155
+
156
+ class LispKeyword
157
+ def initialize( str )
158
+ @key = str.intern
159
+ end
160
+
161
+ def ==(other)
162
+ if other.is_a? LispKeyword
163
+ self.key == other.key
164
+ else
165
+ false
166
+ end
167
+ end
168
+
169
+ def ===(other)
170
+ self.==(other)
171
+ end
172
+
173
+ def to_s
174
+ self.key.to_s
175
+ end
176
+
177
+ attr_reader :key
290
178
  end
291
-
292
- def sourcefile
293
- @chReader.sourcefile
179
+
180
+ class DelayedCallPacket
181
+ def initialize( _origname, _pred, _args )
182
+ @origname = _origname
183
+ @pred = _pred
184
+ @args = _args
185
+ end
186
+ attr_reader :origname, :pred, :args
294
187
  end
295
188
 
296
- def lineno
297
- @chReader.lineno
189
+ class Token
190
+ def initialize( kind, str, sourcefile, lineno = nil, column = nil )
191
+ @kind = kind
192
+ @str = str
193
+ @sourcefile = sourcefile
194
+ @lineno = lineno
195
+ @column = column
196
+ end
197
+ attr_accessor :kind, :str, :sourcefile, :lineno, :column
298
198
  end
299
-
300
- def skipspace
301
- begin
302
- ch = @chReader.getc
303
- break if nil == ch # non eof?
304
- #printf( " skipspace: [%02x]\n", ch ) if @debug
305
- end while ch.chr.match( /[ \t]/ )
306
- @chReader.ungetc( ch ) if nil != ch
199
+
200
+
201
+ class CharReader
202
+ def initialize( inport, sourcefile )
203
+ @inport = inport
204
+ @sourcefile = sourcefile
205
+ self.reset
206
+ end
207
+
208
+ def reset
209
+ @lineno = 1
210
+ @column = 1
211
+ end
212
+
213
+ def getc
214
+ @undo_lineno = @lineno
215
+ @undo_column = @column
216
+ ch = @inport.getc
217
+ if nil != ch
218
+ if ch.chr.match( /[\r\n]/ )
219
+ @lineno += 1
220
+ end
221
+ @column += 1
222
+ end
223
+ ch
224
+ end
225
+
226
+ def ungetc( ch )
227
+ @lineno = @undo_lineno
228
+ @column = @undo_column
229
+ @inport.ungetc( ch )
230
+ end
231
+
232
+ def sourcefile
233
+ @sourcefile
234
+ end
235
+
236
+ def lineno
237
+ @lineno
238
+ end
239
+
240
+ def column
241
+ @column
242
+ end
307
243
  end
308
-
309
- def readwhile( exp, oneshot = false )
310
- ret = ""
311
- while true
244
+
245
+ class Reader
246
+ ## tokens
247
+ T_EOF = :t_eof
248
+ T_LPAREN = :t_lparen
249
+ T_RPAREN = :t_rparen
250
+ T_LVECTOR = :t_lvector
251
+ T_SYMBOL = :t_symbol
252
+ T_KEYWORD = :t_keyword
253
+ T_NUM = :t_num
254
+ T_STRING = :t_string
255
+ T_QUOTE = :t_quote
256
+ T_QUASIQUOTE = :t_quasiquote
257
+ T_UNQUOTE = :t_unquote
258
+ T_UNQUOTE_SPLICING = :t_unquote_splicing
259
+ T_FEEDTO = :t_feedto
260
+ T_DOT = :t_dot
261
+ T_LINEFEED = :t_linefeed
262
+ T_COMMENT = :t_comment
263
+ T_DEBUG_PRINT = :t_debug_print
264
+
265
+ # inport is IO class
266
+ def initialize( inport, sourcefile, debug = false )
267
+ @inport = inport
268
+ @sourcefile = sourcefile
269
+ @chReader = nil
270
+ @curtoken = nil
271
+ @debug = debug
272
+ end
273
+
274
+ def reset
275
+ @chReader.reset if @chReader
276
+ end
277
+
278
+ def sourcefile
279
+ @sourcefile
280
+ end
281
+
282
+ def lineno
283
+ if @chReader
284
+ @chReader.lineno
285
+ else
286
+ 1
287
+ end
288
+ end
289
+
290
+ def skipspace
291
+ begin
292
+ ch = @chReader.getc
293
+ break if nil == ch # non eof?
294
+ #printf( " skipspace: [%02x]\n", ch ) if @debug
295
+ end while ch.chr.match( /[ \t]/ )
296
+ @chReader.ungetc( ch ) if nil != ch
297
+ end
298
+
299
+ def readwhile( exp, oneshot = false )
300
+ ret = ""
301
+ while true
302
+ ch = @chReader.getc
303
+ #printf( " readwhile: [%02x]\n", ch ) if @debug
304
+ if !ch # eof?
305
+ break
306
+ end
307
+ if ch.chr.match( exp )
308
+ ret += ch.chr
309
+ else
310
+ @chReader.ungetc( ch )
311
+ break
312
+ end
313
+ if oneshot then break end
314
+ end
315
+ ret
316
+ end
317
+
318
+ def peekchar( exp )
312
319
  ch = @chReader.getc
313
- #printf( " readwhile: [%02x]\n", ch ) if @debug
320
+ #printf( " peekchar: [%02x]\n", ch ) if @debug
314
321
  if !ch # eof?
315
- break
322
+ return nil
316
323
  end
317
324
  if ch.chr.match( exp )
318
- ret += ch.chr
325
+ ch.chr
319
326
  else
320
327
  @chReader.ungetc( ch )
321
- break
328
+ nil
322
329
  end
323
- if oneshot then break end
324
330
  end
325
- ret
326
- end
327
-
328
- def peekchar( exp )
329
- ch = @chReader.getc
330
- #printf( " peekchar: [%02x]\n", ch ) if @debug
331
- if !ch # eof?
332
- return nil
333
- end
334
- if ch.chr.match( exp )
335
- ch.chr
336
- else
337
- @chReader.ungetc( ch )
338
- nil
331
+
332
+ def readstring()
333
+ ret = ""
334
+ while true
335
+ ch = @chReader.getc
336
+ #printf( " readstring: [%s]\n", ch )
337
+ if !ch # eof?
338
+ break
339
+ end
340
+ if ch.chr == "\\"
341
+ ch2 = @chReader.getc
342
+ ret += case ch2.chr
343
+ when '"' # \" reduce to "
344
+ '"'
345
+ when '\\' # \\ reduce to \
346
+ "\\"
347
+ when 'n'
348
+ "\n"
349
+ when 'r'
350
+ "\r"
351
+ when 't'
352
+ "\t"
353
+ else
354
+ ""
355
+ end
356
+ elsif ch.chr != '"'
357
+ ret += ch.chr
358
+ else
359
+ @chReader.ungetc( ch )
360
+ break
361
+ end
362
+ end
363
+ ret
339
364
  end
340
- end
341
365
 
342
- def readstring()
343
- ret = ""
344
- while true
366
+ def tokenWithComment
367
+ skipspace
345
368
  ch = @chReader.getc
346
- #printf( " readstring: [%s]\n", ch )
347
- if !ch # eof?
348
- break
349
- end
350
- if ch.chr == "\\"
351
- ch2 = @chReader.getc
352
- ret += case ch2.chr
353
- when '"' # \" reduce to "
354
- '"'
355
- when '\\' # \\ reduce to \
356
- "\\"
357
- when 'n'
358
- "\n"
359
- when 'r'
360
- "\r"
361
- when 't'
362
- "\t"
363
- else
364
- ""
365
- end
366
- elsif ch.chr != '"'
367
- ret += ch.chr
369
+ if nil == ch # eof?
370
+ @curtoken = Token.new( T_EOF, "", @chReader.sourcefile, @chReader.lineno, @chReader.column )
368
371
  else
369
- @chReader.ungetc( ch )
370
- break
371
- end
372
- end
373
- ret
374
- end
375
-
376
- def tokenWithComment
377
- skipspace
378
- ch = @chReader.getc
379
- if nil == ch # eof?
380
- @curtoken = Token.new( T_EOF, "", @chReader.sourcefile, @chReader.lineno, @chReader.column )
381
- else
382
- str = ch.chr
383
- kind =
384
- case str
385
- when /[\']/
386
- T_QUOTE
387
- when /[\`]/
388
- T_QUASIQUOTE
389
- when /[,]/
390
- str += readwhile( /[@]/, true )
391
- if 1 == str.length
392
- T_UNQUOTE
393
- else
394
- T_UNQUOTE_SPLICING
395
- end
396
- when '(', '['
397
- T_LPAREN
398
- when ')', ']'
399
- T_RPAREN
400
- when '.'
401
- str += readwhile( /[_a-zA-Z0-9!?.]/ )
402
- if 1 == str.length
403
- T_DOT
404
- else
405
- T_SYMBOL
406
- end
407
- when /[\r\n]/
408
- T_LINEFEED
409
- when /;/
410
- readwhile( /[^\r\n]/ )
411
- str = ""
412
- T_COMMENT
413
- when /[#]/
414
- nextch = peekchar( /[?!tfbodx(]/ )
415
- case nextch
416
- when "?"
417
- if peekchar( /[=]/ )
418
- str = ""
419
- T_DEBUG_PRINT
372
+ str = ch.chr
373
+ kind =
374
+ case str
375
+ when /[\']/
376
+ T_QUOTE
377
+ when /[\`]/
378
+ T_QUASIQUOTE
379
+ when /[,]/
380
+ str += readwhile( /[@]/, true )
381
+ if 1 == str.length
382
+ T_UNQUOTE
420
383
  else
421
- str += readwhile( /[^ \t\r\n]/ )
422
- raise NameError, sprintf( "Error: unknown #xxxx syntax for Nendo %s", str )
423
- end
424
- when "!"
384
+ T_UNQUOTE_SPLICING
385
+ end
386
+ when '(', '['
387
+ T_LPAREN
388
+ when ')', ']'
389
+ T_RPAREN
390
+ when '.'
391
+ str += readwhile( /[_a-zA-Z0-9!?.]/ )
392
+ if 1 == str.length
393
+ T_DOT
394
+ else
395
+ T_SYMBOL
396
+ end
397
+ when /[\r\n]/
398
+ T_LINEFEED
399
+ when /;/
425
400
  readwhile( /[^\r\n]/ )
426
401
  str = ""
427
402
  T_COMMENT
428
- when "("
429
- str = ""
430
- T_LVECTOR
431
- when "t"
432
- str = "true"
433
- T_SYMBOL
434
- when "f"
435
- str = "false"
436
- T_SYMBOL
437
- when "b","o","d","x"
438
- str = readwhile( /[0-9a-zA-Z]/ )
403
+ when /[#]/
404
+ nextch = peekchar( /[?!tfbodx(]/ )
439
405
  case nextch
440
- when "b"
441
- if str.match( /^[0-1]+$/ )
442
- str = "0b" + str
443
- else
444
- raise RuntimeError, sprintf( "Error: illegal #b number for Nendo #b%s", str )
445
- end
446
- when "o"
447
- if str.match( /^[0-7]+$/ )
448
- str = "0o" + str
449
- else
450
- raise RuntimeError, sprintf( "Error: illegal #o number for Nendo #o%s", str )
451
- end
452
- when "d"
453
- if str.match( /^[0-9]+$/ )
454
- str = "0d" + str
406
+ when "?"
407
+ if peekchar( /[=]/ )
408
+ str = ""
409
+ T_DEBUG_PRINT
455
410
  else
456
- raise RuntimeError, sprintf( "Error: illegal #d number for Nendo #d%s", str )
457
- end
458
- when "x"
459
- if str.match( /^[0-9a-fA-F]+$/ )
460
- str = "0x" + str
461
- else
462
- raise RuntimeError, sprintf( "Error: illegal #x number for Nendo #x%s", str )
411
+ str += readwhile( /[^ \t\r\n]/ )
412
+ raise NameError, sprintf( "Error: unknown #xxxx syntax for Nendo %s", str )
413
+ end
414
+ when "!"
415
+ readwhile( /[^\r\n]/ )
416
+ str = ""
417
+ T_COMMENT
418
+ when "("
419
+ str = ""
420
+ T_LVECTOR
421
+ when "t"
422
+ str = "true"
423
+ T_SYMBOL
424
+ when "f"
425
+ str = "false"
426
+ T_SYMBOL
427
+ when "b","o","d","x"
428
+ str = readwhile( /[0-9a-zA-Z]/ )
429
+ case nextch
430
+ when "b"
431
+ if str.match( /^[0-1]+$/ )
432
+ str = "0b" + str
433
+ else
434
+ raise RuntimeError, sprintf( "Error: illegal #b number for Nendo #b%s", str )
435
+ end
436
+ when "o"
437
+ if str.match( /^[0-7]+$/ )
438
+ str = "0o" + str
439
+ else
440
+ raise RuntimeError, sprintf( "Error: illegal #o number for Nendo #o%s", str )
441
+ end
442
+ when "d"
443
+ if str.match( /^[0-9]+$/ )
444
+ str = "0d" + str
445
+ else
446
+ raise RuntimeError, sprintf( "Error: illegal #d number for Nendo #d%s", str )
447
+ end
448
+ when "x"
449
+ if str.match( /^[0-9a-fA-F]+$/ )
450
+ str = "0x" + str
451
+ else
452
+ raise RuntimeError, sprintf( "Error: illegal #x number for Nendo #x%s", str )
453
+ end
463
454
  end
455
+ str = Integer( str ).to_s
456
+ T_NUM
457
+ else
458
+ str += readwhile( /[^ \t\r\n]/ )
459
+ raise NameError, sprintf( "Error: unknown #xxxx syntax for Nendo %s", str )
460
+ end
461
+ when /[_a-zA-Z!$%&*+\/:<=>?@^~-]/ # symbol
462
+ str += readwhile( /[0-9._a-zA-Z!$%&*+\/:<=>?@^~-]/ )
463
+ if str.match( /^[=][>]$/ )
464
+ T_FEEDTO
465
+ elsif str.match( /^[+-][0-9.]+$/ )
466
+ T_NUM
467
+ elsif str.match( /^[:]/ )
468
+ str = str[1..-1]
469
+ T_KEYWORD
470
+ else
471
+ T_SYMBOL
464
472
  end
465
- str = Integer( str ).to_s
473
+ when /[0-9]/ # Numeric
474
+ str += readwhile( /[0-9.]/ )
466
475
  T_NUM
476
+ when /["]/ # String
477
+ str = LispString.new( readstring() )
478
+ readwhile( /["]/ )
479
+ T_STRING
467
480
  else
468
481
  str += readwhile( /[^ \t\r\n]/ )
469
- raise NameError, sprintf( "Error: unknown #xxxx syntax for Nendo %s", str )
482
+ raise NameError, sprintf( "Error: unknown token for Nendo [%s]", str )
470
483
  end
471
- when /[_a-zA-Z!$%&*+\/:<=>?@^~-]/ # symbol
472
- str += readwhile( /[0-9._a-zA-Z!$%&*+\/:<=>?@^~-]/ )
473
- if str.match( /^[=][>]$/ )
474
- T_FEEDTO
475
- elsif str.match( /^[+-][0-9.]+$/ )
476
- T_NUM
477
- elsif str.match( /^[:]/ )
478
- str = str[1..-1]
479
- T_KEYWORD
484
+ printf( " token: [%s] : %s (%s:L%d:C%d)\n", str, kind.to_s, @chReader.sourcefile, @chReader.lineno, @chReader.column ) if @debug
485
+ @curtoken = Token.new( kind, str, @chReader.sourcefile, @chReader.lineno, @chReader.column )
486
+ end
487
+ end
488
+
489
+ def token
490
+ begin
491
+ tokenWithComment
492
+ end while T_COMMENT == curtoken.kind
493
+ curtoken
494
+ end
495
+
496
+ def curtoken
497
+ if !@curtoken
498
+ self.token
499
+ end
500
+ @curtoken
501
+ end
502
+
503
+ def atom
504
+ cur = curtoken
505
+ printf( " NonT: [%s] : [%s]\n", "atom", cur.str ) if @debug
506
+ token
507
+ case cur.kind
508
+ when T_SYMBOL
509
+ sym = cur.str.intern
510
+ sym.setLispToken( cur )
511
+ case sym
512
+ when :true
513
+ true
514
+ when :false
515
+ false
516
+ when :nil
517
+ nil
518
+ else
519
+ sym
520
+ end
521
+ when T_NUM
522
+ if cur.str.match( /[.]/ ) # floating point
523
+ cur.str.to_f
524
+ else
525
+ cur.str.to_i
526
+ end
527
+ when T_STRING
528
+ cur.str
529
+ when T_QUOTE
530
+ :quote
531
+ when T_QUASIQUOTE
532
+ :quasiquote
533
+ when T_UNQUOTE
534
+ :unquote
535
+ when T_UNQUOTE_SPLICING
536
+ :"unquote-splicing"
537
+ when T_DOT
538
+ :"dot-operator"
539
+ when T_FEEDTO
540
+ :feedto
541
+ when T_DEBUG_PRINT
542
+ "debug-print".intern
543
+ when T_KEYWORD
544
+ LispKeyword.new( cur.str )
545
+ else
546
+ raise "Error: Unknown token in atom()"
547
+ end
548
+ end
549
+
550
+ # vector := sexp
551
+ # | atom ... atom
552
+ def vector
553
+ printf( " NonT: [%s]\n", "vector" ) if @debug
554
+ arr = []
555
+ while true
556
+ case curtoken.kind
557
+ when T_LINEFEED
558
+ token # skipEnter
559
+ when T_EOF
560
+ raise RuntimeError, "Error: unbalanced vector's paren(4)"
561
+ when T_LPAREN, T_LVECTOR
562
+ arr << sexp()
563
+ when T_RPAREN
564
+ break
565
+ when T_QUOTE , T_QUASIQUOTE , T_UNQUOTE , T_UNQUOTE_SPLICING, T_DEBUG_PRINT
566
+ arr << sexp()
567
+ when T_DOT
568
+ raise RuntimeError, "Error: illegal list."
569
+ else
570
+ arr << atom()
571
+ end
572
+ end
573
+ arr
574
+ end
575
+
576
+ # list := sexp
577
+ # | atom ... atom
578
+ # | atom ... . atom
579
+ def list
580
+ printf( " NonT: [%s]\n", "list" ) if @debug
581
+ dotted = false
582
+ cells = []
583
+ lastAtom = Nil.new
584
+ while true
585
+ case curtoken.kind
586
+ when T_LINEFEED
587
+ token # skipEnter
588
+ when T_EOF
589
+ raise RuntimeError, "Error: unbalanced paren(1)"
590
+ when T_LPAREN, T_LVECTOR
591
+ cells << Cell.new( sexp() )
592
+ when T_RPAREN
593
+ break
594
+ when T_DOT
595
+ if 0 == cells.length
596
+ # (. symbol1 symbol2 ... ) form
597
+ cells << Cell.new( atom() )
480
598
  else
481
- T_SYMBOL
599
+ # ( symbol1 ... symbol2 . symbol3 ) form
600
+ token
601
+ lastAtom = sexp()
602
+ if lastAtom.is_a? Cell and lastAtom.isNull
603
+ lastAtom = Nil.new # the null list "()" could not be a lastAtom.
604
+ end
482
605
  end
483
- when /[0-9]/ # Numeric
484
- str += readwhile( /[0-9.]/ )
485
- T_NUM
486
- when /["]/ # String
487
- str = LispString.new( readstring() )
488
- readwhile( /["]/ )
489
- T_STRING
606
+ when T_QUOTE , T_QUASIQUOTE , T_UNQUOTE , T_UNQUOTE_SPLICING, T_DEBUG_PRINT
607
+ cells << Cell.new( sexp() )
490
608
  else
491
- str += readwhile( /[^ \t\r\n]/ )
492
- raise NameError, sprintf( "Error: unknown token for Nendo [%s]", str )
609
+ if not lastAtom.is_a? Nil
610
+ raise "Error : illegal dotted pair syntax."
611
+ else
612
+ cells << Cell.new( atom() )
613
+ end
493
614
  end
494
- printf( " token: [%s] : %s (%s:L%d:C%d)\n", str, kind.to_s, @chReader.sourcefile, @chReader.lineno, @chReader.column ) if @debug
495
- @curtoken = Token.new( kind, str, @chReader.sourcefile, @chReader.lineno, @chReader.column )
496
- end
497
- end
498
-
499
- def token
500
- begin
501
- tokenWithComment
502
- end while T_COMMENT == curtoken.kind
503
- curtoken
504
- end
505
-
506
- def curtoken
507
- if !@curtoken
508
- self.token
615
+ end
616
+ ## setup list
617
+ if 0 == cells.size
618
+ Cell.new() # null list
619
+ elsif 1 == cells.size
620
+ cells.first.cdr = lastAtom
621
+ cells.first
622
+ elsif 1 < cells.size
623
+ ptr = cells.pop
624
+ ptr.cdr = lastAtom
625
+ cells.reverse.each { |x|
626
+ x.cdr = ptr
627
+ ptr = x
628
+ }
629
+ cells.first
630
+ end
509
631
  end
510
- @curtoken
511
- end
512
-
513
- def atom
514
- cur = curtoken
515
- printf( " NonT: [%s] : [%s]\n", "atom", cur.str ) if @debug
516
- token
517
- case cur.kind
518
- when T_SYMBOL
519
- sym = cur.str.intern
520
- sym.setLispToken( cur )
521
- case sym
522
- when :true
523
- true
524
- when :false
525
- false
526
- when :nil
527
- nil
528
- else
529
- sym
632
+
633
+ def skipEnter
634
+ while T_LINEFEED == curtoken.kind
635
+ token
530
636
  end
531
- when T_NUM
532
- if cur.str.match( /[.]/ ) # floating point
533
- cur.str.to_f
534
- else
535
- cur.str.to_i
536
- end
537
- when T_STRING
538
- cur.str
539
- when T_QUOTE
540
- :quote
541
- when T_QUASIQUOTE
542
- :quasiquote
543
- when T_UNQUOTE
544
- :unquote
545
- when T_UNQUOTE_SPLICING
546
- :"unquote-splicing"
547
- when T_DOT
548
- :"dot-operator"
549
- when T_FEEDTO
550
- :feedto
551
- when T_DEBUG_PRINT
552
- "debug-print".intern
553
- when T_KEYWORD
554
- LispKeyword.new( cur.str )
555
- else
556
- raise "Error: Unknown token in atom()"
557
637
  end
558
- end
559
-
560
- # vector := sexp
561
- # | atom ... atom
562
- def vector
563
- printf( " NonT: [%s]\n", "vector" ) if @debug
564
- arr = []
565
- while true
638
+
639
+ # sexp := ( list ) | | #( vector ) | 'sexp | `sexp | atom
640
+ def sexp
641
+ printf( " NonT: [%s]\n", "sexp" ) if @debug
566
642
  case curtoken.kind
567
643
  when T_LINEFEED
568
- token # skipEnter
644
+ token
645
+ sexp()
569
646
  when T_EOF
570
- raise RuntimeError, "Error: unbalanced vector's paren(4)"
571
- when T_LPAREN, T_LVECTOR
572
- arr << sexp()
647
+ raise RuntimeError, "Error: unbalanced paren(2)"
648
+ when T_LPAREN
649
+ skipEnter
650
+ token # consume '('
651
+ ret = list()
652
+ skipEnter
653
+ token # consume ')'
654
+ ret
573
655
  when T_RPAREN
574
- break
575
- when T_QUOTE , T_QUASIQUOTE , T_UNQUOTE , T_UNQUOTE_SPLICING, T_DEBUG_PRINT
576
- arr << sexp()
577
- when T_DOT
578
- raise RuntimeError, "Error: illegal list."
656
+ raise RuntimeError, "Error: unbalanced paren(3)"
657
+ when T_LVECTOR
658
+ skipEnter
659
+ token # consume '#('
660
+ ret = vector()
661
+ skipEnter
662
+ token # consume ')'
663
+ ret
664
+ when T_QUOTE , T_QUASIQUOTE , T_UNQUOTE , T_UNQUOTE_SPLICING
665
+ _atom = atom() ## "quote" symbol
666
+ Cell.new( _atom, Cell.new( sexp() ))
667
+ when T_DEBUG_PRINT
668
+ file = curtoken.sourcefile
669
+ lineno = curtoken.lineno
670
+ _atom = atom() ## "debug-print" symbol
671
+ child = sexp()
672
+ [_atom, child, LispString.new( file ), lineno, Cell.new( :quote, Cell.new( child )) ].to_list
579
673
  else
580
- arr << atom()
674
+ atom()
581
675
  end
582
676
  end
583
- arr
584
- end
585
677
 
586
- # list := sexp
587
- # | atom ... atom
588
- # | atom ... . atom
589
- def list
590
- printf( " NonT: [%s]\n", "list" ) if @debug
591
- dotted = false
592
- cells = []
593
- lastAtom = nil
594
- while true
678
+ # return value is [ S-expression-tree, eof-flag, valid-sexp-flag ]
679
+ def _read
680
+ @chReader = CharReader.new( @inport, @sourcefile ) unless @chReader
595
681
  case curtoken.kind
596
- when T_LINEFEED
597
- token # skipEnter
598
682
  when T_EOF
599
- raise RuntimeError, "Error: unbalanced paren(1)"
600
- when T_LPAREN, T_LVECTOR
601
- cells << Cell.new( sexp() )
602
- when T_RPAREN
603
- break
604
- when T_DOT
605
- if 0 == cells.length
606
- # (. symbol1 symbol2 ... ) form
607
- cells << Cell.new( atom() )
683
+ [ Nil.new, true, false ]
684
+ when T_LINEFEED
685
+ token
686
+ [ Nil.new, false, false ]
687
+ else
688
+ [ sexp(), false, true ]
689
+ end
690
+ end
691
+ end
692
+
693
+
694
+ # built-in functions
695
+ module BuiltinFunctions
696
+ def __assertFlat( *args )
697
+ if 0 == args.length
698
+ raise ArgumentError, "Error: + - * / % operator got illegal argument. "
699
+ else
700
+ args.each { |x|
701
+ if Cell == x.class or Nil == x.class
702
+ raise ArgumentError, "Error: + - * / % operator got illegal argument. "
703
+ end
704
+ }
705
+ end
706
+ end
707
+
708
+ def __assertList( funcname, arg )
709
+ if Cell != arg.class
710
+ raise ArgumentError, "Error: %s expects a list argument.\n"
711
+ end
712
+ end
713
+
714
+ def _equal_QUMARK( a, b )
715
+ if a.class != b.class
716
+ false
717
+ elsif a.class == Cell
718
+ if a.isNull and b.isNull
719
+ true
608
720
  else
609
- # ( symbol1 ... symbol2 . symbol3 ) form
610
- token
611
- lastAtom = sexp()
612
- if lastAtom.is_a? Cell and lastAtom.isNull
613
- lastAtom = Nil.new # the null list "()" could not be a lastAtom.
721
+ _equal_QUMARK( a.car, b.car ) and _equal_QUMARK( a.cdr, b.cdr )
722
+ end
723
+ elsif a.class == Nil and b.class == Nil
724
+ true
725
+ else
726
+ (a === b)
727
+ end
728
+ end
729
+
730
+ def __PLMARK( *args )
731
+ arr = args[0].to_arr
732
+ case args[0].length
733
+ when 0
734
+ 0
735
+ else
736
+ __assertFlat( arr )
737
+ arr.each { |x|
738
+ if not (_number_QUMARK(x) or _string_QUMARK(x))
739
+ raise TypeError
614
740
  end
741
+ }
742
+ case args[0].length
743
+ when 1
744
+ args[0].car
745
+ else
746
+ arr[1..-1].inject(arr[0]){|x,y| x+y}
615
747
  end
616
- when T_QUOTE , T_QUASIQUOTE , T_UNQUOTE , T_UNQUOTE_SPLICING, T_DEBUG_PRINT
617
- cells << Cell.new( sexp() )
748
+ end
749
+ end
750
+
751
+ def __ASMARK( *args )
752
+ arr = args[0].to_arr
753
+ case args[0].length
754
+ when 0
755
+ 1
618
756
  else
619
- if lastAtom
620
- raise "Error : illegal dotted pair syntax."
757
+ __assertFlat( arr )
758
+ arr.each { |x|
759
+ if not _number_QUMARK(x)
760
+ raise TypeError
761
+ end
762
+ }
763
+ case args[0].length
764
+ when 1
765
+ args[0].car
621
766
  else
622
- cells << Cell.new( atom() )
767
+ arr[1..-1].inject(arr[0]){|x,y| x*y}
623
768
  end
624
769
  end
625
770
  end
626
- ## setup list
627
- if 0 == cells.size
628
- Cell.new() # null list
629
- elsif 1 == cells.size
630
- if lastAtom
631
- cells.first.cdr = lastAtom
771
+
772
+ def __MIMARK( first, *rest )
773
+ raise TypeError if not _number_QUMARK(first)
774
+ rest = rest[0].to_arr
775
+ __assertFlat( rest )
776
+ if 0 == rest.length
777
+ - first
778
+ else
779
+ rest.inject(first){|x,y| x-y}
632
780
  end
633
- cells.first
634
- elsif 1 < cells.size
635
- ptr = cells.pop
636
- if lastAtom
637
- ptr.cdr = lastAtom
781
+ end
782
+
783
+ def __SLMARK( first, *rest )
784
+ raise TypeError if not _number_QUMARK(first)
785
+ rest = rest[0].to_arr
786
+ __assertFlat( rest )
787
+ if 0 == rest.length
788
+ 1 / first
789
+ else
790
+ rest.inject(first){|x,y| x/y}
638
791
  end
639
- cells.reverse.each { |x|
640
- x.cdr = ptr
641
- ptr = x
642
- }
643
- cells.first
644
792
  end
645
- end
646
-
647
- def skipEnter
648
- while T_LINEFEED == curtoken.kind
649
- token
793
+
794
+ def __PAMARK( first, *rest )
795
+ _modulo( first, *rest )
796
+ end
797
+
798
+ def _quotient( first, second )
799
+ raise TypeError if not _number_QUMARK(first)
800
+ raise TypeError if not _number_QUMARK(second)
801
+ (first / second.to_f).to_i
802
+ end
803
+
804
+ def _remainder( first, second )
805
+ raise TypeError if not _number_QUMARK(first)
806
+ raise TypeError if not _number_QUMARK(second)
807
+ first - _quotient( first, second ) * second
808
+ end
809
+
810
+ def _modulo( first, *rest )
811
+ raise TypeError if not _number_QUMARK(first)
812
+ rest = rest[0].to_arr
813
+ __assertFlat( rest )
814
+ if 0 == rest.length
815
+ 1 % first
816
+ else
817
+ rest.inject(first){|x,y| x%y}
818
+ end
650
819
  end
651
- end
652
-
653
- # sexp := ( list ) | | #( vector ) | 'sexp | `sexp | atom
654
- def sexp
655
- printf( " NonT: [%s]\n", "sexp" ) if @debug
656
- case curtoken.kind
657
- when T_LINEFEED
658
- token
659
- sexp()
660
- when T_EOF
661
- raise RuntimeError, "Error: unbalanced paren(2)"
662
- when T_LPAREN
663
- skipEnter
664
- token # consume '('
665
- ret = list()
666
- skipEnter
667
- token # consume ')'
668
- ret
669
- when T_RPAREN
670
- raise RuntimeError, "Error: unbalanced paren(3)"
671
- when T_LVECTOR
672
- skipEnter
673
- token # consume '#('
674
- ret = vector()
675
- skipEnter
676
- token # consume ')'
677
- ret
678
- when T_QUOTE , T_QUASIQUOTE , T_UNQUOTE , T_UNQUOTE_SPLICING
679
- _atom = atom() ## "quote" symbol
680
- Cell.new( _atom, Cell.new( sexp() ))
681
- when T_DEBUG_PRINT
682
- file = curtoken.sourcefile
683
- lineno = curtoken.lineno
684
- _atom = atom() ## "debug-print" symbol
685
- child = sexp()
686
- [_atom, child, LispString.new( file ), lineno, Cell.new( :quote, Cell.new( child )) ].to_list
687
- else
688
- atom()
820
+
821
+ def _not( arg )
822
+ arg = false if Nil == arg.class
823
+ not arg
824
+ end
825
+
826
+ def _cons( first, second )
827
+ if first.is_a? Nil
828
+ first = Cell.new
829
+ end
830
+ if second.is_a? Cell
831
+ if second.isNull
832
+ Cell.new( first )
833
+ else
834
+ Cell.new( first, second )
835
+ end
836
+ else
837
+ Cell.new( first, second )
838
+ end
689
839
  end
690
- end
691
840
 
692
- # return value is [ S-expression-tree, eof-flag, valid-sexp-flag ]
693
- def _read
694
- case curtoken.kind
695
- when T_EOF
696
- [ Nil.new, true, false ]
697
- when T_LINEFEED
698
- token
699
- [ Nil.new, false, false ]
700
- else
701
- [ sexp(), false, true ]
841
+ def _set_MIMARKcar_EXMARK( cell, arg )
842
+ if cell.is_a? Cell
843
+ cell.car = arg
844
+ cell
845
+ else
846
+ raise TypeError
847
+ end
702
848
  end
703
- end
704
- end
705
849
 
850
+ def _set_MIMARKcdr_EXMARK( cell, arg )
851
+ arg = if arg.is_a? Cell
852
+ _null_QUMARK( arg ) ? Nil.new : arg
853
+ else
854
+ arg
855
+ end
856
+ if cell.is_a? Cell
857
+ cell.cdr = arg
858
+ cell
859
+ else
860
+ raise TypeError
861
+ end
862
+ end
706
863
 
707
- # built-in functions
708
- module BuiltinFunctions
709
- def __assertFlat( *args )
710
- if 0 == args.length
711
- raise ArgumentError, "Error: + - * / % operator got illegal argument. "
712
- else
713
- args.each { |x|
714
- if Cell == x.class or Nil == x.class
715
- raise ArgumentError, "Error: + - * / % operator got illegal argument. "
864
+ def _exit( *args )
865
+ if 0 == args[0].length
866
+ Kernel::exit(0)
867
+ else
868
+ arr = args[0].to_arr
869
+ Kernel::exit(arr[0])
870
+ end
871
+ end
872
+
873
+ def _print( format, *rest )
874
+ print( format, *(rest[0].to_arr) )
875
+ end
876
+
877
+ def _printf( format, *rest )
878
+ Kernel::printf( format, *(rest[0].to_arr) )
879
+ end
880
+
881
+ def _sprintf( format, *rest )
882
+ Kernel::sprintf( format, *(rest[0].to_arr) )
883
+ end
884
+
885
+ def _null_QUMARK( arg )
886
+ if Nil == arg.class
887
+ true
888
+ elsif Cell == arg.class
889
+ arg.isNull
890
+ else
891
+ false
892
+ end
893
+ end
894
+ def _length( arg )
895
+ if _null_QUMARK( arg )
896
+ 0
897
+ elsif arg.is_a? Cell
898
+ arg.length
899
+ else
900
+ raise TypeError
901
+ end
902
+ end
903
+ def _list( *args) args[0] end
904
+ def _sort( arg ) arg.to_arr.sort.to_list end
905
+ def _reverse( arg ) arg.to_arr.reverse.to_list end
906
+ def _uniq( arg ) arg.to_arr.uniq.to_list end
907
+ def _range( num, *args )
908
+ arr = args[0].to_arr
909
+ if 0 < arr.length
910
+ if arr[0].is_a? Fixnum
911
+ (0..num-1).to_a.map { |x| x + arr[0] }.to_list
912
+ else
913
+ raise TypeError, "Error range's start expects number."
914
+ end
915
+ else
916
+ (0..num-1).to_a.to_list
917
+ end
918
+ end
919
+ def __EQMARK( a,b ) a == b end
920
+ def __GTMARK( a,b ) a > b end
921
+ def __GTMARK_EQMARK( a,b ) a >= b end
922
+ def __LTMARK( a,b ) a < b end
923
+ def __LTMARK_EQMARK( a,b ) a <= b end
924
+ def _eqv_QUMARK( a,b ) a === b end
925
+ def _eq_QUMARK( a,b ) a == b end
926
+ def _gt_QUMARK( a,b ) a > b end
927
+ def _ge_QUMARK( a,b ) a >= b end
928
+ def _lt_QUMARK( a,b ) a < b end
929
+ def _le_QUMARK( a,b ) a <= b end
930
+ def _eqv_QUMARK( a,b ) a === b end
931
+ def _car( cell ) cell.car end
932
+ def _cdr( cell ) cell.cdr end
933
+ def _write( arg ) printer = Printer.new ; print printer._write( arg ) ; arg end
934
+ def _write_MIMARKto_MIMARKstring( arg ) printer = Printer.new ; printer._write( arg ) end
935
+ def _display( arg ) printer = Printer.new ; print printer._print( arg ) ; arg end
936
+ def _print( arg ) self._display( arg ) ; self._newline() ; arg end
937
+ def _newline( ) print "\n" end
938
+ def _procedure_QUMARK( arg ) ((Proc == arg.class) or (Method == arg.class)) end
939
+ def _macro_QUMARK( arg ) (LispMacro == arg.class) end
940
+ def _symbol_QUMARK( arg ) (Symbol == arg.class) end
941
+ def _keyword_QUMARK( arg ) (arg.is_a? LispKeyword) end
942
+ def _pair_QUMARK( arg )
943
+ if _null_QUMARK( arg )
944
+ false
945
+ else
946
+ (Cell == arg.class)
947
+ end
948
+ end
949
+ def _integer_QUMARK( arg ) arg.is_a? Integer end
950
+ def _number_QUMARK( arg ) arg.is_a? Numeric end
951
+ def _string_QUMARK( arg ) String == arg.class end
952
+ def _macroexpand_MIMARK1( arg )
953
+ if _pair_QUMARK( arg )
954
+ macroexpandInit( 1 )
955
+ macroexpandEngine( arg )
956
+ else
957
+ arg
958
+ end
959
+ end
960
+ def _to_s( arg ) _to_MIMARKs( arg ) end
961
+ def _to_MIMARKs( arg ) arg.to_s end
962
+ def _to_i( arg ) _to_MIMARKi( arg ) end
963
+ def _to_MIMARKi( arg ) arg.to_i end
964
+ def _nil_QUMARK( arg ) arg.nil? end
965
+ def _to_list( arg ) _to_MIMARKlist( arg ) end
966
+ def _to_MIMARKlist( arg )
967
+ case arg
968
+ when Array
969
+ arg.to_list
970
+ when Cell
971
+ arg
972
+ else
973
+ raise TypeError
974
+ end
975
+ end
976
+ def _to_arr( arg ) _to_MIMARKarr( arg ) end
977
+ def _to_MIMARKarr( arg )
978
+ case arg
979
+ when Cell
980
+ arg.to_arr
981
+ when Array
982
+ arg
983
+ else
984
+ raise TypeError
985
+ end
986
+ end
987
+ def _intern( arg ) arg.intern end
988
+ def _string_MIMARK_GTMARKsymbol( arg ) arg.intern end
989
+ def _symbol_MIMARK_GTMARKstring( arg ) arg.to_s end
990
+ def _string_MIMARKjoin( lst, *args )
991
+ arr = args[0].to_arr
992
+ if 0 < arr.length
993
+ if not arr[0].is_a? String
994
+ raise TypeError, "Error string-join's expects delimitter as String."
995
+ else
996
+ lst.to_a.map{ |x| x.car }.join( arr[0] )
997
+ end
998
+ else
999
+ lst.to_a.map{ |x| x.car }.join
1000
+ end
1001
+ end
1002
+ def _require( arg )
1003
+ Kernel::require( arg )
1004
+ false
1005
+ end
1006
+ def _read( *args )
1007
+ lst = args[0].to_arr
1008
+ io = if 0 == lst.length
1009
+ STDIN
1010
+ else
1011
+ lst[0]
1012
+ end
1013
+ reader = Reader.new( io, "STDIN", false )
1014
+ ret = nil
1015
+ begin
1016
+ s = reader._read
1017
+ ret = s[0]
1018
+ if s[1] # EOF?
1019
+ ret = Cell.new
1020
+ break
716
1021
  end
717
- }
1022
+ end until s[2]
1023
+ ret
718
1024
  end
719
- end
720
1025
 
721
- def __assertList( funcname, arg )
722
- if Cell != arg.class
723
- raise ArgumentError, "Error: %s expects a list argument.\n"
1026
+ def _apply1( first, arg )
1027
+ trampCall( callProcedure( "(apply1 genereate func)", first, arg ))
724
1028
  end
725
- end
726
1029
 
727
- def _equal_QUMARK( a, b )
728
- if a.class != b.class
729
- false
730
- elsif a.class == Cell
731
- if a.isNull and b.isNull
732
- true
1030
+ def _global_MIMARKvariables
1031
+ self.instance_variables.select { |x|
1032
+ x.match( /^[@]_[a-zA-Z]/ )
1033
+ }.map{ |name|
1034
+ self.toLispSymbol( name[1..-1] ).intern
1035
+ }.to_list
1036
+ end
1037
+
1038
+ def _make_MIMARKvalues( lst )
1039
+ if _pair_QUMARK( lst )
1040
+ LispValues.new( lst.to_arr )
1041
+ elsif _null_QUMARK( lst )
1042
+ LispValues.new( [] )
733
1043
  else
734
- _equal_QUMARK( a.car, b.car ) and _equal_QUMARK( a.cdr, b.cdr )
1044
+ raise ArgumentError, "Error: make-values expects a list argument."
735
1045
  end
736
- elsif a.class == Nil and b.class == Nil
737
- true
738
- else
739
- (a === b)
740
1046
  end
741
- end
742
1047
 
743
- def __PLMARK( *args )
744
- arr = args[0].to_arr
745
- case args[0].length
746
- when 0
747
- 0
748
- else
749
- __assertFlat( arr )
750
- arr.each { |x|
751
- if not (_number_QUMARK(x) or _string_QUMARK(x))
752
- raise TypeError
753
- end
754
- }
755
- case args[0].length
756
- when 1
757
- args[0].car
1048
+ def _values_QUMARK( arg ) arg.is_a? LispValues end
1049
+
1050
+ def _values_MIMARKvalues( arg )
1051
+ if _values_QUMARK( arg )
1052
+ arg.values.to_list
758
1053
  else
759
- arr[1..-1].inject(arr[0]){|x,y| x+y}
1054
+ raise TypeError, "Error: values-values expects only LispValues object."
760
1055
  end
761
1056
  end
762
- end
763
1057
 
764
- def __ASMARK( *args )
765
- arr = args[0].to_arr
766
- case args[0].length
767
- when 0
768
- 1
769
- else
770
- __assertFlat( arr )
771
- arr.each { |x|
772
- if not _number_QUMARK(x)
773
- raise TypeError
774
- end
775
- }
776
- case args[0].length
777
- when 1
778
- args[0].car
1058
+ def _make_MIMARKkeyword( arg )
1059
+ if _symbol_QUMARK( arg ) or _string_QUMARK( arg )
1060
+ LispKeyword.new( arg.to_s )
779
1061
  else
780
- arr[1..-1].inject(arr[0]){|x,y| x*y}
1062
+ raise TypeError, "Error: make-keyword expects symbol or string object."
781
1063
  end
782
1064
  end
783
- end
784
-
785
- def __MIMARK( first, *rest )
786
- raise TypeError if not _number_QUMARK(first)
787
- rest = rest[0].to_arr
788
- __assertFlat( rest )
789
- if 0 == rest.length
790
- - first
791
- else
792
- rest.inject(first){|x,y| x-y}
793
- end
794
- end
795
-
796
- def __SLMARK( first, *rest )
797
- raise TypeError if not _number_QUMARK(first)
798
- rest = rest[0].to_arr
799
- __assertFlat( rest )
800
- if 0 == rest.length
801
- 1 / first
802
- else
803
- rest.inject(first){|x,y| x/y}
804
- end
805
- end
806
-
807
- def __PAMARK( first, *rest )
808
- raise TypeError if not _number_QUMARK(first)
809
- rest = rest[0].to_arr
810
- __assertFlat( rest )
811
- if 0 == rest.length
812
- 1 % first
813
- else
814
- rest.inject(first){|x,y| x%y}
815
- end
816
- end
817
-
818
- def _not( arg )
819
- arg = false if Nil == arg.class
820
- not arg
821
- end
822
-
823
- def _cons( first, second )
824
- if second.is_a? Cell
825
- if second.isNull
826
- Cell.new( first )
1065
+
1066
+ def _keyword_MIMARK_GTMARKstring( arg )
1067
+ if _keyword_QUMARK( arg )
1068
+ arg.key.to_s
827
1069
  else
828
- Cell.new( first, second )
1070
+ raise TypeError, "Error: keyword->string expects only keyword object."
829
1071
  end
830
- else
831
- Cell.new( first, second )
832
- end
833
- end
834
-
835
- def _exit( *args )
836
- if 0 == args[0].length
837
- Kernel::exit(0)
838
- else
839
- arr = args[0].to_arr
840
- Kernel::exit(arr[0])
841
- end
842
- end
843
-
844
- def _print( format, *rest )
845
- print( format, *(rest[0].to_arr) )
846
- end
847
-
848
- def _printf( format, *rest )
849
- Kernel::printf( format, *(rest[0].to_arr) )
850
- end
851
-
852
- def _sprintf( format, *rest )
853
- Kernel::sprintf( format, *(rest[0].to_arr) )
854
- end
855
-
856
- def _null_QUMARK( arg )
857
- if Nil == arg.class
858
- true
859
- elsif Cell == arg.class
860
- arg.isNull
861
- else
862
- false
863
1072
  end
864
- end
865
- def _length( arg )
866
- if _null_QUMARK( arg )
867
- 0
868
- elsif arg.is_a? Cell
869
- arg.length
870
- else
871
- raise TypeError
1073
+
1074
+ def _get_MIMARKnendo_MIMARKhome
1075
+ File.dirname(__FILE__)
872
1076
  end
873
- end
874
- def _list( *args) args[0] end
875
- def _sort( arg ) arg.to_arr.sort.to_list end
876
- def _reverse( arg ) arg.to_arr.reverse.to_list end
877
- def _uniq( arg ) arg.to_arr.uniq.to_list end
878
- def _range( num, *args )
879
- arr = args[0].to_arr
880
- if 0 < arr.length
881
- if arr[0].is_a? Fixnum
882
- (0..num-1).to_a.map { |x| x + arr[0] }.to_list
1077
+
1078
+ def _hash_MIMARKtable_MIMARKget( h, key, *args )
1079
+ if !((key.is_a? String) or ( key.is_a? Symbol))
1080
+ raise TypeError, "Error: argument key requires String or Symbol.\n"
1081
+ end
1082
+ if h.has_key?( key )
1083
+ h[key]
883
1084
  else
884
- raise TypeError, "Error range's start expects number."
1085
+ arr = args[0].to_arr
1086
+ if 0 < arr.length
1087
+ arr[0]
1088
+ else
1089
+ raise RuntimeError, sprintf( "Error: in hash-table-get() key [%s] was not exist.\n", key )
1090
+ end
885
1091
  end
886
- else
887
- (0..num-1).to_a.to_list
888
1092
  end
889
- end
890
- def __EQMARK( a,b ) a == b end
891
- def __GTMARK( a,b ) a > b end
892
- def __GTMARK_EQMARK( a,b ) a >= b end
893
- def __LTMARK( a,b ) a < b end
894
- def __LTMARK_EQMARK( a,b ) a <= b end
895
- def _eqv_QUMARK( a,b ) a === b end
896
- def _eq_QUMARK( a,b ) a == b end
897
- def _gt_QUMARK( a,b ) a > b end
898
- def _ge_QUMARK( a,b ) a >= b end
899
- def _lt_QUMARK( a,b ) a < b end
900
- def _le_QUMARK( a,b ) a <= b end
901
- def _eqv_QUMARK( a,b ) a === b end
902
- def _car( cell ) cell.car end
903
- def _cdr( cell ) cell.cdr end
904
- def _write( arg ) printer = Printer.new ; print printer._write( arg ) ; arg end
905
- def _write_MIMARKto_MIMARKstring( arg ) printer = Printer.new ; printer._write( arg ) end
906
- def _display( arg ) printer = Printer.new ; print printer._print( arg ) ; arg end
907
- def _print( arg ) self._display( arg ) ; self._newline() ; arg end
908
- def _newline( ) print "\n" end
909
- def _procedure_QUMARK( arg ) ((Proc == arg.class) or (Method == arg.class)) end
910
- def _macro_QUMARK( arg ) (LispMacro == arg.class) end
911
- def _symbol_QUMARK( arg ) (Symbol == arg.class) end
912
- def _keyword_QUMARK( arg ) (arg.is_a? LispKeyword) end
913
- def _pair_QUMARK( arg )
914
- if _null_QUMARK( arg )
915
- false
916
- else
917
- (Cell == arg.class)
1093
+
1094
+ def _hash_MIMARKtable_MIMARKput_EXMARK( h, key, value )
1095
+ if !((key.is_a? String) or ( key.is_a? Symbol))
1096
+ raise TypeError, "Error: argument key requires String or Symbol.\n"
1097
+ end
1098
+ h[key] = value
918
1099
  end
919
- end
920
- def _number_QUMARK( arg ) arg.is_a? Numeric end
921
- def _string_QUMARK( arg ) String == arg.class end
922
- def _macroexpand_MIMARK1( arg )
923
- if _pair_QUMARK( arg )
924
- macroexpand_1( arg )
925
- else
926
- arg
1100
+
1101
+ # backtrace expects this format "filename:lineno: place message ". e.g. "init.nnd:10: in aaa macro.".
1102
+ def _raise( exception, message, backtrace )
1103
+ raise exception, message, [ backtrace ]
927
1104
  end
928
- end
929
- def _to_s( arg ) _to_MIMARKs( arg ) end
930
- def _to_MIMARKs( arg ) arg.to_s end
931
- def _to_i( arg ) _to_MIMARKi( arg ) end
932
- def _to_MIMARKi( arg ) arg.to_i end
933
- def _nil_QUMARK( arg ) arg.nil? end
934
- def _to_list( arg ) _to_MIMARKlist( arg ) end
935
- def _to_MIMARKlist( arg )
936
- case arg
937
- when Array
938
- arg.to_list
939
- when Cell
940
- arg
941
- else
942
- raise TypeError
1105
+
1106
+ def __ASMARKLINE_ASMARK()
1107
+ @lastLineno
943
1108
  end
944
- end
945
- def _to_arr( arg ) _to_MIMARKarr( arg ) end
946
- def _to_MIMARKarr( arg )
947
- case arg
948
- when Cell
949
- arg.to_arr
950
- when Array
951
- arg
952
- else
953
- raise TypeError
1109
+
1110
+ def __ASMARKFILE_ASMARK()
1111
+ @lastSourcefile
954
1112
  end
955
- end
956
- def _intern( arg ) arg.intern end
957
- def _string_MIMARK_GTMARKsymbol( arg ) arg.intern end
958
- def _symbol_MIMARK_GTMARKstring( arg ) arg.to_s end
959
- def _string_MIMARKjoin( lst, *args )
960
- arr = args[0].to_arr
961
- if 0 < arr.length
962
- if not arr[0].is_a? String
963
- raise TypeError, "Error string-join's expects delimitter as String."
964
- else
965
- lst.to_a.map{ |x| x.car }.join( arr[0] )
1113
+
1114
+ def _vector_MIMARKset_EXMARK( v, index, value )
1115
+ if !(v.is_a? Array)
1116
+ raise TypeError, "Error: vector-set! requires Array as argument v(Lisp's vector).\n"
966
1117
  end
967
- else
968
- lst.to_a.map{ |x| x.car }.join
1118
+ if (index < 0) or (v.size <= index)
1119
+ raise ArgumentError, "Error: vector-set! requires index between 0 and (size-1) number.\n"
1120
+ end
1121
+ v[index] = value
969
1122
  end
970
1123
  end
971
- def _require( arg )
972
- Kernel::require( arg )
973
- false
974
- end
975
- def _read( *args )
976
- lst = args[0].to_arr
977
- io = if 0 == lst.length
978
- STDIN
979
- else
980
- lst[0]
981
- end
982
- reader = Reader.new( io, "STDIN", false )
983
- ret = nil
984
- begin
985
- s = reader._read
986
- ret = s[0]
987
- if s[1] # EOF?
988
- ret = Cell.new
989
- break
990
- end
991
- end until s[2]
992
- ret
993
- end
994
-
995
- def _apply1( first, arg )
996
- callProcedure( "(apply1 genereate func)", first, arg )
997
- end
998
-
999
- def _global_MIMARKvariables
1000
- self.instance_variables.select { |x|
1001
- x.match( /^[@]_[a-zA-Z]/ )
1002
- }.map{ |name|
1003
- self.toLispSymbol( name[1..-1] ).intern
1004
- }.to_list
1005
- end
1124
+
1125
+
1126
+ # Translate S expression to Ruby expression and Evaluation
1127
+ class Evaluator
1128
+ include BuiltinFunctions
1129
+ EXEC_TYPE_NORMAL = 1
1130
+ EXEC_TYPE_ANONYMOUS = 2
1131
+ EXEC_TYPE_TAILCALL = 3
1132
+
1133
+ def initialize( debug = false )
1134
+ @indent = " "
1135
+ @binding = binding
1136
+ @debug = debug
1137
+ @char_table_lisp_to_ruby = {
1138
+ # list (! $ % & * + - . / : < = > ? @ ^ _ ~)
1139
+ '!' => '_EXMARK',
1140
+ '$' => '_DOMARK',
1141
+ '%' => '_PAMARK',
1142
+ '&' => '_ANMARK',
1143
+ '*' => '_ASMARK',
1144
+ '+' => '_PLMARK',
1145
+ '-' => '_MIMARK',
1146
+ # '.'
1147
+ '/' => '_SLMARK',
1148
+ ':' => '_COMARK',
1149
+ '<' => '_LTMARK',
1150
+ '=' => '_EQMARK',
1151
+ '>' => '_GTMARK',
1152
+ '?' => '_QUMARK',
1153
+ '@' => '_ATMARK',
1154
+ '^' => '_NKMARK',
1155
+ # '_'
1156
+ '~' => '_CHMARK',
1157
+ }
1158
+ @char_table_ruby_to_lisp = @char_table_lisp_to_ruby.invert
1159
+
1160
+ # toplevel binding
1161
+ @global_lisp_binding = Hash.new
1162
+
1163
+ # initialize buildin functions as Proc objects
1164
+ rubyExp = self.methods.select { |x|
1165
+ x.to_s.match( /^_/ )
1166
+ }.map { |name|
1167
+ [
1168
+ defMethodStr( name ),
1169
+ sprintf( "@%s = self.method( :%s ).to_proc", name, name ),
1170
+ sprintf( "@global_lisp_binding['%s'] = self.method( :%s_METHOD ).to_proc", name, name ),
1171
+ ].join( " ; " )
1172
+ }.join( " ; " )
1173
+ eval( rubyExp, @binding )
1174
+
1175
+ # reset gensym counter
1176
+ @gensym_counter = 0
1006
1177
 
1007
- def _make_MIMARKvalues( lst )
1008
- if _pair_QUMARK( lst )
1009
- LispValues.new( lst.to_arr )
1010
- elsif _null_QUMARK( lst )
1011
- LispValues.new( [] )
1012
- else
1013
- raise ArgumentError, "Error: make-values expects a list argument."
1178
+ # init optimize level
1179
+ @optimize_level = 1
1180
+
1181
+ # compiled ruby code
1182
+ # { 'filename1' => [ 'code1' 'code2' ... ],
1183
+ # 'filename2' => [ 'code1' 'code2' ... ], ... }
1184
+ @compiled_code = Hash.new
1185
+
1186
+ global_lisp_define( toRubySymbol( "%compile-phase-functions" ), Cell.new())
1014
1187
  end
1015
- end
1016
-
1017
- def _values_QUMARK( arg ) arg.is_a? LispValues end
1018
-
1019
- def _values_MIMARKvalues( arg )
1020
- if _values_QUMARK( arg )
1021
- arg.values.to_list
1022
- else
1023
- raise TypeError, "Error: values-values expects only LispValues object."
1188
+
1189
+ def global_lisp_define( rubySymbol, val )
1190
+ @___tmp = val
1191
+ eval( sprintf( "@%s = @___tmp;", rubySymbol ), @binding )
1192
+ eval( sprintf( "@global_lisp_binding['%s'] = @___tmp;", rubySymbol ), @binding )
1024
1193
  end
1025
- end
1026
-
1027
- def _make_MIMARKkeyword( arg )
1028
- if _symbol_QUMARK( arg ) or _string_QUMARK( arg )
1029
- LispKeyword.new( arg.to_s )
1030
- else
1031
- raise TypeError, "Error: make-keyword expects symbol or string object."
1194
+
1195
+ def setArgv( argv )
1196
+ self.global_lisp_define( toRubySymbol( "*argv*"), argv.to_list )
1032
1197
  end
1033
- end
1034
1198
 
1035
- def _keyword_MIMARK_GTMARKstring( arg )
1036
- if _keyword_QUMARK( arg )
1037
- arg.key.to_s
1038
- else
1039
- raise TypeError, "Error: keyword->string expects only keyword object."
1199
+ def setOptimizeLevel( level )
1200
+ @optimize_level = level
1040
1201
  end
1041
- end
1042
-
1043
- def _get_MIMARKnendo_MIMARKhome
1044
- File.dirname(__FILE__)
1045
- end
1046
1202
 
1047
- def _hash_MIMARKtable_MIMARKget( h, key, *args )
1048
- if !((key.is_a? String) or ( key.is_a? Symbol))
1049
- raise TypeError, "Error: argument key requires String or Symbol.\n"
1203
+ def getOptimizeLevel
1204
+ @optimize_level
1050
1205
  end
1051
- if h.has_key?( key )
1052
- h[key]
1053
- else
1054
- arr = args[0].to_arr
1055
- if 0 < arr.length
1056
- arr[0]
1057
- else
1058
- raise RuntimeError, sprintf( "Error: in hash-table-get() key [%s] was not exist.\n", key )
1059
- end
1060
- end
1061
- end
1062
-
1063
- def _hash_MIMARKtable_MIMARKput_EXMARK( h, key, value )
1064
- if !((key.is_a? String) or ( key.is_a? Symbol))
1065
- raise TypeError, "Error: argument key requires String or Symbol.\n"
1206
+
1207
+ def defMethodStr( name )
1208
+ sprintf( "def self.%s_METHOD( origname, pred, args ) callProcedure( origname, pred, args ) end", name )
1066
1209
  end
1067
- h[key] = value
1068
- end
1069
-
1070
- # backtrace expects this format "filename:lineno: place message ". e.g. "init.nnd:10: in aaa macro.".
1071
- def _raise( exception, message, backtrace )
1072
- raise exception, message, [ backtrace ]
1073
- end
1074
-
1075
- def __ASMARKLINE_ASMARK()
1076
- @lastLineno
1077
- end
1078
-
1079
- def __ASMARKFILE_ASMARK()
1080
- @lastSourcefile
1081
- end
1082
1210
 
1083
- def _vector_MIMARKset_EXMARK( v, index, value )
1084
- if !(v.is_a? Array)
1085
- raise TypeError, "Error: vector-set! requires Array as argument v(Lisp's vector).\n"
1211
+ def _gensym( )
1212
+ @gensym_counter += 1
1213
+ filename = if @lastSourcefile.is_a? String
1214
+ Digest::SHA1.hexdigest( @lastSourcefile )
1215
+ else
1216
+ ""
1217
+ end
1218
+ sprintf( "__gensym__%s_%d", filename, @gensym_counter ).intern
1086
1219
  end
1087
- if (index < 0) or (v.size <= index)
1088
- raise ArgumentError, "Error: vector-set! requires index between 0 and (size-1) number.\n"
1220
+
1221
+ def forward_gensym_counter( )
1222
+ @gensym_counter += 10000
1089
1223
  end
1090
- v[index] = value
1091
- end
1092
- end
1093
-
1094
-
1095
- # Translate S expression to Ruby expression and Evaluation
1096
- class Evaluator
1097
- include BuiltinFunctions
1098
- def initialize( debug = false )
1099
- @indent = " "
1100
- @binding = binding
1101
- @debug = debug
1102
- @char_table_lisp_to_ruby = {
1103
- # list (! $ % & * + - . / : < = > ? @ ^ _ ~)
1104
- '!' => '_EXMARK',
1105
- '$' => '_DOMARK',
1106
- '%' => '_PAMARK',
1107
- '&' => '_ANMARK',
1108
- '*' => '_ASMARK',
1109
- '+' => '_PLMARK',
1110
- '-' => '_MIMARK',
1111
- # '.'
1112
- '/' => '_SLMARK',
1113
- ':' => '_COMARK',
1114
- '<' => '_LTMARK',
1115
- '=' => '_EQMARK',
1116
- '>' => '_GTMARK',
1117
- '?' => '_QUMARK',
1118
- '@' => '_ATMARK',
1119
- '^' => '_NKMARK',
1120
- # '_'
1121
- '~' => '_CHMARK',
1122
- }
1123
- @char_table_ruby_to_lisp = @char_table_lisp_to_ruby.invert
1124
-
1125
- # toplevel binding
1126
- @global_lisp_binding = Hash.new
1127
-
1128
- # built-in functions
1129
- self.methods.grep( /^_/ ) { |rubySymbol|
1130
- global_lisp_define( rubySymbol, self.method( rubySymbol ))
1131
- }
1132
-
1133
- # initialize buildin functions as Proc objects
1134
- rubyExp = self.methods.select { |x|
1135
- x.to_s.match( /^_/ )
1136
- }.map { |name|
1137
- sprintf( "@%s = self.method( :%s ).to_proc", name, name )
1138
- }.join( " ; " )
1139
- eval( rubyExp, @binding )
1140
-
1141
- # reset gensym counter
1142
- @gensym_counter = 0
1143
-
1144
- # compiled ruby code
1145
- # { 'filename1' => [ 'code1' 'code2' ... ],
1146
- # 'filename2' => [ 'code1' 'code2' ... ], ... }
1147
- @compiled_code = Hash.new
1148
- end
1149
-
1150
- def global_lisp_define( rubySymbol, val )
1151
- @___tmp = val
1152
- eval( sprintf( "@%s = @___tmp;", rubySymbol ), @binding )
1153
- eval( sprintf( "@global_lisp_binding['%s'] = true;", rubySymbol ), @binding )
1154
- end
1155
-
1156
- def setArgv( argv )
1157
- self.global_lisp_define( toRubySymbol( "*argv*"), argv.to_list )
1158
- end
1159
-
1160
- def _gensym( )
1161
- @gensym_counter += 1
1162
- filename = if @lastSourcefile.is_a? String
1163
- Digest::SHA1.hexdigest( @lastSourcefile )
1164
- else
1165
- ""
1166
- end
1167
- sprintf( "__gensym__%s_%d", filename, @gensym_counter ).intern
1168
- end
1169
1224
 
1170
- def forward_gensym_counter( )
1171
- @gensym_counter += 10000
1172
- end
1173
-
1174
- def toRubyValue( val )
1175
- if NilClass == val.class
1176
- "nil"
1177
- elsif TrueClass == val.class
1178
- val.to_s
1179
- elsif FalseClass == val.class
1180
- val.to_s
1181
- else
1182
- val.to_s
1183
- end
1184
- end
1185
-
1186
- def toRubySymbol( name )
1187
- name = name.to_s if Symbol == name.class
1188
- if 0 == name.length
1189
- ""
1190
- else
1191
- arr = name.gsub( /["]/, '' ).split( /[.]/ )
1192
- tmp = arr[0]
1193
- tmp.gsub!( /[:][:]/, " " ) # save '::'
1194
- @char_table_lisp_to_ruby.each_pair { |key,val|
1195
- tmp.gsub!( Regexp.new( Regexp.escape( key )), val )
1196
- }
1197
- arr[0] = tmp.gsub( /[ ][ ]/, "::" )
1198
- if arr[0].match( /^[A-Z]/ )
1199
- # nothing to do
1200
- elsif arr[0] == ""
1201
- arr[0] = 'Kernel'
1225
+ def toRubyValue( val )
1226
+ if NilClass == val.class
1227
+ "nil"
1228
+ elsif TrueClass == val.class
1229
+ val.to_s
1230
+ elsif FalseClass == val.class
1231
+ val.to_s
1202
1232
  else
1203
- arr[0] = '_' + arr[0]
1233
+ val.to_s
1204
1234
  end
1205
- arr.join( "." )
1206
1235
  end
1207
- end
1208
-
1209
- def isRubyInterface( name )
1210
- name.to_s.match( /[.]/ )
1211
- end
1212
-
1213
- def toLispSymbol( name )
1214
- name = name.to_s if Symbol == name.class
1215
- raise ArgumentError, sprintf( "Error: `%s' is not a lisp symbol", name ) if not ('_' == name[0])
1216
- name = name[1..-1]
1217
- @char_table_ruby_to_lisp.each_pair { |key,val|
1218
- name = name.gsub( Regexp.new( key ), val )
1219
- }
1220
- name
1221
- end
1222
-
1223
- def toRubyArgument( origname, pred, args )
1224
- argument_error_message = sprintf( "Error: wrong number of arguments for closure `%s'", origname )
1225
- num = pred.arity
1226
- if 0 == num
1227
- raise ArgumentError, argument_error_message if 0 != args.length
1228
- []
1229
- elsif 0 < num
1230
- if args.isNull
1231
- [ Nil.new ]
1236
+
1237
+ def toRubySymbol( name )
1238
+ name = name.to_s if Symbol == name.class
1239
+ if 0 == name.length
1240
+ ""
1232
1241
  else
1233
- raise ArgumentError, argument_error_message if num != args.length
1234
- args.map { |x| x.car }
1235
- end
1236
- else
1237
- num = num.abs( )-1
1238
- raise ArgumentError, argument_error_message if num > args.length
1239
- params = []
1240
- rest = []
1241
- args.each_with_index { |x,i|
1242
- if i < num
1243
- params << x.car
1242
+ arr = name.gsub( /["]/, '' ).split( /[.]/ )
1243
+ tmp = arr[0]
1244
+ tmp.gsub!( /[:][:]/, " " ) # save '::'
1245
+ @char_table_lisp_to_ruby.each_pair { |key,val|
1246
+ tmp.gsub!( Regexp.new( Regexp.escape( key )), val )
1247
+ }
1248
+ arr[0] = tmp.gsub( /[ ][ ]/, "::" )
1249
+ if arr[0].match( /^[A-Z]/ )
1250
+ # nothing to do
1251
+ elsif arr[0] == ""
1252
+ arr[0] = 'Kernel'
1244
1253
  else
1245
- rest << x.car
1254
+ arr[0] = '_' + arr[0]
1246
1255
  end
1247
- }
1248
- result = []
1249
- if 0 < params.length
1250
- result = params
1256
+ arr.join( "." )
1251
1257
  end
1252
- if 0 == rest.length
1253
- result << Cell.new
1254
- else
1255
- result << rest.to_list
1256
- end
1257
- result
1258
1258
  end
1259
- end
1260
-
1261
- def callProcedure( origname, pred, args )
1262
- rubyArgument = toRubyArgument( origname, pred, args )
1263
- pred.call( *rubyArgument )
1264
- end
1265
-
1266
- # for code generation of Ruby's argument values
1267
- # in case: str = ","
1268
- # [1,"2",3] => [
1269
- # [ 1, ","]
1270
- # ["2", ","]
1271
- # [ 3 ]
1272
- # ]
1273
- def separateWith( arr, str )
1274
- seps = []
1275
- (arr.length-1).times {|n| seps << str }
1276
- arr.zip( seps ).map{ |x|
1277
- x.select { |elem| elem }
1278
- }
1279
- end
1280
-
1281
- def execFunc( funcname, args, sourcefile, lineno, locals, lambda_flag )
1282
- case funcname
1283
- when :define, :set! # `define' special form
1284
- ar = args.cdr.map { |x| x.car }
1285
- variable_sym = toRubySymbol( args.car.to_s.sub( /^:/, "" ))
1286
- global_cap = locals.flatten.include?( variable_sym.split( /[.]/ )[0] ) ? nil : "@"
1287
- [ "begin",
1288
- [
1289
- sprintf( "@global_lisp_binding['%s'] = true", variable_sym ),
1290
- sprintf( "%s%s = ", global_cap, variable_sym ),
1291
- ar ],
1292
- "end" ]
1293
- when :error
1294
- [
1295
- 'begin raise RuntimeError, ',
1296
- args.car,
1297
- "rescue => __e ",
1298
- sprintf( " __e.set_backtrace( [\"%s:%d\"] + __e.backtrace )", sourcefile, lineno ),
1299
- " raise __e",
1300
- "end "]
1301
- else
1302
- if (not lambda_flag) and isRubyInterface( funcname )
1303
- # Ruby method
1304
- # 1) convert arguments
1305
- translatedArr = args.map { |x| x.car }
1306
- # 2) generate caller code part
1307
- lispSymbolReference( toRubySymbol( funcname ), locals, translatedArr, sourcefile, lineno )
1308
- else
1309
- # Nendo function
1310
- if 0 == args.length
1311
- arr = [ "Cell.new(" ]
1259
+
1260
+ def isRubyInterface( name )
1261
+ name.to_s.match( /[.]/ )
1262
+ end
1263
+
1264
+ def toLispSymbol( name )
1265
+ name = name.to_s if Symbol == name.class
1266
+ raise ArgumentError, sprintf( "Error: `%s' is not a lisp symbol", name ) if not ('_' == name[0])
1267
+ name = name[1..-1]
1268
+ @char_table_ruby_to_lisp.each_pair { |key,val|
1269
+ name = name.gsub( Regexp.new( key ), val )
1270
+ }
1271
+ name
1272
+ end
1273
+
1274
+ def toRubyArgument( origname, pred, args )
1275
+ argument_error_message = sprintf( "Error: wrong number of arguments for closure `%s'", origname )
1276
+ num = pred.arity
1277
+ if 0 == num
1278
+ raise ArgumentError, argument_error_message if 0 != args.length
1279
+ []
1280
+ elsif 0 < num
1281
+ if args.isNull
1282
+ [ Nil.new ]
1312
1283
  else
1313
- arr = separateWith( args.map.with_index { |x,i| x.car }, ",Cell.new(" )
1314
- arr[0].unshift( "Cell.new(" )
1284
+ raise ArgumentError, argument_error_message if num != args.length
1285
+ args.map { |x| x.car }
1286
+ end
1287
+ else
1288
+ num = num.abs( )-1
1289
+ raise ArgumentError, argument_error_message if num > args.length
1290
+ params = []
1291
+ rest = []
1292
+ args.each_with_index { |x,i|
1293
+ if i < num
1294
+ params << x.car
1295
+ else
1296
+ rest << x.car
1297
+ end
1298
+ }
1299
+ result = []
1300
+ if 0 < params.length
1301
+ result = params
1315
1302
  end
1316
- if lambda_flag
1317
- [sprintf( "callProcedure( 'anonymouse', " ),
1318
- [ funcname ] + [ "," ],
1319
- arr,
1320
- sprintf( " )" ) + arr.map { |n| ")" }.join]
1303
+ if 0 == rest.length
1304
+ result << Cell.new
1321
1305
  else
1322
- origname = funcname.to_s
1323
- funcname = funcname.to_s
1324
- sym = toRubySymbol( funcname )
1325
- [sprintf( "callProcedure( '%s',", origname ),
1326
- [lispSymbolReference( sym, locals, nil, sourcefile, lineno )] + [","],
1327
- arr,
1328
- sprintf( " )" ) + arr.map { |n| ")" }.join]
1306
+ result << rest.to_list
1329
1307
  end
1308
+ result
1330
1309
  end
1331
1310
  end
1332
- end
1311
+
1312
+ def trampCall( result )
1313
+ while result.is_a? DelayedCallPacket
1314
+ method_name = toRubySymbol( result.origname ) + "_METHOD"
1315
+ @tmp_origname = result.origname
1316
+ @tmp_pred = result.pred
1317
+ @tmp_args = result.args
1318
+ result = eval( sprintf( "self.%s( @tmp_origname, @tmp_pred, @tmp_args )", method_name ), @binding )
1319
+ end
1320
+ result
1321
+ end
1333
1322
 
1334
- def makeBegin( args, locals )
1335
- ar = args.map { |e|
1336
- translate( e.car, locals )
1337
- }
1338
- ["begin", ar, "end"]
1339
- end
1323
+ def method_missing( name, *args )
1324
+ sym = toRubySymbol( name );
1325
+ if @global_lisp_binding[name].is_a? Proc
1326
+ @global_lisp_binding[name].call( args[0], args[1], args[2] )
1327
+ else
1328
+ callProcedure( args[0], args[1], args[2] )
1329
+ end
1330
+ end
1340
1331
 
1341
- # returns [ argsyms[], string ]
1342
- def toRubyParameter( argform )
1343
- argsyms = []
1344
- locals = []
1345
- rest = nil
1346
- if Symbol == argform.class
1347
- rest = argform
1348
- else
1349
- argsyms = argform.map { |x| toRubySymbol( x.car ) }
1350
- locals = argsyms.clone
1351
- rest = argform.lastAtom
1352
- end
1353
- if rest
1354
- rest = toRubySymbol( rest )
1355
- locals << rest
1356
- argsyms << "*__rest__"
1357
- [ locals, sprintf( "|%s| %s = __rest__[0] ; ", argsyms.join( "," ), rest ) ]
1358
- else
1359
- [ locals, sprintf( "|%s|", argsyms.join( "," )) ]
1332
+ def delayCall( origname, pred, args )
1333
+ case @optimize_level
1334
+ when 0 # no optimize
1335
+ callProcedure( origname, pred, args )
1336
+ else # tail call optimization
1337
+ DelayedCallPacket.new( origname, pred, args )
1338
+ end
1339
+ end
1340
+
1341
+ def callProcedure( origname, pred, args )
1342
+ pred.call( *toRubyArgument( origname, pred, args ))
1343
+ end
1344
+
1345
+ # for code generation of Ruby's argument values
1346
+ # in case: str = ","
1347
+ # [1,"2",3] => [
1348
+ # [ 1, ","]
1349
+ # ["2", ","]
1350
+ # [ 3 ]
1351
+ # ]
1352
+ def separateWith( arr, str )
1353
+ seps = []
1354
+ (arr.length-1).times {|n| seps << str }
1355
+ arr.zip( seps ).map{ |x|
1356
+ x.select { |elem| elem }
1357
+ }
1360
1358
  end
1361
- end
1362
1359
 
1363
- def makeClosure( sym, args, locals )
1364
- first = args.car
1365
- if args.car.car == :quote
1366
- first = args.car.cdr.car
1367
- end
1368
- rest = args.cdr
1369
- ( _locals, argStr ) = toRubyParameter( first )
1370
- str = case sym
1371
- when :macro
1372
- sprintf( "LispMacro.new { %s ", argStr )
1373
- when :lambda
1374
- sprintf( "Proc.new { %s ", argStr )
1360
+ def execFunc( funcname, args, sourcefile, lineno, locals, execType )
1361
+ case funcname
1362
+ when :define, :set! # `define' special form
1363
+ ar = args.cdr.map { |x| x.car }
1364
+ variable_sym = toRubySymbol( args.car.to_s.sub( /^:/, "" ))
1365
+ global_cap = locals.flatten.include?( variable_sym.split( /[.]/ )[0] ) ? nil : "@"
1366
+ [ "begin",
1367
+ [
1368
+ if global_cap
1369
+ [
1370
+ defMethodStr( variable_sym ),
1371
+ sprintf( "@global_lisp_binding['%s'] = self.method( :%s_METHOD )", variable_sym, variable_sym )
1372
+ ]
1373
+ else
1374
+ ""
1375
+ end,
1376
+ sprintf( "%s%s = ", global_cap, variable_sym ),
1377
+ "trampCall(", [ ar ], ")"],
1378
+ "end"
1379
+ ]
1380
+ when :error
1381
+ [
1382
+ 'begin raise RuntimeError, ',
1383
+ args.car,
1384
+ "rescue => __e ",
1385
+ sprintf( " __e.set_backtrace( [\"%s:%d\"] + __e.backtrace )", sourcefile, lineno ),
1386
+ " raise __e",
1387
+ "end "]
1388
+ else
1389
+ if (EXEC_TYPE_ANONYMOUS != execType) and isRubyInterface( funcname )
1390
+ # Ruby method
1391
+ # 1) convert arguments
1392
+ translatedArr = args.map { |x| x.car }
1393
+ # 2) generate caller code part
1394
+ lispSymbolReference( toRubySymbol( funcname ), locals, translatedArr, sourcefile, lineno )
1395
+ else
1396
+ # Nendo function
1397
+ if 0 == args.length
1398
+ arr = [ "Cell.new(" ]
1375
1399
  else
1376
- raise "Error: makeClosure: unknown symbol type " + sym
1400
+ arr = separateWith( args.map.with_index { |x,i| x.car }, ",Cell.new(" )
1401
+ arr[0].unshift( "Cell.new(" )
1377
1402
  end
1378
- ar = rest.map { |e|
1379
- translate( e.car, locals.clone + [_locals])
1380
- }
1381
- [ str, ar, "}" ]
1382
- end
1383
-
1384
- def makeIf( args, locals )
1385
- _condition = translate( args.car, locals )
1386
- _then = translate( args.cdr.car, locals )
1387
- _else = nil
1388
- if 2 < args.length
1389
- _else = translate( args.cdr.cdr.car, locals )
1390
- end
1391
- if _else
1392
- ["if ( ", _condition, " ) then",
1393
- [ _then ],
1394
- "else",
1395
- [ _else ],
1396
- "end"]
1397
- else
1398
- ["if ( ", _condition, " ) then",
1399
- [ _then ],
1400
- "end"]
1403
+ if EXEC_TYPE_ANONYMOUS == execType
1404
+ [sprintf( "trampCall( callProcedure( 'anonymouse', " ),
1405
+ [ funcname ] + [ "," ],
1406
+ arr,
1407
+ sprintf( " ))" ) + arr.map { |n| ")" }.join]
1408
+ else
1409
+ origname = funcname.to_s
1410
+ funcname = funcname.to_s
1411
+ sym = toRubySymbol( funcname )
1412
+ _call = case execType
1413
+ when EXEC_TYPE_NORMAL
1414
+ if locals.flatten.include?( sym )
1415
+ [ sprintf( "trampCall( callProcedure( ", sym ), "))" ] # local function
1416
+ else
1417
+ [ sprintf( "trampCall( self.%s_METHOD( ", sym ), "))" ] # toplevel function
1418
+ end
1419
+ when EXEC_TYPE_TAILCALL
1420
+ [ "delayCall(", ")" ]
1421
+ end
1422
+ [sprintf( "%s '%s',", _call[0], origname ),
1423
+ [lispSymbolReference( sym, locals, nil, sourcefile, lineno )] + [","],
1424
+ arr,
1425
+ sprintf( " %s", _call[1] ) + arr.map { |n| ")" }.join]
1426
+ end
1427
+ end
1428
+ end
1401
1429
  end
1402
- end
1403
-
1404
- def makeLet( args, locals )
1405
- _name = "___lambda"
1406
- argvals = []
1407
- rest = args.cdr
1408
- if args.car.is_a? Nil
1409
- # nothing to do
1410
- lambda_head = sprintf( "%s = lambda { || ", _name )
1411
- else
1412
- argsyms = args.car.map { |x|
1413
- toRubySymbol( x.car.car.cdr.car.to_s )
1414
- }
1415
- argvals = args.car.map.with_index { |x,i|
1416
- translate( x.car.cdr.car, locals )
1417
- }
1418
- lambda_head = sprintf( "%s = lambda { |%s| ", _name, argsyms.join( "," ))
1419
- end
1420
- ["begin",
1421
- [lambda_head,
1422
- rest.map { |e| translate( e.car, locals.clone + [argsyms] ) },
1423
- sprintf( "} ; %s.call(", _name ),
1424
- separateWith( argvals, "," ),
1425
- sprintf( " )")],
1426
- "end"]
1427
- end
1428
-
1429
- def makeLetrec( args, locals )
1430
- _name = "___lambda"
1431
- argvals = []
1432
- argsyms = []
1433
- rest = args.cdr
1434
- if args.car.is_a? Nil
1435
- # nothing to do
1436
- lambda_head = sprintf( "%s = lambda { || ", _name )
1437
- else
1438
- argsyms = args.car.map { |x|
1439
- toRubySymbol( x.car.car.cdr.car.to_s )
1440
- }
1441
- argvals = args.car.map { |x|
1442
- translate( x.car.cdr.car, locals.clone + [argsyms] )
1430
+
1431
+ def makeBegin( args, locals )
1432
+ ar = args.map { |e|
1433
+ translate( e.car, locals )
1443
1434
  }
1444
- lambda_head = sprintf( "%s = lambda { |%s| ", _name, argsyms.join( "," ))
1445
- end
1446
- ["begin",
1447
- [lambda_head,
1448
- argsyms.zip( argvals ).map { |x| [ x[0], " = ", x[1] ] },
1449
- rest.map { |e| translate( e.car, locals.clone + [argsyms] ) },
1450
- sprintf( "} ; %s.call(", _name ),
1451
- argsyms.map { |x| "nil" }.join( "," ),
1452
- sprintf( " )")],
1453
- "end"]
1454
- end
1455
-
1456
- def apply( car, cdr, sourcefile, lineno, locals, lambda_flag = false )
1457
- cdr.each { |x|
1458
- if Cell == x.class
1459
- x.car = translate( x.car, locals )
1435
+ ["begin", ar, "end"]
1436
+ end
1437
+
1438
+ # returns [ argsyms[], string ]
1439
+ def toRubyParameter( argform )
1440
+ argsyms = []
1441
+ locals = []
1442
+ rest = false
1443
+ if Symbol == argform.class
1444
+ rest = argform
1445
+ else
1446
+ argsyms = argform.map { |x| toRubySymbol( x.car ) }
1447
+ locals = argsyms.clone
1448
+ if argform.lastAtom
1449
+ rest = argform.getLastAtom
1450
+ end
1460
1451
  end
1461
- }
1462
- execFunc( car, cdr, sourcefile, lineno, locals, lambda_flag )
1463
- end
1464
-
1465
- def genQuote( sexp, str = "" )
1466
- origStr = str
1467
- case sexp
1468
- when Cell
1469
- if sexp.isNull
1470
- str += "Cell.new()"
1452
+ if rest
1453
+ rest = toRubySymbol( rest )
1454
+ locals << rest
1455
+ argsyms << "*__rest__"
1456
+ [ locals, sprintf( "|%s| %s = __rest__[0] ; ", argsyms.join( "," ), rest ) ]
1471
1457
  else
1472
- arr = sexp.map { |x| genQuote( x.car ) }
1473
- str += "Cell.new("
1474
- str += arr.join( ",Cell.new(" )
1475
- lastAtom = sexp.lastAtom
1476
- str += "," + genQuote( lastAtom ) if lastAtom
1477
- str += arr.map{ |e| ")" }.join
1478
- end
1479
- when Array
1480
- arr = sexp.map { |x| genQuote( x ) }
1481
- str += "[" + arr.join(",") + "]"
1482
- when Symbol
1483
- str += sprintf( ":\"%s\"", sexp.to_s )
1484
- when String, LispString
1485
- str += sprintf( "\"%s\"", LispString.escape( sexp ))
1486
- when LispKeyword
1487
- str += sprintf( "LispKeyword.new( \"%s\" )", sexp.key.to_s )
1488
- when TrueClass, FalseClass, NilClass # reserved symbols
1489
- str += toRubyValue( sexp )
1490
- else
1491
- str += sprintf( "%s", sexp )
1458
+ [ locals, sprintf( "|%s|", argsyms.join( "," )) ]
1459
+ end
1492
1460
  end
1493
- str
1494
- end
1495
-
1496
- def lispSymbolReference( sym, locals, translatedArr, sourcefile, lineno )
1497
- variable_sym = sym.split( /[.]/ )[0]
1498
- global_cap = if variable_sym.match( /^[A-Z]/ )
1499
- nil
1500
- else
1501
- locals.flatten.include?( variable_sym ) ? nil : "@"
1502
- end
1503
- expression = if translatedArr
1504
- [sprintf( "%s%s(", global_cap, sym ),
1505
- separateWith( translatedArr, "," ),
1506
- sprintf( " )" )]
1507
- else
1508
- [sprintf( "%s%s", global_cap, sym )]
1509
- end
1510
- if global_cap
1511
- ["begin",
1512
- [sprintf( "if @global_lisp_binding.has_key?('%s') then", variable_sym ),
1513
- expression,
1514
- sprintf( 'else raise NameError.new( "Error: undefined variable %s", "%s" ) end', variable_sym, variable_sym ),
1515
- sprintf( 'rescue => __e ; __e.set_backtrace( ["%s:%d"] + __e.backtrace ) ; raise __e', sourcefile, lineno )],
1516
- "end"]
1517
- else
1461
+
1462
+ def makeClosure( sym, args, locals )
1463
+ first = args.car
1464
+ if args.car.car == :quote
1465
+ first = args.car.cdr.car
1466
+ end
1467
+ rest = args.cdr
1468
+ ( _locals, argStr ) = toRubyParameter( first )
1469
+ str = case sym
1470
+ when :macro
1471
+ sprintf( "LispMacro.new { %s ", argStr )
1472
+ when :lambda
1473
+ sprintf( "Proc.new { %s ", argStr )
1474
+ else
1475
+ raise "Error: makeClosure: unknown symbol type " + sym
1476
+ end
1477
+ ar = rest.map { |e|
1478
+ translate( e.car, locals.clone + [_locals])
1479
+ }
1480
+ [ str, ar, "}" ]
1481
+ end
1482
+
1483
+ def makeIf( args, locals )
1484
+ _condition = translate( args.car, locals )
1485
+ _then = translate( args.cdr.car, locals )
1486
+ _else = nil
1487
+ if 2 < args.length
1488
+ _else = translate( args.cdr.cdr.car, locals )
1489
+ end
1490
+ if _else
1491
+ ["if ( ", _condition, " ) then",
1492
+ [ _then ],
1493
+ "else",
1494
+ [ _else ],
1495
+ "end"]
1496
+ else
1497
+ ["if ( ", _condition, " ) then",
1498
+ [ _then ],
1499
+ "end"]
1500
+ end
1501
+ end
1502
+
1503
+ def makeLet( args, locals )
1504
+ _name = "___lambda"
1505
+ argvals = []
1506
+ rest = args.cdr
1507
+ if args.car.is_a? Nil
1508
+ # nothing to do
1509
+ lambda_head = sprintf( "%s = lambda { || ", _name )
1510
+ else
1511
+ argsyms = args.car.map { |x|
1512
+ toRubySymbol( x.car.car.cdr.car.to_s )
1513
+ }
1514
+ argvals = args.car.map.with_index { |x,i|
1515
+ translate( x.car.cdr.car, locals )
1516
+ }
1517
+ lambda_head = sprintf( "%s = lambda { |%s| ", _name, argsyms.join( "," ))
1518
+ end
1518
1519
  ["begin",
1519
- [expression,
1520
- sprintf( 'rescue => __e ; __e.set_backtrace( ["%s:%d"] + __e.backtrace ) ; raise __e', sourcefile, lineno )],
1520
+ [lambda_head,
1521
+ rest.map { |e| translate( e.car, locals.clone + [argsyms] ) },
1522
+ sprintf( "} ; %s.call(", _name ),
1523
+ separateWith( argvals, "," ),
1524
+ sprintf( " )")],
1521
1525
  "end"]
1522
1526
  end
1523
- end
1524
-
1525
- # Lisp->Ruby translater
1526
- # - locals is array of closure's local variable list
1527
- # when S-expression is
1528
- # (let ((a 1)
1529
- # (b 2))
1530
- # (let ((c 3))
1531
- # (print (+ a b c))))
1532
- # => locals must be [["_a" "_b"]["_c"]] value.
1533
- def translate( sexp, locals )
1534
- case sexp
1535
- when Cell
1536
- if :quote == sexp.car
1537
- genQuote( sexp.cdr.car )
1538
- elsif sexp.isDotted
1539
- raise NameError, "Error: can't eval dotted pair."
1540
- elsif sexp.isNull
1541
- [ "Cell.new()" ]
1542
- elsif Cell == sexp.car.class
1543
- self.apply( translate( sexp.car, locals ), sexp.cdr, sexp.car.car.sourcefile, sexp.car.car.lineno, locals, true )
1544
- elsif :begin == sexp.car
1545
- self.makeBegin( sexp.cdr, locals )
1546
- elsif :lambda == sexp.car
1547
- self.makeClosure( :lambda, sexp.cdr, locals )
1548
- elsif :macro == sexp.car
1549
- self.makeClosure( :macro, sexp.cdr, locals )
1550
- elsif :if == sexp.car
1551
- self.makeIf( sexp.cdr, locals )
1552
- elsif :let == sexp.car
1553
- self.makeLet( sexp.cdr, locals )
1554
- elsif :letrec == sexp.car
1555
- self.makeLetrec( sexp.cdr, locals )
1527
+
1528
+ def makeLetrec( args, locals )
1529
+ _name = "___lambda"
1530
+ argvals = []
1531
+ argsyms = []
1532
+ rest = args.cdr
1533
+ if args.car.is_a? Nil
1534
+ # nothing to do
1535
+ lambda_head = sprintf( "%s = lambda { || ", _name )
1556
1536
  else
1557
- self.apply( sexp.car, sexp.cdr, sexp.car.sourcefile, sexp.car.lineno, locals )
1537
+ argsyms = args.car.map { |x|
1538
+ toRubySymbol( x.car.car.cdr.car.to_s )
1539
+ }
1540
+ argvals = args.car.map { |x|
1541
+ translate( x.car.cdr.car, locals.clone + [argsyms] )
1542
+ }
1543
+ lambda_head = sprintf( "%s = lambda { |%s| ", _name, argsyms.join( "," ))
1558
1544
  end
1559
- when Array
1560
- raise RuntimeError, "Error: can't eval unquoted vector."
1561
- else
1545
+ ["begin",
1546
+ [lambda_head,
1547
+ argsyms.zip( argvals ).map { |x| [ x[0], " = ", x[1] ] },
1548
+ rest.map { |e| translate( e.car, locals.clone + [argsyms] ) },
1549
+ sprintf( "} ; %s.call(", _name ),
1550
+ argsyms.map { |x| "nil" }.join( "," ),
1551
+ sprintf( " )")],
1552
+ "end"]
1553
+ end
1554
+
1555
+ def apply( car, cdr, sourcefile, lineno, locals, execType )
1556
+ cdr.each { |x|
1557
+ if Cell == x.class
1558
+ x.car = translate( x.car, locals )
1559
+ end
1560
+ }
1561
+ execFunc( car, cdr, sourcefile, lineno, locals, execType )
1562
+ end
1563
+
1564
+ def genQuote( sexp, str = "" )
1565
+ origStr = str
1562
1566
  case sexp
1567
+ when Cell
1568
+ if sexp.isNull
1569
+ str += "Cell.new()"
1570
+ else
1571
+ arr = sexp.map { |x| genQuote( x.car ) }
1572
+ str += "Cell.new("
1573
+ str += arr.join( ",Cell.new(" )
1574
+ str += "," + genQuote( sexp.getLastAtom ) if sexp.lastAtom
1575
+ str += arr.map{ |e| ")" }.join
1576
+ end
1577
+ when Array
1578
+ arr = sexp.map { |x| genQuote( x ) }
1579
+ str += "[" + arr.join(",") + "]"
1563
1580
  when Symbol
1564
- sym = sexp.to_s
1565
- sym = toRubySymbol( sym )
1566
- lispSymbolReference( sym, locals, nil, sexp.sourcefile, sexp.lineno )
1567
- when Fixnum
1568
- sexp.to_s
1581
+ str += sprintf( ":\"%s\"", sexp.to_s )
1569
1582
  when String, LispString
1570
- sprintf( "\"%s\"", LispString.escape( sexp ))
1583
+ str += sprintf( "\"%s\"", LispString.escape( sexp ))
1571
1584
  when LispKeyword
1572
- sprintf( "LispKeyword.new( \"%s\" )", sexp.key )
1573
- when Nil
1574
- "Nil.new"
1585
+ str += sprintf( "LispKeyword.new( \"%s\" )", sexp.key.to_s )
1575
1586
  when TrueClass, FalseClass, NilClass # reserved symbols
1576
- toRubyValue( sexp )
1587
+ str += toRubyValue( sexp )
1577
1588
  else
1578
- sexp.to_s
1589
+ str += sprintf( "%s", sexp )
1590
+ end
1591
+ str
1592
+ end
1593
+
1594
+ def trampCallCap( sym )
1595
+ if isRubyInterface( sym )
1596
+ arr = sym.split( /[.]/ )
1597
+ arr[0] = sprintf( "trampCall(%s)", arr[0] )
1598
+ arr.join( "." )
1599
+ else
1600
+ "trampCall(" + sym + ")"
1579
1601
  end
1580
1602
  end
1581
- end
1582
-
1583
- # insert quote in let argument list
1584
- # ((sym1 list1)
1585
- # (sym2 list2)
1586
- # (sym3 list3))
1587
- # will be transformed
1588
- # (((quote sym1) list1)
1589
- # ((quote sym2) list2)
1590
- # ((quote sym3) list3))
1591
- def letArgumentList( sexp )
1592
- sexp.each { |arg|
1593
- arg.car.car = Cell.new( :quote, Cell.new( arg.car.car ))
1594
- arg.car.cdr = quoting( arg.car.cdr )
1595
- }
1596
- sexp
1597
- end
1598
1603
 
1599
- def quoting( sexp )
1600
- case sexp
1601
- when Cell
1602
- if :quote == sexp.car or :quasiquote == sexp.car
1603
- sexp
1604
- elsif :define == sexp.car or :set! == sexp.car or :lambda == sexp.car or :macro == sexp.car
1605
- sexp.cdr.car = Cell.new( :quote, Cell.new( sexp.cdr.car ))
1606
- sexp.cdr.cdr = quoting( sexp.cdr.cdr )
1607
- sexp
1608
- elsif :let == sexp.car
1609
- if _null_QUMARK( sexp.cdr )
1610
- # do nothing
1611
- p "kiyoka1"
1604
+ def lispSymbolReference( sym, locals, translatedArr, sourcefile, lineno )
1605
+ variable_sym = sym.split( /[.]/ )[0]
1606
+ global_cap = if variable_sym.match( /^[A-Z]/ )
1607
+ nil
1608
+ else
1609
+ locals.flatten.include?( variable_sym ) ? nil : "@"
1610
+ end
1611
+ expression = if translatedArr
1612
+ [trampCallCap( sprintf( "%s%s(", global_cap, sym )),
1613
+ separateWith( translatedArr, "," ),
1614
+ sprintf( " )" )]
1615
+ else
1616
+ [trampCallCap( sprintf( "%s%s", global_cap, sym ))]
1617
+ end
1618
+ if global_cap
1619
+ ["begin",
1620
+ [sprintf( "if @global_lisp_binding.has_key?('%s') then", variable_sym ),
1621
+ expression,
1622
+ sprintf( 'else raise NameError.new( "Error: undefined variable %s", "%s" ) end', variable_sym, variable_sym ),
1623
+ sprintf( 'rescue => __e ; __e.set_backtrace( ["%s:%d"] + __e.backtrace ) ; raise __e', sourcefile, lineno )],
1624
+ "end"]
1625
+ else
1626
+ ["begin",
1627
+ [expression,
1628
+ sprintf( 'rescue => __e ; __e.set_backtrace( ["%s:%d"] + __e.backtrace ) ; raise __e', sourcefile, lineno )],
1629
+ "end"]
1630
+ end
1631
+ end
1632
+
1633
+ # Lisp->Ruby translater
1634
+ # - locals is array of closure's local variable list
1635
+ # when S-expression is
1636
+ # (let ((a 1)
1637
+ # (b 2))
1638
+ # (let ((c 3))
1639
+ # (print (+ a b c))))
1640
+ # => locals must be [["_a" "_b"]["_c"]] value.
1641
+ def translate( sexp, locals )
1642
+ case sexp
1643
+ when Cell
1644
+ if :quote == sexp.car
1645
+ genQuote( sexp.cdr.car )
1646
+ elsif sexp.isDotted
1647
+ raise NameError, "Error: can't eval dotted pair."
1648
+ elsif sexp.isNull
1649
+ [ "Cell.new()" ]
1650
+ elsif Cell == sexp.car.class
1651
+ self.apply( translate( sexp.car, locals ), sexp.cdr, sexp.car.car.sourcefile, sexp.car.car.lineno, locals, EXEC_TYPE_ANONYMOUS )
1652
+ elsif :begin == sexp.car
1653
+ self.makeBegin( sexp.cdr, locals )
1654
+ elsif :lambda == sexp.car
1655
+ self.makeClosure( :lambda, sexp.cdr, locals )
1656
+ elsif :macro == sexp.car
1657
+ self.makeClosure( :macro, sexp.cdr, locals )
1658
+ elsif :if == sexp.car
1659
+ self.makeIf( sexp.cdr, locals )
1660
+ elsif :let == sexp.car
1661
+ self.makeLet( sexp.cdr, locals )
1662
+ elsif :letrec == sexp.car
1663
+ self.makeLetrec( sexp.cdr, locals )
1664
+ elsif :"%tailcall" == sexp.car
1665
+ if sexp.cdr.car.is_a? Cell
1666
+ sexp = sexp.cdr.car
1667
+ self.apply( sexp.car, sexp.cdr, sexp.car.sourcefile, sexp.car.lineno, locals, EXEC_TYPE_TAILCALL )
1668
+ else
1669
+ raise RuntimeError, "Error: special form tailcall expects function call expression."
1670
+ end
1671
+ else
1672
+ self.apply( sexp.car, sexp.cdr, sexp.car.sourcefile, sexp.car.lineno, locals, EXEC_TYPE_NORMAL )
1673
+ end
1674
+ when Array
1675
+ raise RuntimeError, "Error: can't eval unquoted vector."
1676
+ else
1677
+ case sexp
1678
+ when Symbol
1679
+ sym = sexp.to_s
1680
+ sym = toRubySymbol( sym )
1681
+ lispSymbolReference( sym, locals, nil, sexp.sourcefile, sexp.lineno )
1682
+ when Fixnum
1683
+ sexp.to_s
1684
+ when String, LispString
1685
+ sprintf( "\"%s\"", LispString.escape( sexp ))
1686
+ when LispKeyword
1687
+ sprintf( "LispKeyword.new( \"%s\" )", sexp.key )
1688
+ when Nil
1689
+ "Nil.new"
1690
+ when TrueClass, FalseClass, NilClass # reserved symbols
1691
+ toRubyValue( sexp )
1612
1692
  else
1693
+ sexp.to_s
1694
+ end
1695
+ end
1696
+ end
1697
+
1698
+ # insert quote in let argument list
1699
+ # ((sym1 list1)
1700
+ # (sym2 list2)
1701
+ # (sym3 list3))
1702
+ # will be transformed
1703
+ # (((quote sym1) list1)
1704
+ # ((quote sym2) list2)
1705
+ # ((quote sym3) list3))
1706
+ def letArgumentList( sexp )
1707
+ sexp.each { |arg|
1708
+ arg.car.car = Cell.new( :quote, Cell.new( arg.car.car ))
1709
+ arg.car.cdr = quotingPhase( arg.car.cdr )
1710
+ }
1711
+ sexp
1712
+ end
1713
+
1714
+ def quotingPhase( sexp )
1715
+ case sexp
1716
+ when Cell
1717
+ if :quote == sexp.car or :quasiquote == sexp.car
1718
+ sexp
1719
+ elsif :define == sexp.car or :set! == sexp.car or :lambda == sexp.car or :macro == sexp.car
1720
+ sexp.cdr.car = Cell.new( :quote, Cell.new( sexp.cdr.car ))
1721
+ sexp.cdr.cdr = quotingPhase( sexp.cdr.cdr )
1722
+ sexp
1723
+ elsif :let == sexp.car
1724
+ if _null_QUMARK( sexp.cdr )
1725
+ # do nothing
1726
+ else
1727
+ case sexp.cdr.car
1728
+ when Cell # let
1729
+ sexp.cdr = Cell.new( letArgumentList( sexp.cdr.car ),
1730
+ quotingPhase( sexp.cdr.cdr ))
1731
+ when Symbol # named let
1732
+ sexp.cdr.car = Cell.new( :quote, Cell.new( sexp.cdr.car ))
1733
+ sexp.cdr.cdr = Cell.new( letArgumentList( sexp.cdr.cdr.car ),
1734
+ quotingPhase( sexp.cdr.cdr.cdr ))
1735
+ end
1736
+ end
1737
+ sexp
1738
+ elsif :letrec == sexp.car
1613
1739
  case sexp.cdr.car
1614
- when Cell # let
1740
+ when Cell # letrec
1615
1741
  sexp.cdr = Cell.new( letArgumentList( sexp.cdr.car ),
1616
- quoting( sexp.cdr.cdr ))
1617
- when Symbol # named let
1618
- sexp.cdr.car = Cell.new( :quote, Cell.new( sexp.cdr.car ))
1619
- sexp.cdr.cdr = Cell.new( letArgumentList( sexp.cdr.cdr.car ),
1620
- quoting( sexp.cdr.cdr.cdr ))
1742
+ quotingPhase( sexp.cdr.cdr ))
1743
+ when Symbol # named letrec is illegal
1744
+ raise RuntimeError, "Error: named letrec is not a illegal form"
1621
1745
  end
1746
+ sexp
1747
+ else
1748
+ Cell.new( quotingPhase( sexp.car ), quotingPhase( sexp.cdr ))
1622
1749
  end
1750
+ else
1623
1751
  sexp
1624
- elsif :letrec == sexp.car
1625
- case sexp.cdr.car
1626
- when Cell # letrec
1627
- sexp.cdr = Cell.new( letArgumentList( sexp.cdr.car ),
1628
- quoting( sexp.cdr.cdr ))
1629
- when Symbol # named letrec is illegal
1630
- raise RuntimeError, "Error: named letrec is not a illegal form"
1752
+ end
1753
+ end
1754
+
1755
+ def macroexpandInit( initVal )
1756
+ @macroExpandCount = initVal
1757
+ end
1758
+
1759
+ def macroexpandEngine( sexp )
1760
+ case sexp
1761
+ when Cell
1762
+ if :quote == sexp.car
1763
+ sexp
1764
+ else
1765
+ sym = sexp.car.to_s
1766
+ sym = toRubySymbol( sym )
1767
+ newSexp = sexp
1768
+ if isRubyInterface( sym )
1769
+ # do nothing
1770
+ sexp
1771
+ elsif sexp.car.class == Symbol and eval( sprintf( "(defined? @%s and LispMacro == @%s.class)", sym,sym ), @binding )
1772
+ eval( sprintf( "@__macro = @%s", sym ), @binding )
1773
+ newSexp = trampCall( callProcedure( sym, @__macro, sexp.cdr ))
1774
+ end
1775
+ if _equal_QUMARK( newSexp, sexp )
1776
+ sexp.map { |x|
1777
+ if x.car.is_a? Cell
1778
+ if 0 <= @macroExpandCount
1779
+ macroexpandEngine( x.car )
1780
+ else
1781
+ x.car
1782
+ end
1783
+ else
1784
+ x.car
1785
+ end
1786
+ }.to_list( sexp.lastAtom, sexp.getLastAtom )
1787
+ else
1788
+ @macroExpandCount -= 1
1789
+ newSexp
1790
+ end
1631
1791
  end
1632
- sexp
1633
1792
  else
1634
- Cell.new( quoting( sexp.car ), quoting( sexp.cdr ))
1793
+ sexp
1635
1794
  end
1636
- else
1637
- sexp
1638
1795
  end
1639
- end
1640
-
1641
- def macroexpand_1_check( sexp )
1642
- if not @expand_flag
1796
+
1797
+ def macroExpandPhase( sexp )
1798
+ converge = true
1799
+ begin
1800
+ macroexpandInit( 100000 )
1801
+ newSexp = macroexpandEngine( sexp )
1802
+ converge = _equal_QUMARK( newSexp, sexp )
1803
+ sexp = newSexp
1804
+ end until converge
1643
1805
  sexp
1644
- else
1645
- newSexp = macroexpand_1_sub( sexp )
1646
- if not _equal_QUMARK( newSexp, sexp )
1647
- @expand_flag = false
1648
- end
1649
- newSexp
1650
1806
  end
1651
- end
1652
-
1653
- def macroexpand_1_sub( sexp )
1654
- case sexp
1655
- when Cell
1656
- if :quote == sexp.car
1657
- sexp
1658
- else
1659
- sym = sexp.car.to_s
1660
- sym = toRubySymbol( sym )
1661
- newSexp = sexp
1662
- if isRubyInterface( sym )
1663
- # do nothing
1664
- elsif sexp.car.class == Symbol and eval( sprintf( "(defined? @%s and LispMacro == @%s.class)", sym,sym ), @binding )
1665
- eval( sprintf( "@__macro = @%s", sym ), @binding )
1666
- newSexp = callProcedure( sym, @__macro, sexp.cdr )
1667
- end
1668
- if _equal_QUMARK( newSexp, sexp )
1669
- sexp.map { |x|
1670
- if x.car.is_a? Cell
1671
- macroexpand_1_check( x.car )
1672
- else
1673
- x.car
1674
- end
1675
- }.to_list( sexp.lastAtom )
1807
+
1808
+ def ppRubyExp( level, exp )
1809
+ indent = @indent * level
1810
+ exp.map { |x|
1811
+ if Array == x.class
1812
+ ppRubyExp( level+1, x )
1676
1813
  else
1677
- newSexp
1814
+ str = sprintf( "%s", x )
1815
+ if str.match( /^[,]/ ) or str.match( /^ = / )
1816
+ sprintf( "%s%s", indent, str )
1817
+ else
1818
+ sprintf( "\n%s%s", indent, str )
1819
+ end
1820
+ end
1821
+ }
1822
+ end
1823
+
1824
+ def lispEval( sexp, sourcefile, lineno )
1825
+ @lastSourcefile = sourcefile
1826
+ @lastLineno = lineno
1827
+ sexp = macroExpandPhase( sexp )
1828
+ sexp = quotingPhase( sexp )
1829
+ if @debug
1830
+ printf( "\n quoting=<<< %s >>>\n", (Printer.new())._print(sexp))
1831
+ end
1832
+ # compiling phase written in Nendo
1833
+ sym = toRubySymbol( "%compile-phase" )
1834
+ if ( eval( sprintf( "(defined? @%s and Proc == @%s.class)", sym,sym ), @binding ))
1835
+ eval( sprintf( "@___tmp = @%s", sym ), @binding )
1836
+ sexp = trampCall( callProcedure( sym, @___tmp, Cell.new( sexp )))
1837
+ if @debug
1838
+ printf( "\n compiled=<<< %s >>>\n", (Printer.new())._print(sexp))
1678
1839
  end
1679
1840
  end
1680
- else
1681
- sexp
1841
+
1842
+ arr = [ "trampCall( ", translate( sexp, [] ), " )" ]
1843
+ rubyExp = ppRubyExp( 0, arr ).flatten.join
1844
+ if not @compiled_code.has_key?( sourcefile )
1845
+ @compiled_code[ sourcefile ] = Array.new
1846
+ end
1847
+ @compiled_code[ sourcefile ] << rubyExp
1848
+ printf( " rubyExp=<<<\n%s\n>>>\n", rubyExp ) if @debug
1849
+ eval( rubyExp, @binding, @lastSourcefile, @lastLineno )
1850
+ end
1851
+
1852
+ def _load( filename )
1853
+ printer = Printer.new( @debug )
1854
+ open( filename, "r:utf-8" ) {|f|
1855
+ reader = Reader.new( f, filename, false )
1856
+ while true
1857
+ lineno = reader.lineno
1858
+ s = reader._read
1859
+ if s[1] # EOF?
1860
+ break
1861
+ elsif Nil != s[0].class
1862
+ printf( "\n readExp=<<< %s >>>\n", printer._print(s[0]) ) if @debug
1863
+ self.lispEval( s[0], reader.sourcefile, lineno )
1864
+ end
1865
+ end
1866
+ }
1867
+ forward_gensym_counter()
1868
+ end
1869
+
1870
+ def _load_MIMARKcompiled_MIMARKcode_MIMARKfrom_MIMARKstring( rubyExp )
1871
+ eval( rubyExp, @binding )
1872
+ forward_gensym_counter()
1873
+ end
1874
+
1875
+ def _load_MIMARKcompiled_MIMARKcode( filename )
1876
+ open( filename, "r:utf-8" ) { |f|
1877
+ eval( f.read, @binding )
1878
+ }
1879
+ forward_gensym_counter()
1682
1880
  end
1683
- end
1684
1881
 
1685
- def macroexpand_1( sexp )
1686
- @expand_flag = true
1687
- macroexpand_1_check( sexp )
1882
+ def _clean_MIMARKcompiled_MIMARKcode
1883
+ @compiled_code = Hash.new
1884
+ end
1885
+
1886
+ def _get_MIMARKcompiled_MIMARKcode
1887
+ @compiled_code
1888
+ ret = Hash.new
1889
+ @compiled_code.each_key { |key|
1890
+ ret[key] = @compiled_code[key].to_list
1891
+ ret[key]
1892
+ }
1893
+ ret.to_list
1894
+ end
1895
+
1896
+ def _eval( sexp )
1897
+ self.lispEval( sexp, "dynamic S-expression ( no source )", 1 )
1898
+ end
1899
+
1900
+ def _enable_MIMARKidebug()
1901
+ @debug = true
1902
+ end
1903
+ def _disable_MIMARKidebug()
1904
+ @debug = false
1905
+ end
1906
+ def _set_MIMARKoptimize_MIMARKlevel(level)
1907
+ self.setOptimizeLevel( level )
1908
+ end
1909
+ def _get_MIMARKoptimize_MIMARKlevel()
1910
+ self.getOptimizeLevel
1911
+ end
1688
1912
  end
1689
-
1690
- def macroexpand( sexp )
1691
- case sexp
1692
- when Cell
1693
- if :quote == sexp.car
1694
- sexp
1695
- else
1696
- sym = sexp.car.to_s
1697
- sym = toRubySymbol( sym )
1698
- newSexp = sexp
1699
- if isRubyInterface( sym )
1700
- # do nothing
1701
- elsif sexp.car.class == Symbol and eval( sprintf( "(defined? @%s and LispMacro == @%s.class)", sym,sym ), @binding )
1702
- eval( sprintf( "@__macro = @%s", sym ), @binding )
1703
- newSexp = callProcedure( sym, @__macro, sexp.cdr )
1913
+
1914
+ class Printer
1915
+ def initialize( debug = false )
1916
+ @debug = debug
1917
+ end
1918
+
1919
+ def __write( sexp, readable )
1920
+ getQuoteKeyword = lambda { |x|
1921
+ case x
1922
+ when :quote
1923
+ "'"
1924
+ when :quasiquote
1925
+ "`"
1926
+ when :unquote
1927
+ ","
1928
+ when :"unquote-splicing"
1929
+ ",@"
1930
+ when :"dot-operator"
1931
+ "."
1932
+ else
1933
+ false
1704
1934
  end
1705
- if _equal_QUMARK( newSexp, sexp )
1706
- sexp.map { |x|
1707
- if x.car.is_a? Cell
1708
- macroexpand( x.car )
1709
- else
1710
- x.car
1711
- end
1712
- }.to_list( sexp.lastAtom )
1935
+ }
1936
+ case sexp
1937
+ when Cell
1938
+ arr = sexp.map { |x| __write( x.car, readable ) }
1939
+ lastAtom = sexp.lastAtom
1940
+ lastAtomStr = lastAtom ? __write( sexp.getLastAtom, readable ) : ""
1941
+ keyword = getQuoteKeyword.call( sexp.car )
1942
+ if keyword
1943
+ keyword + arr[1..-1].join( " " ) + (lastAtom ? " . " + lastAtomStr : "")
1944
+ else
1945
+ "(" + arr.join( " " ) + (lastAtom ? " . " + lastAtomStr : "") + ")"
1946
+ end
1947
+ when Array # is a vector in the Nendo world.
1948
+ arr = sexp.map { |x| __write( x, readable ) }
1949
+ "#(" + arr.join( " " ) + ")"
1950
+ when true
1951
+ "#t"
1952
+ when false
1953
+ "#f"
1954
+ when Symbol
1955
+ keyword = getQuoteKeyword.call( sexp )
1956
+ if keyword
1957
+ keyword
1713
1958
  else
1714
- newSexp
1959
+ sprintf( "%s", sexp.to_s )
1715
1960
  end
1961
+ when String, LispString
1962
+ if readable
1963
+ sprintf( "\"%s\"", LispString.escape( sexp.to_s ))
1964
+ else
1965
+ sexp.to_s
1966
+ end
1967
+ when LispKeyword
1968
+ ":" + sexp.key.to_s
1969
+ when Nil
1970
+ "()"
1971
+ when nil
1972
+ "nil"
1973
+ else
1974
+ sprintf( "%s", sexp )
1716
1975
  end
1717
- else
1718
- sexp
1719
1976
  end
1720
- end
1721
-
1722
- def lispCompile( sexp )
1723
- converge = true
1724
- begin
1725
- newSexp = macroexpand( sexp )
1726
- converge = _equal_QUMARK( newSexp, sexp )
1727
- sexp = newSexp
1728
- end until converge
1729
- sexp
1977
+
1978
+ def _print( sexp )
1979
+ self.__write( sexp, false )
1980
+ end
1981
+ def _write( sexp )
1982
+ self.__write( sexp, true )
1983
+ end
1730
1984
  end
1731
1985
 
1732
- def ppRubyExp( level, exp )
1733
- indent = @indent * level
1734
- exp.map { |x|
1735
- if Array == x.class
1736
- ppRubyExp( level+1, x )
1737
- else
1738
- str = sprintf( "%s", x )
1739
- if str.match( /^[,]/ ) or str.match( /^ = / )
1740
- sprintf( "%s%s", indent, str )
1741
- else
1742
- sprintf( "\n%s%s", indent, str )
1986
+
1987
+ class Core
1988
+ def initialize( debug_evaluator = false, debug_printer = false )
1989
+ @debug_evaluator = debug_evaluator
1990
+ @evaluator = Evaluator.new( debug_evaluator )
1991
+ @debug_printer = debug_printer
1992
+ end
1993
+
1994
+ def loadInitFile( use_compiled = true )
1995
+ done = false
1996
+ if use_compiled
1997
+ compiled_file = File.dirname(__FILE__) + "/init.nndc"
1998
+ if File.exist?( compiled_file )
1999
+ @evaluator._load_MIMARKcompiled_MIMARKcode( compiled_file )
2000
+ done = true
1743
2001
  end
1744
2002
  end
1745
- }
1746
- end
1747
-
1748
- def lispEval( sexp, sourcefile, lineno )
1749
- @lastSourcefile = sourcefile
1750
- @lastLineno = lineno
1751
- sexp = lispCompile( sexp )
1752
- sexp = quoting( sexp );
1753
- if @debug
1754
- printf( "\n quoting=<<< %s >>>\n", (Printer.new())._print(sexp))
1755
- end
1756
- arr = [ translate( sexp, [] ) ]
1757
- rubyExp = ppRubyExp( 0, arr ).flatten.join
1758
- if not @compiled_code.has_key?( sourcefile )
1759
- @compiled_code[ sourcefile ] = Array.new
1760
- end
1761
- @compiled_code[ sourcefile ] << rubyExp
1762
- printf( " rubyExp=<<<\n%s\n>>>\n", rubyExp ) if @debug
1763
- eval( rubyExp, @binding, @lastSourcefile, @lastLineno )
1764
- end
2003
+ unless done
2004
+ @evaluator._load( File.dirname(__FILE__) + "/init.nnd" )
2005
+ end
2006
+ end
2007
+
2008
+ def load( path )
2009
+ @evaluator._load( path )
2010
+ end
2011
+
2012
+ def load_compiled_code( path )
2013
+ @evaluator._load_MIMARKcompiled_MIMARKcode( path )
2014
+ end
2015
+
2016
+ def load_compiled_code_from_string( rubyExp )
2017
+ @evaluator._load_MIMARKcompiled_MIMARKcode_MIMARKfrom_MIMARKstring( rubyExp )
2018
+ end
2019
+
2020
+ def setArgv( argv )
2021
+ @evaluator.setArgv( argv )
2022
+ end
1765
2023
 
1766
- def _load( filename )
1767
- printer = Printer.new( @debug )
1768
- open( filename, "r:utf-8" ) {|f|
1769
- reader = Reader.new( f, filename, false )
2024
+ def setOptimizeLevel( level )
2025
+ @evaluator.setOptimizeLevel( level )
2026
+ end
2027
+
2028
+ def clean_compiled_code
2029
+ @evaluator._clean_MIMARKcompiled_MIMARKcode()
2030
+ end
2031
+
2032
+ def prompt
2033
+ STDERR.print "nendo> "
2034
+ end
2035
+
2036
+ def repl
2037
+ printer = Printer.new( @debug_printer )
2038
+ reader = Reader.new( STDIN, "(stdin)", false )
2039
+ self.prompt
2040
+ while true
2041
+ begin
2042
+ lineno = reader.lineno
2043
+ s = reader._read
2044
+ if s[1] # EOF?
2045
+ break
2046
+ elsif not s[0].is_a? Nil
2047
+ printf( "\n readExp=<<< %s >>>\n", printer._write(s[0]) ) if @debug_evaluator
2048
+ STDERR.print printer._write( @evaluator.lispEval( s[0], reader.sourcefile, lineno )) + "\n"
2049
+ self.prompt
2050
+ end
2051
+ rescue => e
2052
+ print e.message + "\n"
2053
+ e.backtrace.each { |x| printf( "\tfrom %s\n", x ) }
2054
+ print "\n"
2055
+ self.prompt
2056
+ end
2057
+ end
2058
+ end
2059
+
2060
+ def replStr( str )
2061
+ printer = Printer.new( @debug_printer )
2062
+ sio = StringIO.open( str )
2063
+ reader = Reader.new( sio, "(string)", false )
2064
+ result = nil
1770
2065
  while true
1771
2066
  lineno = reader.lineno
1772
2067
  s = reader._read
1773
2068
  if s[1] # EOF?
1774
2069
  break
1775
- elsif Nil != s[0].class
1776
- printf( "\n readExp=<<< %s >>>\n", printer._print(s[0]) ) if @debug
1777
- self.lispEval( s[0], reader.sourcefile, lineno )
2070
+ elsif not s[0].is_a? Nil
2071
+ printf( "\n readExp=<<< %s >>>\n", printer._write(s[0]) ) if @debug_evaluator
2072
+ result = printer._write( @evaluator.lispEval( s[0], reader.sourcefile, lineno ))
1778
2073
  end
1779
2074
  end
1780
- }
1781
- forward_gensym_counter()
2075
+ result
2076
+ end
1782
2077
  end
2078
+ end
1783
2079
 
1784
- def _load_MIMARKcompiled_MIMARKcode_MIMARKfrom_MIMARKstring( rubyExp )
1785
- eval( rubyExp, @binding )
1786
- forward_gensym_counter()
1787
- end
1788
2080
 
1789
- def _load_MIMARKcompiled_MIMARKcode( filename )
1790
- open( filename, "r:utf-8" ) { |f|
1791
- eval( f.read, @binding )
1792
- }
1793
- forward_gensym_counter()
1794
- end
1795
2081
 
1796
- def _clean_MIMARKcompiled_MIMARKcode
1797
- @compiled_code = Hash.new
1798
- end
1799
-
1800
- def _get_MIMARKcompiled_MIMARKcode
1801
- @compiled_code
1802
- ret = Hash.new
1803
- @compiled_code.each_key { |key|
1804
- ret[key] = @compiled_code[key].to_list
1805
- ret[key]
1806
- }
1807
- ret.to_list
1808
- end
1809
2082
 
1810
- def _eval( sexp )
1811
- self.lispEval( sexp, "dynamic S-expression ( no source )", 1 )
2083
+ class Symbol
2084
+ def setLispToken( token )
2085
+ @token = token
1812
2086
  end
1813
-
1814
- def _enable_MIMARKidebug()
1815
- @debug = true
2087
+ def sourcefile
2088
+ @token ? @token.sourcefile : ""
1816
2089
  end
1817
- def _disable_MIMARKidebug()
1818
- @debug = false
2090
+ def lineno
2091
+ @token ? @token.lineno : 1
1819
2092
  end
1820
2093
  end
1821
2094
 
1822
- class Printer
1823
- def initialize( debug = false )
1824
- @debug = debug
1825
- end
1826
-
1827
- def __write( sexp, readable )
1828
- getQuoteKeyword = lambda { |x|
1829
- case x
1830
- when :quote
1831
- "'"
1832
- when :quasiquote
1833
- "`"
1834
- when :unquote
1835
- ","
1836
- when :"unquote-splicing"
1837
- ",@"
1838
- when :"dot-operator"
1839
- "."
1840
- else
1841
- false
1842
- end
1843
- }
1844
- case sexp
1845
- when Cell
1846
- arr = sexp.map { |x| __write( x.car, readable ) }
1847
- lastAtom = sexp.lastAtom
1848
- lastAtom = __write( lastAtom, readable ) if lastAtom
1849
- keyword = getQuoteKeyword.call( sexp.car )
1850
- if keyword
1851
- keyword + arr[1..-1].join( " " ) + (lastAtom ? " . " + lastAtom : "")
1852
- else
1853
- "(" + arr.join( " " ) + (lastAtom ? " . " + lastAtom : "") + ")"
1854
- end
1855
- when Array # is a vector in the Nendo world.
1856
- arr = sexp.map { |x| __write( x, readable ) }
1857
- "#(" + arr.join( " " ) + ")"
1858
- when true
1859
- "#t"
1860
- when false
1861
- "#f"
1862
- when Symbol
1863
- keyword = getQuoteKeyword.call( sexp )
1864
- if keyword
1865
- keyword
1866
- else
1867
- sprintf( "%s", sexp.to_s )
1868
- end
1869
- when String, LispString
1870
- if readable
1871
- sprintf( "\"%s\"", LispString.escape( sexp.to_s ))
1872
- else
1873
- sexp.to_s
1874
- end
1875
- when LispKeyword
1876
- ":" + sexp.key.to_s
1877
- when Nil
1878
- "()"
1879
- when nil
1880
- "nil"
2095
+ class Array
2096
+ def to_list( lastAtom = false, value = Nendo::Nil.new )
2097
+ if 0 == self.length
2098
+ Nendo::Nil.new
1881
2099
  else
1882
- sprintf( "%s", sexp )
2100
+ cells = self.map { |x|
2101
+ Nendo::Cell.new( x )
2102
+ }
2103
+ ptr = cells.pop
2104
+ ptr.cdr = value if lastAtom
2105
+ cells.reverse.each { |x|
2106
+ x.cdr = ptr
2107
+ ptr = x
2108
+ }
2109
+ return ptr
1883
2110
  end
1884
2111
  end
1885
-
1886
- def _print( sexp )
1887
- self.__write( sexp, false )
1888
- end
1889
- def _write( sexp )
1890
- self.__write( sexp, true )
1891
- end
1892
2112
  end
1893
2113
 
1894
-
1895
- class Nendo
1896
- def initialize( debug_evaluator = false, debug_printer = false )
1897
- @debug_evaluator = debug_evaluator
1898
- @evaluator = Evaluator.new( debug_evaluator )
1899
- @debug_printer = debug_printer
1900
- end
1901
-
1902
- def loadInitFile( use_compiled = true )
1903
- done = false
1904
- if use_compiled
1905
- compiled_file = File.dirname(__FILE__) + "/init.nndc"
1906
- if File.exist?( compiled_file )
1907
- @evaluator._load_MIMARKcompiled_MIMARKcode( compiled_file )
1908
- done = true
1909
- end
1910
- end
1911
- unless done
1912
- @evaluator._load( File.dirname(__FILE__) + "/init.nnd" )
1913
- end
1914
- end
1915
-
1916
- def load( path )
1917
- @evaluator._load( path )
1918
- end
1919
-
1920
- def load_compiled_code( path )
1921
- @evaluator._load_MIMARKcompiled_MIMARKcode( path )
1922
- end
1923
-
1924
- def load_compiled_code_from_string( rubyExp )
1925
- @evaluator._load_MIMARKcompiled_MIMARKcode_MIMARKfrom_MIMARKstring( rubyExp )
1926
- end
1927
-
1928
- def setArgv( argv )
1929
- @evaluator.setArgv( argv )
1930
- end
1931
-
1932
- def clean_compiled_code
1933
- @evaluator._clean_MIMARKcompiled_MIMARKcode()
1934
- end
1935
-
1936
- def repl
1937
- printer = Printer.new( @debug_printer )
1938
- reader = nil
1939
- print "nendo> "
1940
- begin
1941
- begin
1942
- reader = Reader.new( STDIN, "(stdin)", false )
1943
- rescue => e
1944
- print e.message + "\n"
1945
- e.backtrace.each { |x| printf( "\tfrom %s\n", x ) }
1946
- reader = nil
1947
- print "\n" + "nendo> "
1948
- end
1949
- end until reader
1950
- while true
1951
- lineno = reader.lineno
1952
- begin
1953
- s = reader._read
1954
- if s[1] # EOF?
1955
- break
1956
- elsif Nil != s[0].class
1957
- printf( "\n readExp=<<< %s >>>\n", printer._write(s[0]) ) if @debug_evaluator
1958
- print printer._write( @evaluator.lispEval( s[0], reader.sourcefile, lineno ))
1959
- print "\n" + "nendo> "
1960
- end
1961
- rescue => e
1962
- print e.message + "\n"
1963
- e.backtrace.each { |x| printf( "\tfrom %s\n", x ) }
1964
- print "\n" + "nendo> "
1965
- end
1966
- end
1967
- end
1968
-
1969
- def replStr( str )
1970
- printer = Printer.new( @debug_printer )
1971
- sio = StringIO.open( str )
1972
- reader = Reader.new( sio, "(string)", false )
1973
- result = nil
1974
- while true
1975
- lineno = reader.lineno
1976
- s = reader._read
1977
- if s[1] # EOF?
1978
- break
1979
- elsif Nil != s[0].class
1980
- printf( "\n readExp=<<< %s >>>\n", printer._write(s[0]) ) if @debug_evaluator
1981
- result = printer._write( @evaluator.lispEval( s[0], reader.sourcefile, lineno ))
1982
- end
1983
- end
1984
- result
2114
+ class Hash
2115
+ def to_list
2116
+ arr = Array.new
2117
+ self.each_pair { |key,val|
2118
+ arr << Nendo::Cell.new( key, val )
2119
+ }
2120
+ arr.to_list
1985
2121
  end
1986
2122
  end