Implémentation de certaines fonctions / macros de LISP.

TODO-Liste

@@ -1,4 +1,21 @@
 TODO :
 - Ajouter la fonction map-case-analysis
 - Changer les <signal> par les fonctions warn (warning ?) ou error selon le cas d'utilisation.
-- Remplacer les ";; cas machin" par le code effectif.
+- 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 :(

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))))