<style>
/* basic design */
.reveal h1, .reveal h2, .reveal h3, .reveal h4, .reveal h5, .reveal h6,
.reveal section, .reveal table, .reveal li, .reveal blockquote, .reveal th, .reveal td, .reveal p {
font-family: 'Meiryo UI', 'Source Sans Pro', Helvetica, sans-serif, 'Helvetica Neue', 'Helvetica', 'Arial', 'Hiragino Sans', 'ヒラギノ角ゴシック', YuGothic, 'Yu Gothic';
text-align: left;
line-height: 1.6;
letter-spacing: normal;
text-shadow: none;
word-wrap: break-word;
color: #444;
}
.reveal h1, .reveal h2, .reveal h3, .reveal h4, .reveal h5, .reveal h6 {font-weight: bold;}
.reveal h1, .reveal h2, .reveal h3 {color: #00a474;}
.reveal th {background: #DDD;}
.reveal section img {background:none; border:none; box-shadow:none; max-width: 95%; max-height: 95%;}
.reveal blockquote {width: 90%; padding: 0.5vw 2.0vw;}
.reveal table {margin: 1.0vw auto;}
.reveal code {line-height: 1.2;}
.reveal p, .reveal li {padding: 0vw; margin: 0vw;}
.reveal .box {margin: -0.5vw 1.5vw 2.0vw -1.5vw; padding: 0.5vw 1.5vw 0.5vw 1.5vw; background: #e4ffe5; border-radius: 1.5vw;}
/* table design */
.reveal table {background: #f5f5f5;}
.reveal th {background: #444; color: #fff;}
.reveal td {position: relative; transition: all 300ms;}
.reveal tbody:hover td { color: transparent; text-shadow: 0 0 3px #aaa;}
.reveal tbody:hover tr:hover td {color: #444; text-shadow: 0 1px 0 #fff;}
/* blockquote design */
.reveal blockquote {
width: 90%;
padding: 0.5vw 0 0.2vw 6.0vw;
font-style: italic;
background: #ddffff;
}
.reveal blockquote:before{
position: absolute;
top: 0.1vw;
left: 1vw;
content: "\f10d";
font-family: FontAwesome;
color: #00a474;
font-size: 1.6vw;
}
/* font size */
.reveal h1 {font-size: 5.0vw;}
.reveal h2 {font-size: 4.0vw;}
.reveal h3 {font-size: 2.8vw;}
.reveal h4 {font-size: 2.6vw;}
.reveal h5 {font-size: 2.4vw;}
.reveal h6 {font-size: 2.2vw;}
.reveal section, .reveal table, .reveal li, .reveal blockquote, .reveal th, .reveal td, .reveal p {font-size: 2.2vw;}
.reveal code {font-size: 1.6vw;}
/* new color */
.red {color: #EE6557;}
.blue {color: #16A6B6;}
/* split slide */
#right {left: -18.33%; text-align: left; float: left; width: 50%; z-index: -10;}
#left {left: 31.25%; text-align: left; float: left; width: 50%; z-index: -10;}
</style>
<style>
/* 背景デザイン */
.reveal {
background-color:/*背景色*/
#f8f8ff;
}
.reveal h1 {padding: 3.0vw 0vw;}
@media screen and (max-width: 1024px) {
.reveal h2 {margin: -2.0vw 0 0 0; padding: 0.0vw 0vw 3.0vw 2.0vw; }
}
@media screen and (min-width: 1025px) and (max-width: 1920px) {
.reveal h2 {margin: -1.5vw 0 0 0; padding: 0.0vw 0vw 3.0vw 2.0vw; }
}
@media screen and (min-width: 1921px) and (max-width: 100000px) {
.reveal h2 {margin: -1.0vw 0 0 0; padding: 0.0vw 0vw 3.0vw 2.0vw; }
}
</style>
<style>
/* specific design */
.reveal h2 {
padding: 0 1.5vw;
margin: 0.0vw 0 2.0vw -2.0vw;
border-left: solid 1.2vw #00a474;
border-bottom: solid 0.8vw #9e9e9e;
}
</style>
<!-- --------------------------------------------------------------------------------------- -->
#### 卒業研究
<br>
# sintax-parseの効率化
<br>
<br>
#### 2021/12/10~
### @ariken
---
[TOC]
* [datum->syntax](/z3PdlUX3Q8CfTzGvzJcKfg?view#datum-gtsyntax)
## 完成形目標
```Racket
(syntax-parse stx
[(foo x)
#:do [(define result
(if (syntax-property #'x 'class)
(if (x のプロパティが myid である);キャッシュ
'success1， #f)
(if (x がクラス myid を持っている);実際
'success2， #f)))]
#:when result
(cond
((eq? result 'success1) パターンマッチ)
((eq? result 'success2) 'myid を付与後にパターンマッチ))
]
[(foo y) #''y])
```
5行目〜６行目追加
```racket
(syntax-parse stx
[(foo x)
#:do [(define result
(if (syntax-property #'x 'class)
(if (symbol=?
(syntax-property #'x 'class) 'myid)
'success1 #f) ;x のプロパティが myid である
(if (x がクラス myid を持っている)
'success2， #f)))];
;ifではなく、(define-syntax (bar stx)
;(syntax-parse stx
;[(_ x:myid)
;#:with y:myid #’x
;#’’y]))
;このように書いてエラーを抽出して、
;エラーをキャッチして、success2を返すように動かす。
#:when result
(cond
((eq? result 'success1) パターンマッチ)
((eq? result 'success2) 'myid を付与後パターンマッチ))
]
[(foo y) #''y])
```
とりあえず実行できるか確認
```racket
(define-syntax (foo stx)
(syntax-parse stx
[(foo x)
#:do [(define result
(if (syntax-property #'x 'class)
(if (symbol=?
(syntax-property #'x 'class) 'myid)
'success1 #f) #f))]
#:when result
(cond
((eq? result 'success1) 12)
((eq? result 'success2) 34))
]
[(foo y) #''y]))
```
```
> symbol=?: reference to an unbound identifier
at phase: 1; the transformer environment
context...:
matching binding...:
common scopes...: in: symbol=?
```
8~9行目の
`(symbol=? (syntax-property #'x 'class) 'myid)`
のコードで`#f`と`'myid`でbooleanとsymbolで比較しているのが原因。
###### tags: booleanとsymbol比較
1. `#f`をsymbol型に変換する
2. `symbol=?`とは別の実装方法を考える
1の方法で改善するためのメモ
```racket
> (define stx #'x)
> (symbol=? (syntax-property stx 'class) 'myid)
. . symbol=?: contract violation
expected: symbol?
given: #f
argument position: 1st
other arguments...:
> (syntax-property stx 'class)
#f
> (define stx-s (syntax-property stx 'class 'myid))
> (syntax-property stx 'class)
#f
> (syntax-property stx-s 'class)
'myid
> (symbol=? (syntax-property stx-s 'class) 'myid)
#t
```
`#t`のときはうまく動作
`#f`のときはエラー
```racket
(symbol=?
(if
(boolean=?
(syntax-property stx 'class) ;#f
#f)
'ok
((syntax-property stx 'class))
)
'myid)
```
```racket
> (symbol=? (if (boolean=? (syntax-property stx 'class) #f) 'ok ((syntax-property stx 'class))) 'myid)
#f
> (symbol=? (if (boolean=? (syntax-property stx-s 'class) #f) 'ok ((syntax-property stx 'class))) 'myid)
. . boolean=?: contract violation
expected: boolean?
given: 'myid
argument position: 1st
other arguments...:
```
今度はstxが`#f`のときはうまく動作するが、`symbol`のときはエラー...
`(boolean=? (syntax-property stx-s 'class) #f)`
が`symbol`と`boolean`の比較をしているから。振り出しに戻った...
###### tag [booleanとsymbol比較](#tags-boolean%E3%81%A8symbol%E6%AF%94%E8%BC%83)
* ### `eq?`で解決しました........😭
```racket
(define-syntax (foo stx)
(syntax-parse stx
[(foo x)
#:do [(define result
(if (syntax-property #'x 'class)
(if (eq?
(syntax-property #'x 'class) 'myid)
'success1 #f) ;x のプロパティが myid である
#f))]
#:when result
(cond
((eq? result 'success1) 12)
((eq? result 'success2) 34))
]
[(foo y) #''y]))
```
```racket
#lang racket
(require syntax/parse)
(require syntax/parse/debug)
(require (for-syntax syntax/parse))
(define-syntax (foo stx)
(define-syntax-class myid
#:description "myid"
(pattern (x:myid))
(pattern (x:id))
(pattern (x:number))
(pattern (x:keyword)))
(syntax-parse stx
[(_ x)
#:do [(define result
(if
(eq? (syntax-property #'x 'class) 'myid) ;条件
'success1 ;x のプロパティが myid である (#t)
(syntax-parse #'x ;x のプロパティが myid でない (#f)
[x ;ため、x のクラスが myid か確認する
#:with y #'x
#:declare y id
'success2])))] ;x のクラスが myid である (#f)
#:when result
(cond
((eq? result 'success1) (println 'ok1))
((eq? result 'success2) (println 'ok2)))
]
[(_ y) #'y]))
```
---
## 研究本文
---
## 進捗管理
> [time=Fri, Jan 21, 2022 10:00 AM]
::: info
目標：現在実装中の`fast-syntax-parse`が完成すること。
完成後に性能評価もできれば◎
:::
* 現時点のプログラム
```Racket=
#lang racket
(require syntax/parse)
(require syntax/parse/debug)
(require (for-syntax syntax/parse))
(define-syntax (fast-syntax-parse stx)
(syntax-parse stx
[(_ target [pattern body])
#'(syntax-parse target
[(_ x);なんとか:myidを取り除く、かつ名前をつけて覚えておく
;(string-contains? x ":myid")
#:do [(define result
(if (eq? (syntax-property #'x 'class) 'myid)
'success1
(syntax-parse #'x
[x
#:declare x myid
'success2])))]
#:when result
(cond
((eq? result 'success1) #'(body))
((eq? result 'success2)
(with-syntax ([x2 #'(syntax-property #'x 'class 'myid)]) ;'myidを付与
#'(new_body);x2 を渡した new_body
)))
])
]))
```
----
## 改善箇所
* 11行目の:myidを取り除き、名前をつけて記録するところ
* 26~27行目の'myidを付与した後にbodyを実行する部分
### 改善方法
1. 11行目，xはstringではなく構文オブジェクトなのでstring-contains?をそのように呼び出すことはできないですね．
識別子(シンボルがsyntax-eであるような構文オブジェクト)を受け取り，そのシンボルの文字列表現中に文字「:」があるなら「:」以降の文字列をシンボルにしたものを返す，「:」がなければ#fを返す，という関数をまず定義してみてはどうでしょうか？
2. 26行目，27行目の方は，bodyの中のxをx2に全部置き換える必要があるので，
(define (substitute body old-id new-id) …)
という関数を定義してはどうでしょう？
bodyは任意のリストがsyntax-eであるような構文オブジェクト
old-id と new-id はシンボルがsyntax-eであるような構文オブジェクト(つまり識別子)
たとえば，body が #’(+ x y) のとき，(substitute body #’x #‘x2) と呼び出せば，#’(+ x2 y) を返す関数です．
----
### 改善
1.
```racket=
(define (colon-exist? target)
(if (string-contains?
(syntax->datum target)
;3行目でlist->stringを使って文字列化したい
;例(list->string (list #\A #\p #\p #\l #\e)) -> "Apple"
":");この時に「:」が何文字目にあるかを記憶しておく(n)
;#tのとき、「:」以降の文字列をシンボルにしたものを返す
;(substring "Apple" 1) -> "pple"が役立ちそう
;#f))
```
```racket
(define (colon-exist? target)
(if (string-contains? target ":")
(substring target 1)
#f))
```
```racket
(define (colon-exist? target)
(if (string-contains? (expr->string target) ":")
(substring (expr->string target) 2)
#f))
(define X #'(define y:myid 5))
(map (lambda (ex)
(colon-exist? ex))
(syntax->datum X))
'(#f "myid" #f)
```
```racket
(define (colon-srch str n)
(if (string-prefix? str ":")
n
(colon-srch (substring str 1) (+ n 1))))
;(colon-srch b 1) -> 2
;"y:myid"の中から「:」が何文字目に存在するか?
(define (colon-tail-cut target)
(if (string-contains? (expr->string target) ":")
(string->symbol (substring (expr->string target)
(colon-srch (expr->string target) 1)))
#f))
```
2.
```racket
(define (substitute body old-id new-id)
(if (member old-id (syntax->datum body))
#t(old-idをnew-idに書き換える)
;無理そうならnew-bodyを新しく定義する
#f(なかったら特に何もしない)))
```
```racket
(define a #'(+ x y))
(map (lambda (ex)
(if (eq? ex 'x) 'x2 ex))
(syntax->datum a))
'(+ x2 y)
(define (substitute body old-id new-id)
(map (lambda (ex)
(if (eq? ex (syntax->datum old-id))
(syntax->datum new-id)
ex))
(syntax->datum body)))
```
---
## 完成（仮）
```racket=
#lang racket
(require syntax/parse)
(require syntax/parse/debug)
(require mzlib/string) ; expr->string に必要
(require (for-syntax syntax/parse))
; (colon-srch "y:myid" 1) -> 2
; "y:myid" の中から 「:」 が何文字目に存在するか?
(define (colon-srch str n)
(if (string-prefix? str ":")
n
(colon-srch (substring str 1) (+ n 1))))
; (colon-tail-cut 'average:number) -> 'number'
; (colon-tail-cut 'fast-syntax-parse) -> #f
; この関数に渡したときに 「:」 が存在すれば後ろの部分をカットして symbol 型で返す.
(define (colon-tail-cut target)
(if (string-contains? (expr->string target) ":")
(string->symbol (substring (expr->string target)
(colon-srch (expr->string target) 1)))
#f))
; body が #’(+ x y) のとき，
; (substitute body #’x #‘x2) と呼び出せば，
; #’(+ x2 y) を返す関数
(define (substitute body old-id new-id)
(map (lambda (ex)
(if (eq? ex (syntax->datum old-id))
(syntax->datum new-id)
ex))
(syntax->datum body)))
(define-syntax (fast-syntax-parse stx)
(syntax-parse stx
[(_ target [pattern body])
#'(syntax-parse target
[(_ x)
#:do [(define myid (car (filter symbol? (map (lambda (ex)
(colon-tail-cut ex))
(syntax->datum x)))))
(define result
(if (eq? (syntax-property #'x 'class) myid)
'success1
(syntax-parse #'x
[x
#:declare x myid
'success2])))]
#:when result
(cond
((eq? result 'success1) body)
((eq? result 'success2)
(with-syntax ([x2 #'(syntax-property #'x 'class myid)]) ;'myidを付与
(datum->syntax #'lex
(substitute body #'x #'x2); new_body
#'srcloc))))
])
]))
```
---
## syntax-property
```racket
(syntax-property stx key v [preserved?]) → syntax?
stx : syntax?
key : (if preserved? (and/c symbol? symbol-interned?) any/c)
v : any/c
preserved? : any/c = (eq? key 'paren-shape)
(syntax-property stx key) → any
stx : syntax?
key : any/c
```
3 つまたは 4 つの引数を持つ形式は、任意のプロパティ値 v をキー key に関連付けることで stx を拡張します。その結果、関連付けされた新しいシンタックス オブジェクトが生成されます (stx 自体は変更されません)。プロパティは preserved? が真の場合は preserved として追加されます。この場合、key はインターネッドされたシンボルでなければならず、v はマーシャルされたバイトコードに保存できる後述の値でなければなりません。
2つの引数を持つ形式は、stxにkeyに関連付けられた任意のプロパティ値を返し、keyに関連付けられた値がstxにない場合は#fを返します。stx が汚染されている場合は、結果の値を持つシンタックス オブジェクトも汚染されています。
バイトコードへのマーシャリングをサポートするために、保存された構文プロパティの値は、次のいずれかの非循環値でなければなりません。
* 許可された保存されたプロパティの値を含むペア。
* 許可された保存されたプロパティ値を含むベクトル（不変的にマーシャルされていない）。
* 許可された保存されたプロパティ値を含むボックス（unmarshaled as immutable）。
* 許可された保存されたプロパティの値を含む不変のプレハブ構造
* 許可されたプリザーブドプロパティ値を持つキーと値を持つ不変のハッシュテーブル
* シンタックスオブジェクト、または
* 空のリスト、記号、数値、文字、文字列、バイト文字列、または正規表現のいずれかの値。
保存されたプロパティに他の値があると、所有するシンタックスオブジェクトをバイトコード形式にマーシャリングしようとしたときに例外が発生します。
## メモ
```racket
(define stx #'x)
(define stx2 (syntax-property stx 'class 123))
(syntax-property stx2 'class)
123
```
```racket
> (syntax-property stx 'class)
#f
> (syntax-property stx2 'class)
123
> (syntax-property stx2 'myid 234)
.#<syntax:3-unsaved-editor:14:14 x>
> (syntax-property stx2 'myid)
#f
> (syntax-property stx2 'class 234)
.#<syntax:3-unsaved-editor:14:14 x>
> (syntax-property stx2 'class)
123
> (define stx3 (syntax-property stx2 'class2 234))
> (syntax-property stx3 'class)
123
> (syntax-property stx3 'class2)
234
> (syntax-property stx2 'class)
123
> (syntax-property stx2 'class2)
#f
> (syntax-property stx2 'class2 345)
.#<syntax:3-unsaved-editor:14:14 x>
> (define stx2 (syntax-property stx2 'class2 345))
define-values: assignment disallowed;
cannot re-define a constant
constant: stx2
in module:'anonymous-module
(if (= (syntax-property stx2 'class) 123)
(display "OK")
(display "NG"))
OK
> (syntax-property stx 'class)
#f
> (syntax-property stx2 'class)
123
> (define stx-myid (syntax-property stx 'class 'myid))
> (syntax-property stx-myid 'class)
'myid
> (if (symbol=? (syntax-property stx-myid 'class) 'myid) 'success #f)
'success
> (syntax-parse #'(1 2 3)
[(a b c)
#:with rev #'(c b a)
#'rev])
#<syntax:eval:15:0 (3 2 1)>
```
---
{"metaMigratedAt":"2023-06-16T16:02:53.987Z","metaMigratedFrom":"YAML","title":"研究","breaks":true,"slideOptions":"{\"theme\":\"white\",\"controls\":true,\"progress\":true,\"slideNumber\":\"c/t\",\"center\":false,\"fragments\":true,\"help\":true,\"transition\":\"convex\",\"transitionSpeed\":\"default\",\"keyboard\":true,\"width\":\"93%\",\"height\":\"100%\",\"previewLinks\":false,\"spotlight\":{\"enabled\":false}}","contributors":"[{\"id\":\"a0de3d6a-cf71-4961-a3bb-e324e7c21a77\",\"add\":23797,\"del\":11474}]"}