[Racket]字句解析

Racketのparser-toolsを使って字句解析をしてみます。

#lang racket
(require parser-tools/lex
  parser-tools/lex-sre)

(define-lex-abbrev newline
  (or (: #\return #\newline)
      (: #\newline)
      (: #\return)))

(define-lex-abbrev whitespace
  (+
   (or (: #\tab)
       (: #\space))))

(define-lex-abbrev section
  (: #\[
     (* (~ #\]))
     #\]))

(define-lex-abbrev =
  #\=)

(define-lex-abbrev id
  (+ (~ #\space #\tab #\newline #\return #\[ #\])))

(define l
  (lexer
   ;; skip
   [newline (l input-port)]
   ;; skip
   [whitespace (l input-port)]
   [section `(section . ,lexeme)]
   [= `(equal . "=")]
   [(eof) `(eof . null)]
   [id `(id . ,lexeme)]))


(define p (open-input-string "[section]\n key = value"))

(display (l p))
;=> (section . [section])
(display (l p))
;=> (id . key)
(display (l p))
;=> (equal . =)
(display (l p))
;=> (id . value)
(display (l p))
;=> (eof . null)

[Racket] HTMLのパース

RacketでHTMLをパースするにはhtmlモジュールとxmlモジュールを使います。

#lang racket

(require
 (prefix-in url: net/url)
 (prefix-in h: html)
 (prefix-in x: xml))

(define (get-attribute name elem)
  (let loop ((rest (h:html-element-attributes elem)))
    (cond
     [(null? rest) #f]
     [(eq? name (x:attribute-name (car rest)))
      (x:attribute-value (car rest))]
     [else (loop (cdr rest))])))

(define (get-element-by-id id elem)
  (match elem
    ([struct h:html-full (attributes content)]
     (let ((val (get-attribute 'id elem)))
       (if (and val (string=? val id))
    elem
    (let loop ((rest content))
      (if (null? rest)
   #f
   (or (get-element-by-id id (car rest))
       (loop (cdr rest))))))))
    ([struct h:html-element (attributes)]
     (let ((val (get-attribute 'id elem)))
       (if (and val (string=? val id))
    val
    #f)))
    (else #f)))

(define (get-html url-string)
  (h:read-html
   (url:get-pure-port
    (url:string->url url-string))))

(let ((obj (get-html "http://docs.racket-lang.org/html/index.html")))
  (let ((body (get-element-by-id "doc-racket-lang-org" obj)))
    (match body
      ([struct h:html-full (attributes content)]
       (displayln attributes)
       (displayln content)))))

外部プロセスの標準出力を取得する

1 Racket

 1:  ;; racket
 2:  #!lang racket
 3:  
 4:  (define (system->string-list cmd . args)
 5:    (match-define
 6:     (list in out pid err procedure)
 7:     (apply process* cmd args))
 8:    (procedure 'wait)
 9:    (unless (eq? (procedure 'status) 'done-ok)
10:            (raise 'exit-failure))
11:    (port->lines in))
12:  
13:  ;; (sytem->string-list "/bin/ls")

2 Chicken

1:  ;; Chicken
2:  (require 'posix)
3:  
4:  (call-with-input-pipe "ls"
5:    (lambda (p)
6:      (read-lines p)))

3 Gauche

1:  ;; Gauche
2:  (use gauche.process)
3:  (process-output->string-list '(ls))

4 Guile

1:  ;; Guile
2:  (use-modules (ice-9 popen))
3:  (use-modules (ice-9 rdelim))
4:  
5:  (let ((p (open-input-pipe "ls")))
6:    (let ((lines (read-delimited "" p)))
7:      (close-pipe p)
8:      (string-split lines #\newline)))

5 Ruby

1:  `ls`.split

6 Python

1:  import subprocess
2:  p = subprocess.Popen("ls", stdin=subprocess.PIPE, stdout=subprocess.PIPE,
3:                       close_fds=True)
4:  
5:  p.stdout.readlines()

処理系に質問する方法

いろいろなプログラミング言語を利用していると、
同じような機能の関数の名前が言語間で異なることがしばしばあります。
ブラウザを立ち上げてドキュメントを探して、としても良いかもしれませんが、
ちょっとど忘れした名前を調べるだけならば、使っている処理系に問いあわせるだけで
目的を達成できそうです。
ということで、各処理系でのヘルプ機能を調べてみました。

Ruby

Rubyのオブジェクトにはメソッドやメンバ変数の一覧を取得するメソッドが備わっています。

• methods メソッドを返す


• public_methods publicなメソッドを返す


• private_methods privateなメソッドを返す


• protected_methods protectedなメソッドを返す


• instance_methods メソッドを返す


• included_modules インクルードしているモジュールを返す


• constants 定数名を返す


• instance_variables インスタンス変数名を返す

xxx_methods系の戻り値の各要素は、1.8系だと文字列、1.9系だとシンボルだそうです。

> String.instance_methods.grep /upcase/
#=> ["upcase!", "upcase"]

Python

Pythonには情報を表示するhelp関数が存在します。
モジュールやクラスなどを指定できるようです。

> help(__builtins__)

> help(str)

> help("print")

また、inspectモジュールをインポートするとgetmembers関数で
メンバ一覧を取得できるようになるので、メソッドを検索することもできます。

> import inspect
> import re
> for (name, _) in inspect.getmembers(str):
...     if re.search("up", name):
...             print name
...
isupper
upper

inspectモジュールには関数の定義ファイルやソースコードを取得する関数もあるようです。

> inspect.getfile(inspect.getfile)
'/usr/lib/python2.6/inspect.py'
> inspect.getsource(inspect.getsource)
...

Common Lisp

Common Lisp処理系は、関数や変数を検索するapropos関数を備えています。
apropos関数は検索するパッケージを指定することができるので、
COMMON-LISPパッケージ(CLパッケージ)を指定することで仕様に存在する関数のみを検索する、
ということも可能です(指定しない場合はすべてのパッケージが対象)

• apropos 関数や変数を検索する。パッケージを指定できる。


• apropos-list 関数や変数を検索しリストにして返す。パッケージを指定できる。

;; SBCL
> (apropos "upcase" :cl)
CHAR-UPCASE (fbound)
NSTRING-UPCASE (fbound)
STRING-UPCASE (fbound)

パッケージ一覧やシンボル一覧を取得する方法もあります。

• list-all-packages すべてのパッケージを返す


• do-all-symbols すべてのシンボルを処理するためのループを実行するマクロ


• do-external-symbols パッケージ外部に公開されているシンボルを処理するためのループを実行するマクロ


• *features* 有効な機能一覧を格納している変数

オブジェクトの情報を表示するdescribe関数、
情報の表示を対話的に行うinspect関数といった機能があります。

また、Common Lispでは関数や変数の定義にドキュメントを含めることができ、
documentation関数でそのドキュメントを取得することができます。

Racket

Scheme処理系のRacketは、REPL(インタプリタ)にhelpと打ち込むと
インストールされているドキュメントを既定のブラウザで開いてくれます。

また、xreplというライブラリを読み込むことでREPLに機能を追加してくれます。
追加されるヘルプ機能は以下のとおりです。

• apropos 関数や変数を検索する


• describe 関数や変数がどこで定義されたかを表示する


• doc 指定した関数のドキュメントを既定のブラウザで表示する

> (require xrepl)
> ,apropos upcase
; Matches: char-upcase, string-locale-upcase, string-upcase.
> ,describe string-upcase
; `string-upcase' is a bound identifier,
;   defined in #%kernel
;   required through "racket/init.rkt"

> ,doc string-upcase
Sending to web browser...
  file: c:\Program Files (x86)\Racket\doc\reference\strings.html
  anchor: (def._((quote._~23~25kernel)._string-upcase))

Gauche

Scheme処理系のGaucheは、関数や変数を探すapropos関数を備えています。

> (apropos 'upcase)
char-upcase                    (scheme)
;; 文字列処理を行うSRFI-13ライブラリを読み込む
> (use srfi-13)
#<undef>
> (apropos 'upcase)
char-upcase                    (scheme)
string-upcase                  (srfi-13)
string-upcase!                 (srfi-13)

オブジェクトの情報を表示したい場合は、describe関数が使えます。

Guile

GNUのScheme処理系Guileは、関数や変数を探すapropos関数を備えています。

> (apropos "upcase")
(guile): char-upcase    #<primitive-procedure char-upcase>
(guile): string-upcase! #<primitive-procedure string-upcase!>
(guile): string-upcase  #<primitive-procedure string-upcase>

Chicken

Scheme処理系のChickenは、utilsライブラリを読み込むことで
関数や変数を検索するapropos関数が利用できるようになります。

> (require 'utils)
> (apropos 'upcase)
char-upcase : (procedure c692)
> (require 'srfi-13)
> (apropos 'upcase)
char-upcase    : (procedure c692)
string-upcase  : (procedure s694 . maybe-start+end695)
string-upcase! : (procedure s698 . maybe-start+end699)

Clojure

JVM上のLisp系言語であるClojureは、関数や変数の検索、ドキュメントや
ソースコードの表示といったヘルプ機能を備えているようです。

• doc ドキュメントを表示する


• source ソースコードを表示する


• find-doc ドキュメントを検索する


• apropos 関数名を検索する

Emacs Lisp

Emacsの拡張言語であるEmacs Lispにはさまざまなヘルプ機能があります。
多すぎるのでよく使っているもののみを列挙します。

• apropos 関数名や変数名を検索する


• help-for-help ヘルプ(デフォルトでC-hに割り当てられているコマンド)


• find-function 関数の定義位置へ移動する


• find-variable 変数の定義位置へ移動する

Racketでファイル名入力ダイアログ

get-file関数でファイル名入力ダイアログを利用できます.戻り値はパスまたは#fです.
オブジェクト指向風にファイル名入力用テキストフィールド+ボタンをまとめたクラスを作成してみます.

#lang racket

(require racket/gui/base)

(define file-input-pane%
  (class vertical-pane%
    (init-field button-label)
    (init-field parent)
    (init-field [label #f])
    (super-new [parent parent]
               [stretchable-height #f]
               [stretchable-width #f])
    (when label
      (new message% [label label]
           [stretchable-width #t]
           [parent this]))
    (define horizontal-pane
      (new horizontal-pane% [parent this]
           [stretchable-height #f]
           [stretchable-width #f]))
    (define file-name-field
      (new text-field%
           [label ""] [parent horizontal-pane]))
    (define file-name-button
      (new button%
           [label button-label]
           [parent horizontal-pane]
           [callback
            (lambda (btn evt)
              (let ((fpath (get-file)))
                (when fpath
                  (send file-name-field set-value
                        (path->string fpath)))))]))
    (define/public (get-value)
      (send file-name-field get-value))
    (define/public (set-value value)
      (send file-name-field set-value value))))

;; test
(define frame (new frame% [label "example"]
                  [width 300]
                  [height 200]))
(new file-input-pane% [parent frame]
     [label "hello"]
     [button-label "file"])

(send frame show #t)

Racketで画像作成(racket/draw)

Racketで画像を作成します.
いくつか手段がありそうですが、racket/drawを利用します.

フォントを指定すれば日本語も出力できるようです.

#lang racket

(require racket/draw)

(define target (make-bitmap 150 30))
(define dc (new bitmap-dc% [bitmap target]))

;; 長方形
(send dc draw-rectangle 1 1 149 29)

;; フォントの設定
(define ms-font (make-object font% 10 "ＭＳ ゴシック" 'default))
(send dc set-font ms-font)

;; 文字列
(send dc draw-text "こんにちはせかい" 5 10)

;; 保存
(send target save-file "hello.png" 'png)

Racketでコマンドライン引数のパース

Racketにはコマンドライン引数をパースするための機能が備わっているようです.
ためしに簡易catコマンドを作ってみます.

#lang racket

(define line-number? #f)

(define files
  (command-line
   #:program "cat"
   #:once-each
   (("-n" "--number") "show line number"
                      (set! line-number? #t))
   ;; 残りの引数.command-lineの戻り値になる.
   #:args args args))

(define output-lines
  (if line-number?
      (lambda (port)
        (define n 1)
        (for ((line (in-lines port)))
          (printf "~a\t:~a~%" n line)
          (set! n (+ 1 n))))
      (lambda (port)
        (for ((line (in-lines port)))
          (displayln line)))))

(if (null? files)
    (output-lines (current-input-port))
    (for ((f files))
      (call-with-input-file f output-lines)))

Racketに付属しているracoというツールを使って実行ファイルに変換します.

$ raco.exe exe cat.rkt

ソースファイルがcat.rktであるとすると、cat.exeという実行ファイルが作成されます(Windows)

cygwinでechoの出力をパイプすると以下のようになります.helpまで自動的に作ってくれるようです.

$ echo 'hoge
> fuga' | ./cat.exe
hoge
fuga

$ echo 'hoge
fuga' | ./cat.exe -n
1       :hoge
2       :fuga

$ ./cat.exe --help
cat [ <option> ... ] [<args>] ...
 where <option> is one of
  -n, --number : show line number
  --help, -h : Show this help
  -- : Do not treat any remaining argument as a switch (at this level)
 Multiple single-letter switches can be combined after one `-'; for
  example: `-h-' is the same as `-h --'

Racket(Scheme)でGUI

Racketでウィンドウを表示し、線を引いてみます.
"draw"ボタンをクリックするたびにランダムな色と位置で線が表示されます.

#lang racket

(require racket/gui/base
         srfi/27)

(define frame
  (new frame%
       [label "Example"]
       [width 300]
       [height 300]))
(define cvs (new canvas% [parent frame]))
(define pen-styles
  '(transparent solid xor hilite dot long-dash
                short-dash dot-dash xor-dot
                xor-long-dash xor-short-dash
                xor-dot-dash))
                
(define btn
  (new button% [parent frame]
       [label "draw"]
       [callback
        (lambda (b e)
          (let ((dc (send cvs get-dc)))
            (let-values (((x y) (send cvs get-virtual-size)))
              (send dc set-pen
                    (make-object color%
                                 (random-integer 255)
                                 (random-integer 255)
                                 (random-integer 255))
                    2
                    (list-ref pen-styles
                              (random-integer (length pen-styles))))
              (send dc draw-line
                    (random-integer x) (random-integer y)
                    (random-integer x) (random-integer y)))))]))

(send frame show #t)

Racket(Scheme)でWebサーバ+formlets

RacketでWebサーバ+formletsを使ってみます。
以下のコードで、ローカルホストの8000ポートでWebサーバが立ち上がります。

#lang racket
(require
  web-server/servlet
  web-server/servlet-env
  web-server/dispatch
  web-server/formlets)

(define-values (dispatcher _)
 (dispatch-rules
  [("input") show-input]
  [("output") show-output]
  [else show-default]))

(define form
 (formlet
  (div "input:" ,{=> input-string input})
  input))

(define (show-input req)
 (response/xexpr
  `(html
    (head (title "input"))
    (body (form ((action "output"))
                ,@(formlet-display form)
                (submit))))))

(define (show-output req)
 (let ((input (formlet-process form req)))
   (response/xexpr
    `(html
      (head (title "output"))
      (body (p "output : " ,input))))))

(define (show-default req)
 (response/xexpr
  `(html (head (title "default"))
         (body (p "default page")))))

(serve/dispatch dispatcher)

input-intフォームに数字以外の文字列を渡した場合に
contractで怒られるのを回避するにはどうすればよいのだろう。