α置換
Posted feedbacks - Scheme
一番外側の変数 = グローバル変数と解釈して書きました。 R5RS の範囲内の構文は網羅しています。入力は一行に置換対象の識別子と置換後の識別子を空白で区切って与えます。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 | (use srfi-1)
(use gauche.collection)
(use util.match)
(define (alpha-replace sexp maps)
(define (remove-map k ms)
(remove-first (lambda (p) (eq? k (car p))) ms))
(define (remove-maps ks ms)
(fold remove-map ms ks))
(define (remove-first pred? xs)
(let loop ((ys xs)
(zs '()))
(cond ((null? ys)
(reverse! zs))
((pred? (car ys))
(append-reverse! zs (cdr ys)))
(else
(loop (cdr ys) (cons (car ys) zs))))))
(define (replace-symbol key maps)
(cond ((assq sexp maps) => cdr)
(else key)))
(define (replace-qq exp level maps)
(match exp
([? symbol? exp]
(if (zero? level)
(alpha-replace exp maps)
exp))
([? vector?]
(map-to <vector> (cut replace-qq <> level maps) exp))
(('quasiquote x)
(replace-qq x (+ level 1) maps))
(([and [or 'unquote 'unquote-splicing] uquote] x)
(list uquote (replace-qq x (- level 1) maps)))
((x . y)
(cons (replace-qq x level maps)
(replace-qq y level maps)))
(_ exp)))
(define (improper-list->list xs)
(let loop ((ys xs)
(rs '()))
(cond ((null? ys) (reverse rs))
((pair? ys) (cons (car ys) rs))
(else (reverse (cons ys rs))))))
(define (take-internal-define-syms sexps)
(map (lambda (exp)
(if (pair? exp)
(caadr exp)
(cadr exp)))
(take-while (lambda (exp)
(and (pair? exp)
(or (eq? (car exp) 'define)
(eq? (car exp) 'define-syntax))))
sexps)))
(match sexp
([? symbol?] (replace-symbol sexp maps))
([not [? pair?]] sexp)
(('quote exp) sexp)
(('quasiquote exp)
(list 'quasiquote (replace-qq exp 1 maps)))
(('case key clauses)
`(case ,(alpha-replace key maps)
,@(map (lambda (c)
`(,(car c) ,@(map (cut alpha-replace <> maps) (cdr c))))
clauses)))
(('define name val)
`(define ,(replace-symbol name maps)
,(alpha-replace val maps)))
(('define (name args ...) body ...)
(let ((maps* (remove-maps (take-internal-define-syms body)
(remove-maps (improper-list->list args) maps))))
`(define (,(replace-symbol name maps) ,@args)
,@(alpha-replace body maps*))))
(('do step test body)
(let ((maps* (remove-maps (map car step) maps)))
`(do ,(map (lambda (c)
`(,(first c)
,(alpha-replace (second c) maps*)
,@(if (null? (cddr c))
'()
(list (alpha-replace (third c) maps*))))))
,(alpha-replace step maps*)
,(alpha-replace test maps*)
,(alpha-replace body maps*))))
(('lambda args body ...)
(let ((maps* (remove-maps (take-internal-define-syms body)
(remove-maps (improper-list->list args) maps))))
`(lambda ,arg
,@(alpha-replace body maps*))))
(('let [? symbol? name] binds body)
(let ((maps* (remove-maps (take-internal-define-syms body)
(remove-maps (map car binds) maps))))
`(let ,name (map (lambda (c)
`(,(car c) ,(alpha-replace (cadr c) maps)))
binds)
,@(alpha-replace body maps*))))
(([or 'let 'let-syntax] binds body ...)
(let ((maps* (remove-maps (take-internal-define-syms body)
(remove-maps (map car binds) maps))))
`(let ,(map (lambda (c)
`(,(car c) ,(alpha-replace (cadr c) maps)))
binds)
,@(alpha-replace body maps*))))
(('let* binds body ...)
(receive (cs maps*) (map-accum
(lambda (c knil)
(values `(,(car c) ,(alpha-replace (cadr c) knil))
(remove-map (car c) knil)))
maps
binds)
(let ((maps** (remove-maps (take-internal-define-syms body)
maps*)))
`(let* ,cs
,@(alpha-replace body maps**)))))
(([or 'letrec 'letrec-syntax] binds body)
(let* ((maps* (remove-maps (map car binds) maps))
(maps** (remove-maps (take-internal-define-syms body) maps*)))
`(letrec ,(map (lambda (c)
`(,(car c) ,(cadr (alpha-replace (cadr c) maps*))))
binds)
,@(alpha-replace body maps**))))
(('syntax-rules keys clauses)
`(syntax-rules ,keys
(map (lambda (c)
`(,(car c)
(,(alpha-replace (caadr c) maps) ,@(cdadr c))))
clauses)))
((x . y)
(cons (alpha-replace x maps)
(alpha-replace y maps)))))
(define (read-maps iport)
(port-map (lambda (line)
(let ((ts (map string->symbol (string-split line #[\s]))))
(cons (car ts) (cadr ts))))
(cut read-line iport)))
(define (main args)
(let ((maps (read-maps (standard-input-port))))
(call-with-input-file (cadr args)
(lambda (iport)
(port-for-each
(lambda (sexp)
(write (alpha-replace sexp maps)))
(cut read iport))))
0))
|
gandalf #6153() Rating-2/6=-0.33
標準入力から与えられたソースコードの変数名 を置換するプログラムを作ってください。 最近はリファクタリングツールなどの普及でこ のような需要は少ないかと思われますが、viな ど貧弱なエディタを使っているときに困る のが変数名の置換です。さすがに以下の例のよ うなプログラムは例としてしか書きませんが、 置換しようとしている変数名と同じ綴りの他の ものがプログラム中に出てくることはまれにあ ります。そこで、与えられたソースコードに現 れる変数だけを指定された名前に置換してくだ さい。 置換対象となるソースコードと使用言語は同じ ものを使ってください。与えられるソースコー ドは、完全なコンパイル単位、もしくはパース して意味が通る範囲のものどちらであってもか まいません。後者の場合、一番外側の変数だけ 置換できるようにしてください。 C言語での解答例をつけたかったのですが、と ても難しかったためまだ作成できていません。 ご容赦ください。 例 $ cat a.c /* a */ int foo() { struct a {int a;} a; #if FOO a.a = 1; #endif { int a; } return 0; } $ alpha -DFOO=1 b a < a.c /* a */ int foo() { struct a {int a;} b; #if FOO b.a = 1; #endif { int a; } return 0; }[ reply ]