suzanne.soy/2010-m1s1-compilation
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Ajout de push-functions

Browse Source
This commit is contained in:
Bertrand BRUN 2010-11-15 14:42:36 +01:00
parent 3bb7a28fb6
commit 9624497290
1 changed files with 8 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
implementation/mini-meval.lisp
View File

@ -42,7 +42,7 @@
(reject (error "slice-up-lambda-list : ~w ne peut être ici." last-element)))) (reject (error "slice-up-lambda-list : ~w ne peut être ici." last-element))))
;; Exemples : ;; Exemples :
;; (slice-up-lambda-list '(a b &optional u &rest c &key ((:foo bar)) :quux (:baz 'glop) &aux x)) ;; (slice-up-lambda-list '(a b &optional u &rest c &key ((:foo bar)) :quux (:baz 'glop) &aux (x 1) (y (+ x 2))))
;; (slice-up-lambda-list '(a b &rest)) ;; (slice-up-lambda-list '(a b &rest))
;; (slice-up-lambda-list '(a b)) ;; (slice-up-lambda-list '(a b))
@ -65,7 +65,7 @@
(mini-meval-params (cdr params) global new-local-2 nil (cdr optional) rest key other aux)) (mini-meval-params (cdr params) global new-local-2 nil (cdr optional) rest key other aux))
(if rest (if rest
(mini-meval-params params global (acons `(,(car rest) . variable) params local) nil nil nil key other aux) (mini-meval-params params global (acons `(,(car rest) . variable) params local) nil nil nil key other aux)
;; TODO : finir d'implémenter &key &allow-other-keys &aux (et relire CLTL). ;; TODO : finir d'implémenter &key &allow-other-keys &aux &rest (et relire CLTL).
local)))) local))))
; (if key ; (if key
; (let* ((keyword (first (car key))) ; (let* ((keyword (first (car key)))
@ -239,6 +239,12 @@ Mini-meval sera appellé sur des morceaux spécifiques du fichier source. Il fau
(() (()
nil))) nil)))
(defun push-functions (etat-global functions)
(cons nil (mapcar-append (cdr etat-global) (lambda (x) `((,x . function) . ,(fdefinition x))) functions)))
(defmacro etat-global-fn (&rest functions)
`(push-functions '(nil) ',functions))
(load "test-unitaire") (load "test-unitaire")
(erase-tests mini-meval) (erase-tests mini-meval)