From e66a97901a71cec454b5d7e5bbbb3edf101f1e05 Mon Sep 17 00:00:00 2001 From: SliTaz User Date: Tue, 26 Oct 2010 20:55:07 +0200 Subject: [PATCH] =?UTF-8?q?Impl=C3=A9mentation=20de=20certaines=20fonction?= =?UTF-8?q?s=20/=20macros=20de=20LISP.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- TODO-Liste | 19 +++++- implementation-fonctions.lisp | 120 ++++++++++++++++++++++++++++++++++ 2 files changed, 138 insertions(+), 1 deletion(-) create mode 100644 implementation-fonctions.lisp diff --git a/TODO-Liste b/TODO-Liste index 3399acc..ea7535e 100644 --- a/TODO-Liste +++ b/TODO-Liste @@ -1,4 +1,21 @@ TODO : - Ajouter la fonction map-case-analysis - Changer les par les fonctions warn (warning ?) ou error selon le cas d'utilisation. -- Remplacer les ";; cas machin" par le code effectif. \ No newline at end of file +- Remplacer les ";; cas machin" par le code effectif. + + +Questions : +- Le prof a dit qu'on ne devait pas gérer le tas, donc pas d'affectations (setf, ...). + Or, il est marqué dans notre poly que notre compilo doit se compiler lui-même. Et il est déjà bourré de setf. + Du coup qu'est-ce qu'on fait ? On ré-écrit le compilo tout en purement fonctionnel ? (quasi-impossible...) + Ou on implémente une gestion rudimentaire du tas (garbage-collector stop-the-world qu'on lance quand le tas est plein) ? + +- Comment compiler un code qui définit à l'exécution des fonctions avec des noms aléatoires, et qui les exécute ensuite ? + Réponse (?) : lorsqu'on appelle une fonction, on l'appelle directement si elle est connue à la compilation, sinon + on cherche dans une table des fonctions, et un fait un jump indirect dessus. Lorsqu'on tombe sur une définition + "non statique" comme celle-là, on appelle l'eval embarqué, pour qu'il définise la fonction et la stocke dans sa table + de fonctions. + +- Peut-on faire funcall sur des macros ? Si oui, on peut réécrire mapcar de manière beaucoup plus efficace dans + inplementation-fonctions.lisp. Si non, vu qu'on a defmacro les fonctions car & cdr & d'autres, on ne peut pas les + funcall :( \ No newline at end of file diff --git a/implementation-fonctions.lisp b/implementation-fonctions.lisp new file mode 100644 index 0000000..15abb18 --- /dev/null +++ b/implementation-fonctions.lisp @@ -0,0 +1,120 @@ +;; variables "locales" : documentation +(defvar documentation '(function variable struct)) ;; TODO + +;; "Primitives" : asm, eval + +(defmacro defun (name args &rest body) + (let ((has-docstring + (and (stringp (car body)) + (cdr body)))) + `(progn + (when ,has-docstring + (push (car body) documentation)) ;; TODO + (%top-level-fun-bind + ,name + (lambda ,args + ,@(if has-docstring + (cdr body) + body)))))) + +(defmacro setf (place value) + (cond ((eq (car place) 'car) + `(%set-car ,place ,value)) + ((eq (car place) 'cdr) + `(%set-cdr ,place ,value)) + ;; TODO + (t (error 'setf-invalid-place "setf : invalid place ~a" place)))) + +(defmacro cond (&rest conditions) + (if (atom conditions) + nil + `(if ,(caar conditions) + ,(if (atom (cdr (cdar conditions))) ;; Si une seule instruction dans la partie droite + (car (cdar conditions)) ;; On la met telle qu'elle + '(progn ,@(cdar conditions))) ;; Sinon, on met un progn autour. + (cond ,@(cdr conditions))))) + + +(defmacro car (list) + (%asm )) ;; TODO : list dans rX, résultat dans rY => move [indirect rX], rY + +(defmacro cdr (list) + (%asm )) ;; TODO : list dans rX, résultat dans rY => move rX, rY; incr rY; move [indirect rY], rY; + +;; Les alias c*r ont été générés par un script (plus facile que de les méta-programmer...). +(defmacro caaaar (list) `(car (car (car (car ,list))))) +(defmacro caaadr (list) `(car (car (car (cdr ,list))))) +(defmacro caadar (list) `(car (car (cdr (car ,list))))) +(defmacro caaddr (list) `(car (car (cdr (cdr ,list))))) +(defmacro cadaar (list) `(car (cdr (car (car ,list))))) +(defmacro cadadr (list) `(car (cdr (car (cdr ,list))))) +(defmacro caddar (list) `(car (cdr (cdr (car ,list))))) +(defmacro cadddr (list) `(car (cdr (cdr (cdr ,list))))) +(defmacro cdaaar (list) `(cdr (car (car (car ,list))))) +(defmacro cdaadr (list) `(cdr (car (car (cdr ,list))))) +(defmacro cdadar (list) `(cdr (car (cdr (car ,list))))) +(defmacro cdaddr (list) `(cdr (car (cdr (cdr ,list))))) +(defmacro cddaar (list) `(cdr (cdr (car (car ,list))))) +(defmacro cddadr (list) `(cdr (cdr (car (cdr ,list))))) +(defmacro cdddar (list) `(cdr (cdr (cdr (car ,list))))) +(defmacro cddddr (list) `(cdr (cdr (cdr (cdr ,list))))) +(defmacro caaar (list) `(car (car (car ,list))))) +(defmacro caadr (list) `(car (car (cdr ,list))))) +(defmacro cadar (list) `(car (cdr (car ,list))))) +(defmacro caddr (list) `(car (cdr (cdr ,list))))) +(defmacro cdaar (list) `(cdr (car (car ,list))))) +(defmacro cdadr (list) `(cdr (car (cdr ,list))))) +(defmacro cddar (list) `(cdr (cdr (car ,list))))) +(defmacro cdddr (list) `(cdr (cdr (cdr ,list))))) +(defmacro caar (list) `(car (car ,list))))) +(defmacro cadr (list) `(car (cdr ,list))))) +(defmacro cdar (list) `(cdr (car ,list))))) +(defmacro cddr (list) `(cdr (cdr ,list))))) + +;; Comptez les "d" :) +(defmacro first (list) `(car ,list)) +(defmacro second (list) `(cadr ,list)) +(defmacro third (list) `(caddr ,list)) +(defmacro fourth (list) `(cadddr ,list)) +(defmacro fifth (list) `(car (cddddr ,list))) +(defmacro sixth (list) `(cadr (cddddr ,list))) +(defmacro seventh (list) `(caddr (cddddr ,list))) +(defmacro eighth (list) `(cadddr (cddddr ,list))) +(defmacro ninth (list) `(car (cddddr (cddddr ,list)))) +(defmacro tenth (list) `(cadr (cddddr (cddddr ,list)))) + +(defmacro let (bindings &rest body) + `((lambda ,(mapcar #'car bindings) + ,body) + ,(mapcar #'cdar bindings))) + +(defmacro let* (bindings &rest body) + `(let (,(car bindings)) + (let* ,(cdr bindings) + ,body))) + +(defmacro labels (f-bindings &rest body) + ;; TODO + ) + +(defmacro funcall (function &rest args) + ;; TODO + ) + +(defmacro apply (function &rest args) + ;; TODO + ;; (last args) est la liste des arguments, les précédents sont des arguments "fixes". + ) + +(defun mapcar (fun &rest lists) + (if (atom list) + nil + (cons (if (atom (cdr lists)) + (apply fun (caar lists)) + (apply fun (mapcar #'car lists)) + (mapcar fun (mapcar #'cdr lists)))))) + +(defun last (list) + (if (atom (cdr list)) + list + (last (cdr list)))) \ No newline at end of file