nendo 0.3.1 → 0.3.2

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/init.nnd CHANGED
@@ -2,7 +2,7 @@
2
2
  ;;;
3
3
  ;;; init.nnd - Nendo's init file.
4
4
  ;;;
5
- ;;; Copyright (c) 2000-2010 Kiyoka Nishiyama <kiyoka@sumibi.org>
5
+ ;;; Copyright (c) 2009-2010 Kiyoka Nishiyama <kiyoka@sumibi.org>
6
6
  ;;;
7
7
  ;;; Redistribution and use in source and binary forms, with or without
8
8
  ;;; modification, are permitted provided that the following conditions
@@ -57,6 +57,12 @@
57
57
  body)))))))))
58
58
 
59
59
 
60
+ ;; debug-print macro is predefined as NOP.
61
+ ;; for self debugging of init.nnd.
62
+ (define debug-print
63
+ (macro (_form sourcefile lineno sourcesexp)
64
+ _form))
65
+
60
66
  ;; ----------------------------------------
61
67
  ;; car and cdr functions
62
68
  ;; ----------------------------------------
@@ -106,6 +112,7 @@
106
112
  ;; ----------------------------------------
107
113
  ;; Utility functions
108
114
  ;; ----------------------------------------
115
+ (define (vector . lst) (to-arr lst))
109
116
  (define (list? arg)
110
117
  (if (pair? arg)
111
118
  (list? (cdr arg))
@@ -241,7 +248,6 @@
241
248
  (apply1 proc (append (reverse (cdr lol)) (car lol))))
242
249
  (reverse args))))
243
250
 
244
-
245
251
  ;; The following quasiquote macro is due to Eric S. Tiedemann. ( Imported from TinyScheme )
246
252
  ;; Copyright 1988 by Eric S. Tiedemann; all rights reserved.
247
253
  ;;
@@ -259,8 +265,11 @@
259
265
  (if (or (procedure? f) (number? f) (string? f))
260
266
  f
261
267
  (list 'quote f))
262
- (list 'cons l r))))
263
-
268
+ (if (eqv? l vector)
269
+ (apply l (eval r))
270
+ (list 'cons l r)
271
+ ))))
272
+
264
273
  (mappend
265
274
  (lambda (f l r)
266
275
  (if (or (null? (cdr f))
@@ -364,6 +373,37 @@
364
373
  ;; ----------------------------------------
365
374
  ;; List utilities imported from TinyScheme
366
375
  ;; ----------------------------------------
376
+ ;;
377
+ ;; (do ((var init inc) ...) (endtest result ...) body ...)
378
+ ;;
379
+ (define do
380
+ (macro do-macro
381
+ (apply (lambda (vars endtest . body)
382
+ (let ((do-loop (gensym)))
383
+ `(letrec ((,do-loop
384
+ (lambda ,(map (lambda (x)
385
+ (if (pair? x) (car x) x))
386
+ `,vars)
387
+ (if ,(car endtest)
388
+ (begin ,@(cdr endtest))
389
+ (begin
390
+ ,@body
391
+ (,do-loop
392
+ ,@(map (lambda (x)
393
+ (cond
394
+ ((not (pair? x)) x)
395
+ ((< (length x) 3) (car x))
396
+ (else (car (cdr (cdr x))))))
397
+ `,vars)))))))
398
+ (,do-loop
399
+ ,@(map (lambda (x)
400
+ (if (and (pair? x) (cdr x))
401
+ (car (cdr x))
402
+ '()))
403
+ `,vars)))))
404
+ do-macro)))
405
+
406
+
367
407
  ;; generic-member
368
408
  (define (generic-member cmp obj lst)
369
409
  (cond
@@ -408,13 +448,52 @@
408
448
  ;; ----------------------------------------
409
449
  ;; Higher-order functions
410
450
  ;; ----------------------------------------
411
- (define (map pred lst)
412
- (if (null? lst)
413
- '()
414
- (cons
415
- (pred (car lst))
416
- (map pred (cdr lst)))))
417
- (define for-each map)
451
+ ;; List utilities imported from TinyScheme by Kiyoka Nishiyama
452
+ ;; and Fixed bugs in `map' and `for-each'.
453
+ (define (foldr f x lst)
454
+ (if (null? lst)
455
+ x
456
+ (foldr f (f x (car lst)) (cdr lst))))
457
+
458
+ (define (unzip1-with-cdr . lists)
459
+ (unzip1-with-cdr-iterative lists '() '()))
460
+
461
+ (define (unzip1-with-cdr-iterative lists cars cdrs)
462
+ (if (null? lists)
463
+ (cons cars cdrs)
464
+ (let ((car1 (caar lists))
465
+ (cdr1 (cdar lists)))
466
+ (unzip1-with-cdr-iterative
467
+ (cdr lists)
468
+ (append cars (list car1))
469
+ (append cdrs (list cdr1))))))
470
+
471
+
472
+ (define (map proc . lists)
473
+ (if (null? lists)
474
+ (apply proc)
475
+ (if (null? (car lists))
476
+ '()
477
+ (let1 unz (apply unzip1-with-cdr lists)
478
+ (let ((cars (car unz))
479
+ (cdrs (cdr unz)))
480
+ (cons (apply proc cars)
481
+ (if (null? cdrs)
482
+ '()
483
+ (apply map (cons proc cdrs)))))))))
484
+
485
+ (define (for-each proc . lists)
486
+ (if (null? lists)
487
+ (apply proc)
488
+ (if (null? (car lists))
489
+ #t
490
+ (let1 unz (apply unzip1-with-cdr lists)
491
+ (let ((cars (car unz))
492
+ (cdrs (cdr unz)))
493
+ (apply proc cars)
494
+ (if (null? cdrs)
495
+ '()
496
+ (apply map (cons proc cdrs))))))))
418
497
 
419
498
  (define (filter pred lst)
420
499
  (if (null? lst)
@@ -454,14 +533,18 @@
454
533
  (let ((defs
455
534
  (filter
456
535
  (lambda (x)
457
- (and (eq? 'define (car x))
458
- (symbol? (cadr x))))
536
+ (if (pair? x)
537
+ (and (eq? 'define (car x))
538
+ (symbol? (cadr x)))
539
+ #f))
459
540
  body))
460
541
  (rest
461
542
  (filter
462
543
  (lambda (x)
463
- (not (and (eq? 'define (car x))
464
- (symbol? (cadr x)))))
544
+ (if (pair? x)
545
+ (not (and (eq? 'define (car x))
546
+ (symbol? (cadr x))))
547
+ #f))
465
548
  body)))
466
549
  (if (< 0 (length defs))
467
550
  `(lambda
@@ -533,6 +616,17 @@
533
616
  (let*-expand exps body))))
534
617
 
535
618
 
619
+ (define begin0
620
+ (macro body
621
+ (if (null? body)
622
+ '(begin
623
+ #f)
624
+ (let1 result (gensym)
625
+ `(receive ,result ,(car body)
626
+ ,@(cdr body)
627
+ (apply values ,result))))))
628
+
629
+
536
630
  ;; ----------------------------------------
537
631
  ;; values
538
632
  ;; ----------------------------------------
@@ -703,6 +797,7 @@
703
797
  (error "Error: alist->hash-table expects alist.")
704
798
  (apply hash-table alist)))
705
799
 
800
+
706
801
  ;; ----------------------------------------
707
802
  ;; Ruby interop librarys
708
803
  ;; ----------------------------------------
@@ -723,6 +818,60 @@
723
818
  (errorf "Error: can't load library file [%s]\n" path )))))
724
819
 
725
820
 
821
+
822
+ ;; ----------------------------------------
823
+ ;; Vector Library
824
+ ;; ----------------------------------------
825
+ (define (vector? v)
826
+ (v.is_a? Array))
827
+
828
+ (define (make-vector k . rest)
829
+ (if (null? rest)
830
+ (Array.new k)
831
+ (Array.new k (car rest))))
832
+
833
+ (define (vector-length v)
834
+ (v.size))
835
+
836
+ (define (vector-copy v)
837
+ (v.clone))
838
+
839
+ (define (vector-ref v index . fallback)
840
+ (if (and (<= 0 index) (< index v.size))
841
+ (v.fetch index)
842
+ (if (null? fallback)
843
+ (errorf "Error: vector-ref index value is overflow: %s\n" index)
844
+ (car fallback))))
845
+
846
+ ;;
847
+ ;; ported from tinyscheme-1.39 by Kiyoka Nishiyama
848
+ ;;
849
+ (define (vector-equal? x y)
850
+ (and (vector? x) (vector? y) (= (vector-length x) (vector-length y))
851
+ (let ((n (vector-length x)))
852
+ (let loop ((i 0))
853
+ (if (= i n)
854
+ #t
855
+ (and (equal? (vector-ref x i) (vector-ref y i))
856
+ (loop (succ i))))))))
857
+
858
+ (define (list->vector x)
859
+ (apply vector x))
860
+
861
+ (define (vector-fill! v e)
862
+ (let ((n (vector-length v)))
863
+ (let loop ((i 0))
864
+ (if (= i n)
865
+ v
866
+ (begin (vector-set! v i e) (loop (succ i)))))))
867
+
868
+ (define (vector->list v)
869
+ (let loop ((n (pred (vector-length v))) (l '()))
870
+ (if (= n -1)
871
+ l
872
+ (loop (pred n) (cons (vector-ref v n) l)))))
873
+
874
+
726
875
  ;; ----------------------------------------
727
876
  ;; Utility function for testing and debugging
728
877
  ;; ----------------------------------------
@@ -782,9 +931,92 @@
782
931
  (newline))
783
932
 
784
933
 
934
+
935
+ ;; ----------------------------------------
936
+ ;; global variables bind checker
937
+ ;; ----------------------------------------
938
+ (define (global-defined? sym)
939
+ (find
940
+ (lambda (x)
941
+ (eq? sym x))
942
+ (global-variables)))
943
+
944
+
945
+ ;; ----------------------------------------
946
+ ;; Nendo compiler utility
947
+ ;; ----------------------------------------
948
+ (define (compiled-code-string compiled-code filename)
949
+ (define (compiled-body-string string-list filename)
950
+ (+
951
+ (string-join
952
+ string-list
953
+ "\n#--------------------\n")
954
+ (string-join
955
+ `("\n\n"
956
+ "# -------------------------------------------------------"
957
+ "# [EOF]"
958
+ "# -------------------------------------------------------")
959
+ "\n")))
960
+
961
+ (let ((str-list (assv-ref filename compiled-code))
962
+ (script-flag (and (global-defined? 'main)
963
+ (procedure? main))))
964
+ (values
965
+ script-flag
966
+ (compiled-body-string str-list filename))))
967
+
968
+
969
+ (define (print-compiled-code src . rest)
970
+ (define (print-to-file f)
971
+ (receive (script-flag str)
972
+ (compiled-code-string (get-compiled-code) src)
973
+ (cond (script-flag
974
+ (f.puts (string-join
975
+ `(
976
+ "#!/usr/local/bin/ruby"
977
+ "# -*- encoding: utf-8 -*-"
978
+ "#"
979
+ "# This file is nendo's compiled script file. "
980
+ "# generated \"nendo -c src\" command. "
981
+ "#"
982
+ ""
983
+ "require 'rubygems'"
984
+ "require 'nendo'"
985
+ ""
986
+ "core = Nendo.new()"
987
+ "core.loadInitFile()"
988
+ "core.setArgv( ARGV )"
989
+ "core.load_compiled_code_from_string( " ,(write-to-string str) " ) "
990
+ "core.replStr( \"(if (and (global-defined? 'main) (procedure? main)) (main *argv*) #f) \" )"
991
+ "")
992
+ "\n")))
993
+ (else
994
+ (f.puts (+ (string-join
995
+ '(
996
+ "#"
997
+ "# This file is nendo's compiled library file. "
998
+ "# generated \"nendo -c src\" command. "
999
+ "# ")
1000
+ "\n")
1001
+ "\n"
1002
+ str))))))
1003
+
1004
+ (when (not (File.exist? src))
1005
+ (errorf "Error: file [%s] not found." src)
1006
+ (exit 1))
1007
+ (clean-compiled-code)
1008
+ (load src)
1009
+ (if (null? rest)
1010
+ (print-to-file STDOUT)
1011
+ (with-open (car rest)
1012
+ (lambda (f)
1013
+ (print-to-file f))
1014
+ "w")))
1015
+
1016
+
785
1017
  ;; ----------------------------------------
786
1018
  ;; global variables
787
1019
  ;; ----------------------------------------
788
1020
  (define *nendo-version*
789
- "0.3.1" ;;NENDO-VERSION
1021
+ "0.3.2" ;;NENDO-VERSION
790
1022
  )