lifeLOG + REPOsitory: 正規表現を使った処理を scheme (Gauche) で書いてみる

2010-09-16

今日は時間がないので、とりあえず、コードだけを貼っておく。これで、前回の Ruby、Python のコードと同じ結果になる。

	#!/opt/local/bin/gosh
	;; -- coding: utf-8 --

	;; get_tag_and_class.scm: extract tag and class names from a HTML document.

	(define (match-tag-and-class line)
	(rxmatch-case line
	[#/<(\w+)[^<>]class=[\'\"]([^\'\"]+)[\'\"][^<>]>(.*)/
	(all tag class rest)
	(if (> (string-length rest) 0)
	(append (list (cons tag class))
	(match-tag-and-class rest))
	(list (cons tag class)))
	]
	[else ()]))

	(define (print-tag-and-class-with-number-inner lst num)
	(if (not (null? lst))
	(begin
	(let ((top (car lst)))
	(if top
	(print num ": " (car top) "." (cdr top))))
	(print-tag-and-class-with-number-inner (cdr lst) num))))

	(define (print-tag-and-class-with-number lst num)
	(if (not (null? lst))
	(begin
	(let ((result (car lst)))
	(if (not (null? result))
	(print-tag-and-class-with-number-inner result num)))
	(print-tag-and-class-with-number (cdr lst) (+ num 1)))))

	(define (print-tag-and-class lst)
	(print-tag-and-class-with-number lst 1))

	(print-tag-and-class
	(map match-tag-and-class (port->string-list (standard-input-port))))