divers.lisp (3111B)
1 ;; variables "locales" : documentation 2 (defvar documentation '(function variable struct)) ;; TODO 3 4 (defvar meval-op '(car cdr funcall apply mapcar last + - * / read caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr 5 cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr caaar caadr cadar caddr cdaar cdadr cddar 6 cdddr caar cadr cdar cddr first second third fourth fifth sixth seventh eighth ninth tenth 7 tree-equal char schar string string= make-string )) 8 9 10 11 ;; TODO : décider de quelles "primitives" on a besoin. 12 ;; "Primitives" : 13 ;; - (%asm in-values out-values clobber-registers instructions) 14 ;; - (%eval expr env) 15 ;; - (%push-new-env "description") 16 ;; - (%add-top-level-fun-binding name value) 17 ;; - (%add-top-level-var-binding name value) 18 ;; - (%add-fun-binding name value) 19 ;; - (%add-var-binding name value) 20 ;; - (%ref-fun name) 21 ;; Les ref-xxx renvoient un bout de code ASM comme ci-dessous : 22 ;; - Pour une valeur dans la pile : 23 ;; (%asm () (r0) (r0) "load X(sp) r0;") 24 ;; où X est la position dans la pile de name 25 ;; - Pour une valeur dans le top-level : 26 ;; (%asm () (r0) (r0) "load X(bp) r0;") 27 ;; - Pour une valeur dans le tas (si on en a un) 28 ;; (%asm () (r0) (r0) "load X r0;") 29 30 (defmacro defun (name args &rest body) 31 (let ((has-docstring 32 (and (stringp (car body)) 33 (cdr body)))) 34 `(progn 35 (when ,has-docstring 36 (push (car body) documentation)) ;; TODO 37 (%top-level-fun-bind 38 ,name 39 (lambda ,args 40 ,@(if has-docstring 41 (cdr body) 42 body)))))) 43 44 (defmacro setf (place value) 45 (cond ((eq (car place) 'car) 46 `(%set-car ,place ,value)) 47 ((eq (car place) 'cdr) 48 `(%set-cdr ,place ,value)) 49 ;; TODO 50 (t (error 'setf-invalid-place "setf : invalid place ~a" place)))) 51 52 (defmacro cond (&rest conditions) 53 (if (atom conditions) 54 nil 55 `(if ,(caar conditions) 56 ,(if (atom (cdr (cdar conditions))) ;; Si une seule instruction dans la partie droite 57 (car (cdar conditions)) ;; On la met telle qu'elle 58 '(progn ,@(cdar conditions))) ;; Sinon, on met un progn autour. 59 (cond ,@(cdr conditions))))) 60 61 62 (defmacro car (list) 63 (%asm )) ;; TODO : list dans rX, résultat dans rY => move [indirect rX], rY 64 65 (defmacro cdr (list) 66 (%asm )) ;; TODO : list dans rX, résultat dans rY => move rX, rY; incr rY; move [indirect rY], rY; 67 68 (defmacro let (bindings &rest body) 69 `((lambda ,(mapcar #'car bindings) 70 ,@body) 71 ,@(mapcar #'cadr bindings))) 72 73 (defmacro let* (bindings &rest body) 74 (if (endp bindings) 75 `(progn ,@body) 76 `(let (,(car bindings)) 77 (let* ,(cdr bindings) 78 ,@body)))) 79 80 (defmacro labels (f-bindings &rest body) 81 ;; TODO 82 ) 83 84 (defmacro funcall (function &rest args) 85 ;; TODO 86 ) 87 88 (defmacro apply (function &rest args) 89 ;; TODO 90 ;; (last args) est la liste des arguments, les précédents sont des arguments "fixes". 91 ) 92 93 (defun mapcar (fun &rest lists) 94 (if (atom list) 95 nil 96 (cons (if (atom (cdr lists)) 97 (apply fun (caar lists)) 98 (apply fun (mapcar #'car lists)) 99 (mapcar fun (mapcar #'cdr lists)))))) 100 101 (defun last (list) 102 (if (atom (cdr list)) 103 list 104 (last (cdr list))))