CommonLisp Scheme Part13

CommonLisp Scheme Part13at TECH

CommonLisp Scheme Part13 - 暇つぶし2ch■コピペモード
□スレを通常表示
□オプションモード
□このｽﾚｯﾄﾞのURL
■項目テキスト

650:デフォルトの名無しさん
 05/08/08 20:39:31 
汚く、token がchar の、indent(space)-num conscious な gauche 版ならできた。 
 
(define (port->sp/char/nls iport) 
  (reverse 
   (fold 
(lambda (x y) 
  (cond ((eq? x #\newline) (cons '() y)) 
((null? y) `((,x))) 
(else (cons `(,@(car y) ,x) (cdr y))))) 
'() 
(port->list read-char iport)))) 
 
(define (proc arg) 
  (let lp ((rest arg) 
   (temp '()) 
   (result '())) 
(if (null? rest) 
(reverse (if (null? temp) result `(,(proc temp) ,@result))) 
(let ((node (car rest))) 
  (case (length node) 
((0) (if (null? temp) 
 (lp (cdr rest) '() result) 
 (lp (cdr rest) '() `(,(proc (reverse temp)) ,@result)))) 
((1) (if (null? temp) 
 (lp (cdr rest) '() `(,(car node) ,@result)) 
 (lp (cdr rest) '() `(,(car node) ,(proc (reverse (cons (cdr node) temp))) ,@result)))) 
(else 
 (lp (cdr rest) `(,(cdr node) ,@temp) result)))))))

651:デフォルトの名無しさん
 05/08/08 20:40:04 
(proc (port->sp/char/nls (open-input-string "a 
b 
 c 
  d 
      dd 
  e 
 f 
 g 
  h 
   i 
 j 
k"))) 
=> 
(#\a #\b (#\c (#\d (((((#\d))))) #\e) #\f #\g (#\h (#\i)) #\j) #\k)

次ページ