EoPL 読んでた記録の確認とその記録 (4)
標題をいい加減何とかしないと、と思いつつ。
とりあえず、
- abstract syntax の定義
- parse-expression の定義
- unparse-expression の定義
を作ってみます。
実装でっちあげてみました
とりあえず、ということで。元気が残ってれば試験も書きます。
abstract syntax の定義 (lexical-address.scm)
(define-datatype lexical-address lexical-address? (lit-exp (datum number?)) (lex-info (id symbol?) (depth number?) (position number?)) (free-info (id symbol?)) (if-exp (test-exp lexical-address?) (true-exp lexical-address?) (false-exp lexical-address?)) (lambda-exp (id symbol?) (body lexical-address?)) (app-exp (rator lexical-address?) (rand lexical-address?)))
parse-expression の定義 (parse-expression.scm)
(define get-position
(lambda (sym l)
(let inner ((sym sym) (l l) (p 0))
(cond
((null? l) #f)
((eqv? sym (car l)) p)
(else
(inner sym (cdr l) (+ 1 p)))))))
(define get-lexical-address
(lambda (symbol dict)
(let inner ((symbol symbol) (dict dict) (d 0) (p 0))
(if (null? dict)
(free-info symbol)
(let ((pos (get-position symbol (car dict))))
(if (eqv? pos #f)
(inner symbol (cdr dict) (+ 1 d) 0)
(lex-info symbol d pos)))))))
(define parse-expression
(lambda (datum)
(let inner ((datum datum) (dict '()))
(cond
((number? datum) (lit-exp datum))
((symbol? datum) (get-lexical-address datum dict))
((pair? datum)
(cond
((eqv? (car datum) 'lambda)
(lambda-exp (cadr datum)
(inner (caddr datum) (cons (cadr datum) dict))))
((eqv? (car datum) 'if)
(if-exp (inner (car datum) dict)
(inner (cadr datum) dict)
(inner (caddr datum) dict)))
(else
(app-exp
(inner (car datum) dict)
(inner (cadr datum) dict)))))
(else
(eopl:error 'parse-expression
"Invalid concrete syntax ~s" datum))))))unparse-expression の定義 (unparse-expression.scm)
(define unparse-expression
(lambda (exp)
(cases lexical-address exp
(lit-exp (datum) datum)
(lex-info (id depth position) id)
(free-info (id) id)
(lambda-exp (id body)
(list 'lambda (list id)
(unparse-expression body)))
(if-exp (test-exp true-exp false)
(list 'if (unparse-expression test-exp)
(unparse-expression true-exp)
(unparse-expression false-exp)))
(app-exp (rator rand)
(list (unparse-expression rator)
(unparse-expression rand))))))試験作成に着手。とりあえず parse-expression からなのかな。
順に検討しつつ実装
してみることに。parse-expression の試験から。とりあえず上記の定義で
(test* "lambda expression"
'(lambda-exp (x) 1)
(parse-expression '(lambda (x) 1)))な試験にパスしてません。
test lambda expression, expects (lambda-exp (x) 1) ==> ERROR: GOT #<<error> "lambda-exp \"~n Bad ~a field (~s ~s) ==> #f.\" id symbol? (x)">
と思ったら色々ボケてて lexical-address.scm の lambda-exp な定義は以下で
(lambda-exp (args list?) (body lexical-address?))
lambda-expression な試験は以下ですね。
(test* "lambda expression"
'(lambda-exp (x) (lit-exp 1))
(parse-expression '(lambda (x) 1)))とりあえず現時点で試験パス。
その後
云々してて現状以下なカンジです。
(define get-position
(lambda (sym l)
(let inner ((sym sym) (l l) (p 0))
(cond
((null? l) #f)
((eqv? sym (car l)) p)
(else
(inner sym (cdr l) (+ 1 p)))))))
(define get-lexical-address
(lambda (symbol dict)
(let inner ((symbol symbol) (dict dict) (d 0) (p 0))
(if (null? dict)
(free-info symbol)
(let ((pos (get-position symbol (car dict))))
(if (eqv? pos #f)
(inner symbol (cdr dict) (+ 1 d) 0)
(lex-info symbol d pos)))))))
(define parse-expression
(lambda (datum)
(let inner ((datum datum) (dict '()))
(cond
((null? datum) '())
((number? datum) (lit-exp datum))
((symbol? datum) (get-lexical-address datum dict))
((pair? datum)
(cond
((eqv? (car datum) 'lambda)
(lambda-exp (cadr datum)
(inner (caddr datum) (cons (cadr datum) dict))))
((eqv? (car datum) 'if)
(if-exp (inner (cadr datum) dict)
(inner (caddr datum) dict)
(inner (cadddr datum) dict)))
(else
(app-exp
(inner (car datum) dict)
(if (null? (cddr datum))
(inner (cadr datum) dict)
(inner (cddr datum) dict))))))
(else
(eopl:error 'parse-expression
"Invalid concrete syntax ~s" datum))))))試験が以下。
(use gauche.test)
(add-load-path ".")
(load "parse-expression")
(test-start "parse-expression")
(test-section "parse-expression")
(test* "number?"
'(lit-exp 5)
(parse-expression 5))
(test* "free-var"
'(free-info x)
(parse-expression 'x))
(test* "lambda expression"
'(lambda-exp (x) (lit-exp 1))
(parse-expression '(lambda (x) 1)))
(test* "if expression"
'(if-exp (app-exp (free-info null?) (free-info l)) (lit-exp 1) (lit-exp 2))
(parse-expression '(if (null? l) 1 2)))
(test-end)上記はパスしてるのですが以下が駄目。
(test* "if expression more"
'(if-exp (app-exp (free-info =) (free-info x) (lit-exp 1))
(free-info x)
(lit-exp 1))
(parse-expression '(if (= x 1) x 1)))もう少し頑張ってみようと思いますが今日はもう限界かも。以下なあたりがアレ。
(else (app-exp (inner (car datum) dict) (if (null? (cddr datum)) (inner (cadr datum) dict) (inner (cddr datum) dict))))))
来週も稼動空きがあるんですが大丈夫なのかorz
