Lisp commun, 560 octets
"Enfin, j'ai trouvé une utilisation pour PROGV."
(macrolet((w(S Z G #1=&optional(J Z))`(if(symbolp,S),Z(destructuring-bind(a b #1#c),S(if(eq a'L),G,J)))))(labels((r(S #1#(N 97))(w S(symbol-value s)(let((v(make-symbol(coerce`(,(code-char N))'string))))(progv`(,b,v)`(,v,v)`(L,v,(r c(1+ n)))))(let((F(r a N))(U(r b N)))(w F`(,F,U)(progv`(,b)`(,U)(r c N))))))(p()(do((c()(read-char()()#\)))q u)((eql c #\))u)(setf q(case c(#\S'(L x(L y(L z((x z)(y z))))))(#\K'(L x(L u x)))(#\I'(L a a))(#\((p)))u(if u`(,u,q)q))))(o(S)(w S(symbol-name S)(#2=format()"~A.~A"b(o c))(#2#()"~A(~A)"(o a)(o b)))))(lambda()(o(r(p))))))
Non golfé
;; Bind S, K and I symbols to their lambda-calculus equivalent.
;;
;; L means lambda, and thus:
;;
;; - (L x S) is variable binding, i.e. "x.S"
;; - (F x) is function application
(define-symbol-macro S '(L x (L y (L z ((x z) (y z))))))
(define-symbol-macro K '(L x (L u x)))
(define-symbol-macro I '(L x x))
;; helper macro: used twice in R and once in O
(defmacro w (S sf lf &optional(af sf))
`(if (symbolp ,S) ,sf
(destructuring-bind(a b &optional c) ,S
(if (eq a 'L)
,lf
,af))))
;; R : beta-reduction
(defun r (S &optional (N 97))
(w S
(symbol-value s)
(let ((v(make-symbol(make-string 1 :initial-element(code-char N)))))
(progv`(,b,v)`(,v,v)
`(L ,v ,(r c (1+ n)))))
(let ((F (r a N))
(U (r b N)))
(w F`(,F,U)(progv`(,b)`(,U)(r c N))))))
;; P : parse from stream to lambda tree
(defun p (&optional (stream *standard-output*))
(loop for c = (read-char stream nil #\))
until (eql c #\))
for q = (case c (#\S S) (#\K K) (#\I I) (#\( (p stream)))
for u = q then `(,u ,q)
finally (return u)))
;; O : output lambda forms as strings
(defun o (S)
(w S
(princ-to-string S)
(format nil "~A.~A" b (o c))
(format nil (w b "(~A~A)" "(~A(~A))") (o a) (o b))))
Réduction bêta
Les variables sont liées dynamiquement pendant la réduction avec PROGVde nouveaux symboles Common Lisp, en utilisant MAKE-SYMBOL. Cela permet d'éviter les collisions de noms (par exemple, l'observation indésirable des variables liées). J'aurais pu utiliser GENSYM, mais nous voulons avoir des noms conviviaux pour les symboles. C'est pourquoi les symboles sont nommés avec les lettres de aà z(comme le permet la question). Nreprésente le code de caractère de la prochaine lettre disponible dans la portée actuelle et commence par 97, alias a.
Voici une version plus lisible de R(sans la Wmacro):
(defun beta-reduce (S &optional (N 97))
(if (symbolp s)
(symbol-value s)
(if (eq (car s) 'L)
;; lambda
(let ((v (make-symbol (make-string 1 :initial-element (code-char N)))))
(progv (list (second s) v)(list v v)
`(L ,v ,(beta-reduce (third s) (1+ n)))))
(let ((fn (beta-reduce (first s) N))
(arg (beta-reduce (second s) N)))
(if (and(consp fn)(eq'L(car fn)))
(progv (list (second fn)) (list arg)
(beta-reduce (third fn) N))
`(,fn ,arg))))))
Résultats intermédiaires
Analyse de la chaîne:
CL-USER> (p (make-string-input-stream "K(K(K(KK)))"))
((L X (L U X)) ((L X (L U X)) ((L X (L U X)) ((L X (L U X)) (L X (L U X))))))
Réduire:
CL-USER> (r *)
(L #:|a| (L #:|a| (L #:|a| (L #:|a| (L #:|a| (L #:|b| #:|a|))))))
(Voir trace d'exécution)
Jolie impression:
CL-USER> (o *)
"a.a.a.a.a.b.a"
Les tests
Je réutilise la même suite de tests que la réponse Python:
Input Output Python output (for comparison)
1. KSK a.b.c.a(c)(b(c)) a.b.c.a(c)(b(c))
2. SII a.a(a) a.a(a)
3. S(K(SI))K a.b.b(a) a.b.b(a)
4. S(S(KS)K)I a.b.a(a(b)) a.b.a(a(b))
5. S(S(KS)K)(S(S(KS)K)I) a.b.a(a(a(b))) a.b.a(a(a(b)))
6. K(K(K(KK))) a.a.a.a.a.b.a a.b.c.d.e.f.e
7. SII(SII) ERROR ERROR
Le 8ème exemple de test est trop grand pour le tableau ci-dessus:
8. SS(SS)(SS)
CL a.b.a(b)(c.b(c)(a(b)(c)))(a(b.a(b)(c.b(c)(a(b)(c))))(b))
Python a.b.a(b)(c.b(c)(a(b)(c)))(a(d.a(d)(e.d(e)(a(d)(e))))(b))
- EDIT J'ai mis à jour ma réponse afin d'avoir le même comportement de regroupement que dans la réponse d'Aditsu , car cela coûte moins d'octets à écrire.
- La différence restante peut être vu pour les tests 6 et 8. Le résultat
a.a.a.a.a.b.aest correct et ne pas utiliser autant de lettres que la réponse Python, où les liaisons à a, b, cet dne sont pas référencés.
Performance
Faire une boucle sur les 7 tests réussis ci-dessus et collecter les résultats est immédiat (sortie SBCL):
Evaluation took:
0.000 seconds of real time
0.000000 seconds of total run time (0.000000 user, 0.000000 system)
100.00% CPU
310,837 processor cycles
129,792 bytes consed
Faire le même test une centaine de fois conduit à ... "Thread local storage exhausted" sur SBCL, en raison d'une limitation connue concernant les variables spéciales. Avec CCL, appeler la même suite de tests 10000 fois prend 3,33 secondes.