crawl.rb

# coding: utf-8
require 'pp'
require 'fileutils'
require 'mechanize'
require 'is_lisp.rb'

module Lispka
  Source = Struct.new(:text, :is_lisp)

  class SRFI
    def initialize(dir)
      @dir = dir
      @agent = WWW::Mechanize.new
    end

    def crawl
      index_page = @agent.get("http://srfi.schemers.org/final-srfis.html")
      index_page.links.each do |link|
        if link.href =~ /srfi-(\d+)/
          number = $1.to_i
          next if number <= 71
          begin
            srfi_page = link.click

            url = "http://srfi.schemers.org/srfi-#{number}/srfi-#{number}.html"
            puts url
            site = WebSite.new(url)
            site.crawl
            site.save(File.join(@dir, number.to_s))
          rescue Exception => e
            puts e.class
            if e.class.to_s =~ /Iconv::/
              next
            else
              raise e
            end
          end
        end
      end
      self
    end

  end

  class WebSite
    def initialize(url)
      @url = url
      @agent = WWW::Mechanize.new
      @srcs = []
    end

    def crawl(is_all=false)
      page = @agent.get(@url)
      loop do
        @srcs.concat WebPage.new(page.root).extract
        break if not is_all
        link_prev = page.root.at('#pager-bottom a.prev')
        break if link_prev.nil?
        puts "proceed to #{link_prev["href"]} ..."
        page = @agent.get(link_prev["href"])
      end 
      self
    end

    def save(dir)
      mkdir(dir)
      mkdir(File.join(dir, "t"))
      mkdir(File.join(dir, "nil"))

      @srcs.each do |src|
        n = 0
        (n += 1) while File.exist?(filename = path_of(dir, src.is_lisp, n.to_s))
        File.open(filename, "w"){|f|
          f.write src.text
        }
        puts "wrote #{filename}"
      end
    end

    private

    def path_of(dir, is_lisp, file)
      File.join(dir, (is_lisp ? "t" : "nil"), file)
    end

    def mkdir(dir)
      FileUtils.mkdir_p(dir) unless File.exist?(dir)
      puts "made a directory #{dir}"
    end
  end

  class WebPage
    def initialize(doc)
      @doc = doc
    end

    def extract
      (@doc/"pre").map{|pre|
        text = scrape(pre)
        Source.new(text, Lispka.lisp?(text))
      }.compact
    end

    private

    def scrape(pre)
      pre.text
    end
  end
end

  # http://scheme.g.hatena.ne.jp/yaotti/
if ARGV.size < 2
  puts "usage: #$0 url dirname [opt]"
  puts "opt = (*none*|all)"
else
  url, dirname, all = *ARGV

  #Lispka::WebSite.new(url).crawl(all=="all").save(dirname)
  Lispka::SRFI.new(dirname).crawl
end

is_lisp.rb

$LOAD_PATH << "/Users/yhara/proj/unbabel/ruby/lib"
require 'unbabel'

module Lispka
  @@lispp = Unbabel::Scheme.new(<<-EOD)
;; lispp :: String -> Int

(define false 0)
(define true 1)

(define (include-unlispy-symbol? sexp)
  (define (unlispy? symbol)
;    (with-output-to-port (standard-error-port)
;      (lambda () (print symbol)))
    (any (lambda (c) 
           (memq c (string->list "{}")))
         (string->list (symbol->string symbol))))
  (cond ((symbol? sexp)
         (unlispy? sexp))
        ((pair? sexp)
         (or (include-unlispy-symbol? (car sexp))
             (include-unlispy-symbol? (cdr sexp))))
        (else
         #f)))

(define (lispp str)
  (let* ((sexps (port->sexp-list (open-input-string str)))
         (n_sexps (length sexps))
         (n_lines (length (port->string-list (open-input-string str)))))
    (cond 
      ((<= n_lines 2)
       false)
;      ((include-unlispy-symbol? sexps)
;       false)
      ((< n_lines n_sexps)
       false)
      (else
       true))))
EOD

  def self.lisp?(src)
    @@lispp[src] == 1
  end

end

#fib[10].should == 55

score.scm

; lisp_score :: String -> Int
(use srfi-1) ; take-while, zip
(define (indent-of line)
  (length
    (take-while (lambda (c) (eq? c #\space))
                (string->list line))))

(define (lisp_score str)
  (define (empty-line? line)
    (or (#/^\s*$/ line)
        (#/^;/ line)))
  (define (calc-score prev current)
    (if (not prev)
      0
      (let* ((p (indent-of prev))
             (c (indent-of current))
             (diff (- c p)))
        (cond 
          ((or (empty-line? prev) (empty-line? current))
           0)
          ((or (= diff 1) (= diff 2))
           1)
          ((= p c)
           0)
          ((= c 0)
           0)
          ((< c p)
           (- c p))
          (else
            (- p c))))))

  (define (calc-line lines)
    (let ((prev (car lines))
          (current (cadr lines)))
      (let1 score (calc-score prev current)
        (format (standard-error-port) "~4d ~s\n" score current)
        score)))

  (format (standard-error-port) "\n")
  (let1 lines (string-split str #\newline)
    (fold + 0 (map calc-line (zip (cons #f lines)
                                  lines)))))

spec_is_lisp.dat

----lispka: t

(define (sqrt-iter guess x)
  (print #`"sort-iter: ,guess ,x")
  (if (good-enough? guess x)
      guess
      (sqrt-iter (improve guess x)
                 x)))
;あとは1.6.scmといっしょ
----lispka: nil

yhara@meteor:~/src/sicp % gosh
gosh> (load "./1.7.scm")
#t
gosh> (sqrt 0.000000001)
sort-iter: 1.0 1.0e-9
sort-iter: 0.5000000005 1.0e-9
sort-iter: 0.25000000125 1.0e-9
sort-iter: 0.125000002625 1.0e-9
sort-iter: 0.06250000531249991 1.0e-9
sort-iter: 0.03125001065624928 1.0e-9
0.03125001065624928
gosh>
----lispka: nil

gosh> (sqrt 100000000)
sort-iter: 1.0 100000000
sort-iter: 50000000.5 100000000
sort-iter: 25000001.24999999 100000000
sort-iter: 12500002.624999894 100000000
sort-iter: 6250005.312499107 100000000
sort-iter: 3125010.6562427534 100000000
sort-iter: 1562521.328066817 100000000
sort-iter: 781292.6635966157 100000000
sort-iter: 390710.3283034968 100000000
sort-iter: 195483.13619747627 100000000
sort-iter: 97997.34463768976 100000000
sort-iter: 49508.89022510405 100000000
sort-iter: 25764.364740575656 100000000
sort-iter: 14822.847335384222 100000000
sort-iter: 10784.594750729779 100000000
sort-iter: 10028.540197249 100000000
sort-iter: 10000.040611237677 100000000
sort-iter: 10000.000000082462 100000000
sort-iter: 10000.0 100000000
----lispka: t

(define (square x) (* x x))

;(define (sqrt-iter guess x)
;  (if (good-enough? guess x)
;      guess
;      (sqrt-iter (improve guess x)
;                 x)))

(define (improve guess x)
  (average guess (/ x guess)))

(define (average x y)
  (/ (+ x y) 2))

(define (good-enough? guess x)
  (< (abs (- (square guess) x)) 0.001))

(define (sqrt x)
  (sqrt-iter 1.0 x))

(define (new-if predicate then-clause else-clause)
    (cond (predicate then-clause)
              (else else-clause)))

(define (sqrt-iter guess x)
  (new-if (good-enough? guess x)
          guess
          (sqrt-iter (improve guess x)
                     x)))
----lispka: nil

yhara@meteor:~/src/sicp % rlwrap gosh
gosh> (load "./1.6.scm")
#t
gosh> (sqrt 5.0)
(帰ってこないのでCtrl-cを押す)
*** ERROR: unhandled signal 2 (SIGINT)
Stack Trace:
_______________________________________
  0  (* x x)
        At line 1 of "./1.6.scm"
  1  (square guess)
        At line 16 of "./1.6.scm"
  2  (abs (- (square guess) x))
        At line 16 of "./1.6.scm"
  3  (good-enough? guess x)
        At line 26 of "./1.6.scm"
 (中略)
 29  (sqrt-iter (improve guess x) x)
        At line 28 of "./1.6.scm"
... (more stack dump truncated)
gosh>
----lispka: nil

(test 0 (p))
→ (test 0 (p))
→ (test 0 (p))
→ (test 0 (p))
...
----lispka: nil

yhara@meteor:~/src/sicp % gosh
gosh> (define (p) (p))

(define (test x y)
  (if (= x 0)
      0
      y))
p
gosh> test
gosh> (test 0 (p))


----lispka: nil

(test 0 (p))
→ (if (= 0 0) 0 (p))
→ 0
----lispka: nil

p = p
test x y = if x == 0 then x else y

main = print $ test 0 p
----lispka: nil

yhara@meteor:~/src/sicp % runhugs 1.5.hs
0
----lispka: nil

(if b>0 then (+) else (-)) a b
----lispka: nil

(if b>0 
  proc{|a,b| a+b}
 else
  proc{|a,b| a-b}
 end).call(a, b)
----lispka:nil

a.__send__(if b>0 then :+ else :- end, b)
----lispka:t

(define (sum-of-squares-of-biggest-two a b c)
  0)
----lispka:t

(use gauche.test)
(load "./1.3.scm")

(test-start "1.3")
(test* "test1"
       13
       (sum-of-squares-of-biggest-two 1 2 3))
(test* "test2"
       (+ 25 36)
       (sum-of-squares-of-biggest-two 6 4 5))
(test-end)
----lispka:nil

yhara@meteor:~/src/sicp % gosh test-1.3.scm
Testing 1.3 ...
test test1, expects 13 ==> ERROR: GOT 0
test test2, expects 61 ==> ERROR: GOT 0
failed.
discrepancies found.  Errors are:
test test1: expects 13 => got 0
test test2: expects 61 => got 0
----lispka:t

(define (sum-of-squares-of-biggest-two a b c)
  (let1 sorted (sort (list a b c))
        (+ (expt (car sorted) 2)
           (expt (cadr sorted) 2))))
----lispka:nil

yhara@meteor:~/src/sicp % gosh test-1.3.scm
Testing 1.3 ...
test test1, expects 13 ==> ERROR: GOT 5
test test2, expects 61 ==> ERROR: GOT 41
failed.
discrepancies found.  Errors are:
test test1: expects 13 => got 5
test test2: expects 61 => got 41
----lispka:t

(define (sum-of-squares-of-biggest-two a b c)
  (let1 sorted (sort (list a b c) >)
        (+ (expt (car sorted) 2)
           (expt (cadr sorted) 2))))
----lispka:nil

yhara@meteor:~/src/sicp % gosh test-1.3.scm
Testing 1.3 ...
test test1, expects 13 ==> ok
test test2, expects 61 ==> ok
passed.
----lispka:t

(/ (+ 5 4 (- 2 (- 3 (+ 6 (/ 4 5)))))
   (* 3 (- 6 2) (- 2 7)))
----lispka:nil

yhara@meteor:~/src/sicp % gosh
gosh> (/ 4 5)
0.8
----lispka:nil

yhara@meteor:~/src/sicp % rlwrap gosh
gosh> (/ 4 5)
0.8
gosh> (/ 1 3)
0.3333333333333333
gosh> (exact? (/ 1 3))
#f
gosh> (exact? 1/3)
#f
----lispka:nil

yhara@meteor:~/src/sicp % gosh -V
Gauche scheme interpreter, version 0.8.3 [utf-8,pthreads]
----lispka:nil

10
12
8
3
6
(処理系依存) a=3
(処理系依存) b=4
19
#f
4 ((> b a)は#tで、(< b (* a b))も#tなので)
16
6
16

spec_is_lisp.rb

require 'spec'
require 'spec'
require 'is_lisp.rb'

def judge_sources
  srcs = {:t => [], :nil => []}
  src = nil
  is_lisp = nil
  File.read("spec_is_lisp.dat").each_line do |line|
    case line
    when /----lispka:\s*t/
      srcs[is_lisp] << src if src
      is_lisp = :t
      src = ""
    when /----lispka:\s*nil/
      srcs[is_lisp] << src if src
      is_lisp = :nil
      src = ""
    else
      src << line
    end
  end
  srcs[is_lisp] << src

  srcs
end

describe "Lispka.lisp?" do
  judge_sources.each do |is_lisp, srcs|
    srcs.each do |src|
      it "should judge the #{is_lisp == :t ? 'lisp' : 'text'} #{src}" do
        Lispka.lisp?(src).should == (is_lisp == :t ? true : false)
      end
    end
  end
end

viewer.rb

# coding: utf-8
require 'rubygems'
require 'sinatra'
require 'is_lisp.rb'

#$lisp_score = Unbabel::Scheme.new(File.read("score.scm"))

template :layout do
  <<-EOD
  <html>
  <head>
    <style>
    pre{ border: 1px solid black; padding: 1em }
    .lisp{ background:#efe }
    .text{ background:#fee }

    .minus{ background:#fee }
    </style>
    <script language="javascript" type="text/javascript" src="javascript/jquery.js"></script>
    <script language="javascript" type="text/javascript" src="javascript/jquery.flot.js"></script>
  </head>
  <body>
  <%= yield %>
  </body>
  </html>
  EOD
end

def render_index(dir)
  @dirs = Dir["#{dir}/*"].select{|d| File.directory?(d)}

  erb <<-EOD
  <ul>
    <% @dirs.each do |d| %>
      <% dd = d.gsub('/', ' ') %>
      <li><a href='/<%= dd %>'><%= d %></a></li>
    <% end %>
  </ul>
  EOD
end

get '/' do
  render_index(".")
end

get '/*' do
  name = params[:splat].first.gsub(/ /, "/")
  #raise params[:splat].inspect #name.inspect

  return render_index(name) unless Dir["#{name}/*"].sort == ["#{name}/nil", "#{name}/t"]
  @lisps = Dir["#{name}/t/*"].sort_by{|path| 
    path.scan(/\d+/).last.to_i
  }
  @texts = Dir["#{name}/nil/*"]
  @lisps_scores = @lisps.map{|path|
    src = File.read(path)
    score = $lisp_score[src]
    [path, src, score]
  }.sort_by{|path, src, score|
    score
  }

  @name = name
  erb <<-EOD
  <a href='<%= @name.split('/')[0..-2].join('/') %>'>back</a>
  <h1><%= @name %></h1>

  <div id="placeholder" style="width:600px;height:300px;"></div>

  <h2>Lisp</h2>
  <% @lisps_scores.each do |path, src, score| %>
    #<%= path %> <%= score %>
    <pre class='<%= (score >= 0) ? "lisp" : "minus"%>'>
    <%= src %>
    </pre>
  <% end %>

<script id="source" language="javascript" type="text/javascript">
$(function () {
    var d1 = [
      <% @lisps_scores.each_with_index do |(path, src, score), i| %>
        [ <%= i %>, <%= score %> ],
      <% end %>
    ];
    
    $.plot($("#placeholder"), [ d1 ]);
});
</script>
  EOD
#  <h2>Text</h2>
#  <% @texts.each do |s| %>
#    <pre class='text'>
#    <%= File.read(s) %>
#    </pre>
#  <% end %>
#  EOD
end

$lisp_score = Unbabel::Scheme.new(<<EOD)
; lisp_score :: String -> Int
(use srfi-1) ; take-while, zip
(define (indent-of line)
  (length
    (take-while (lambda (c) (eq? c #\space))
                (string->list line))))

(define (lisp_score str)
  (define (empty-line? line)
    (or (#/^\s*$/ line)
        (#/^;/ line)))
  (define (calc-score prev current)
    (if (not prev)
      0
      (let* ((p (indent-of prev))
             (c (indent-of current))
             (diff (- c p)))
        (cond 
          ((or (empty-line? prev) (empty-line? current))
           0)
          ((or (= diff 1) (= diff 2))
           1)
          ((= p c)
           0)
          ((= c 0)
           0)
          ((< c p)
           (- c p))
          (else
            (- p c))))))

  (define (calc-line lines)
    (let ((prev (car lines))
          (current (cadr lines)))
      (let1 score (calc-score prev current)
        (format (standard-error-port) "~4d ~s\n" score current)
        score)))

  (format (standard-error-port) "\n")
  (let1 lines (string-split str #\newline)
    (fold + 0 (map calc-line (zip (cons #f lines)
                                  lines)))))
EOD