[uim-commit] r1204 - in branches/r5rs: scm sigscheme

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-08-15 10:59:07 -0700 (Mon, 15 Aug 2005)
New Revision: 1204

Modified:
   branches/r5rs/scm/util.scm
   branches/r5rs/sigscheme/main.c
Log:
* scm/util.scm
  - (symbol-append): New procedure
  - (symbolconc): Replace with a alias to symbol-append
  - (nconc): Move from "SRFI procedures" section to "generic
    utilities" section since it's not a SRFI proc

* sigscheme/main.c
  - Add #include <stdio.h> for stdin and stdout


Modified: branches/r5rs/scm/util.scm
===================================================================
--- branches/r5rs/scm/util.scm	2005-08-15 17:58:02 UTC (rev 1203)
+++ branches/r5rs/scm/util.scm	2005-08-15 17:59:07 UTC (rev 1204)
@@ -31,6 +31,10 @@
 
 ;; Current uim implementation treats char as integer
 
+;;
+;; generic utilities
+;;
+
 ;; TODO: write test
 (define string-escape
   (lambda (s)
@@ -143,6 +147,11 @@
   (lambda args
     (apply string-append (apply map args))))
 
+;; symbol-append is a de facto standard procedure name
+(define symbol-append
+  (lambda args
+    (string->symbol (string-append-map symbol->string args))))
+
 ;; only accepts single-arg functions
 ;; (define caddr (compose car cdr cdr))
 (define compose
@@ -185,6 +194,15 @@
     (max bottom
 	 (min x ceiling))))
 
+(define nconc
+  (lambda (lst obj)
+    (if (null? lst)
+	obj
+	(set-cdr! (last-pair lst) obj))))
+
+;; backward compatibility: should be obsoleted
+(define symbolconc symbol-append)
+
 ;;
 ;; R5RS-like character procedures
 ;;
@@ -227,7 +245,7 @@
 	(- c 48)
 	c)))
 
-;; backward compatibility
+;; backward compatibility: should be obsoleted
 (define control-char? char-control?)
 (define alphabet-char? char-alphabetic?)
 (define numeral-char? char-numeric?)
@@ -281,12 +299,6 @@
 	(last-pair (cdr lst))
 	lst)))
 
-(define nconc
-  (lambda (lst obj)
-    (if (null? lst)
-	obj
-	(set-cdr! (last-pair lst) obj))))
-
 ;; TODO: write test
 (define last
   (lambda (lst)
@@ -484,16 +496,6 @@
 	 (not (*catch 'errobj (begin (load file)
 				     #f))))))
 
-(define (symbolconc . args)
-  (let* ((ret-sym "")
-	 (append-to-ret (lambda (str)
-			  (set! ret-sym
-				(string-append ret-sym str)))))
-    (for-each append-to-ret
-	      (map symbol->string
-		   args))
-    (string->symbol ret-sym)))
-
 ;; TODO: write test
 ;; returns succeeded or not
 (define try-require

Modified: branches/r5rs/sigscheme/main.c
===================================================================
--- branches/r5rs/sigscheme/main.c	2005-08-15 17:58:02 UTC (rev 1203)
+++ branches/r5rs/sigscheme/main.c	2005-08-15 17:59:07 UTC (rev 1204)
@@ -34,6 +34,7 @@
 /*=======================================
   System Include
 =======================================*/
+#include <stdio.h>
 
 /*=======================================
   Local Include