lisp2li.lisp (20645B)
1 (require 'util "util.lisp") 2 (require 'match "match.lisp") 3 4 ;; ` 5 (defvar my-quasiquote nil);(car '`(,a))) 6 7 ;; , 8 (defvar my-unquote nil);(caaadr '`(,a))) 9 10 ;; ,@ 11 (defvar my-unquote-unsplice nil);(caaadr '`(,@a))) 12 13 (declaim (ftype function lisp2li)) ;; Double récursion map-lisp2li / lisp2li. 14 (defun map-lisp2li (expr env) 15 (mapcar (lambda (x) (lisp2li x env)) expr)) 16 17 (declaim (ftype function make-stat-env1)) ;; Double récursion make-stat-env1 / make-stat-env-optional 18 (defun make-stat-env-optional (params env position num-env) 19 (cond ((endp params) 20 env) 21 ((consp (car params)) 22 `((,(caar params) ,num-env ,position) 23 (,(intern (format nil "~a-P" (caar params))) ,num-env ,(+ 1 position)) 24 . ,(make-stat-env-optional (cdr params) env (+ 2 position) num-env))) 25 ((eq '&rest (car params)) 26 (make-stat-env1 (cdr params) env position num-env)) 27 (T 28 `((,(car params) ,num-env ,position) 29 . ,(make-stat-env-optional (cdr params) env (+ 1 position) num-env))))) 30 31 (defun env-depth (env) 32 (or (cadar (last env)) 0)) 33 34 (defun recalculation (env) 35 (cond ((endp env) 36 env) 37 (T 38 `((,(caar env) ,(+ 1 (cadar env)) ,(caddar env)) 39 . ,(recalculation (cdr env)))))) 40 41 (defun make-stat-env1 (params &optional env (position 1) num-env) 42 (cond ((endp params) 43 env) 44 ((eq '&optional (car params)) 45 (make-stat-env-optional (cdr params) env position num-env)) 46 ((eq '&rest (car params)) 47 (make-stat-env1 (cdr params) env position num-env)) 48 (T 49 `((,(car params) 0 ,position) 50 . ,(make-stat-env1 (cdr params) env (+ 1 position) num-env))))) 51 52 (defun make-stat-env (params &optional env (position 1)) 53 (make-stat-env1 params (recalculation env) position 0)) 54 55 (defun transform-quasiquote (expr) 56 (cond 57 ;; a 58 ((atom expr) 59 `',expr) 60 ;; (a) 61 ((atom (car expr)) 62 `(cons ',(car expr) 63 ,(transform-quasiquote (cdr expr)))) 64 ;; (,a) 65 ((eq my-unquote (caar expr)) 66 `(cons ,(cadar expr) 67 ,(transform-quasiquote (cdr expr)))) 68 ;; (,@a) 69 ((eq my-unquote-unsplice (caar expr)) 70 (if (endp (cdr expr)) 71 (cadar expr) 72 `(append ,(cadar expr) 73 ,(transform-quasiquote (cdr expr))))) 74 ;; ((a ...) ...) 75 (T 76 `(cons ,(transform-quasiquote (car expr)) 77 ,(transform-quasiquote (cdr expr)))))) 78 79 (defun get-nb-params-t (params r) 80 (cond ((endp params) 81 r) 82 ((or (eq '&optional (car params)) 83 (eq '&rest (car params))) 84 (get-nb-params-t (cdr params) r)) 85 (T 86 (get-nb-params-t (cdr params) (+ 1 r))))) 87 88 (defun get-nb-params (params) 89 "Renvoie le nombre exact de paramètres sans les &optional et &rest" 90 (get-nb-params-t params 0)) 91 92 (defun implicit-progn (expr) 93 (if (n-consp 2 expr) 94 (cons 'progn expr) 95 (car expr))) 96 97 98 (defun simplify (li) ;; TODO : a finir 99 (cond-match li 100 ((:nil :progn :expr _) 101 (simplify expr)) 102 ((:nil :progn :body0 _* (:nil :progn :body1 _*)+ :body2 _*) 103 (simplify `(:progn ,@body0 ,@(car body1) ,@body2))) 104 ((:nil :progn :body0 _* (:nil :let :size (? integerp) :body1 _*)+ :body2 _*) 105 (simplify `(:let ,@size ,@body0 ,@(car body1) ,@body2))) 106 ((:nil :let :size1 (? integerp) :body1 _* 107 (:nil :let :size2 (? integerp) 108 (:nil :set-var (:depth-set (? integerp) :index-set (? integerp)) @.)+ 109 :var1 (:nil :cvar :depth1 (? integerp) :index1 (? integerp))* 110 :body2 _* :var2 (:nil :cvar :depth2 (? integerp) :index2 (? integerp))*) 111 :body3 _*) 112 (simplify `(:let ,(+ size1 size2) 113 ,@body1 114 ,@(mapcar 115 (lambda (depth index) 116 `(:cvar ,(- depth 1) ,(+ index size1))) depth1 index1) 117 ,@body2 118 ,@(if (and depth2 index2) 119 (mapcar 120 (lambda (depth index) 121 `(:cvar ,(- depth 1) ,(+ index size1))) depth2 index2)) 122 ,@body3))) 123 ((:nil :let :body0 _* (:nil :progn :body1 _*)+ :body2 _*) 124 (simplify `(:let ,@body0 ,@(car body1) ,@body2))) 125 ((:nil :let :size1 (? integerp) :body0 _* (:nil :let :size2 (? integerp) :body1 _*)+ :body2 _*) 126 (simplify `(:let ,(+ size1 (car size2)) ,@body0 ,@(car body1) ,@body2))) 127 ((:nil :if (:nil :const :cond . _) :then @. :else @.) 128 (simplify (if cond then else))) 129 (@. li))) 130 131 (defun lisp2li (expr &optional env) 132 "Convertit le code LISP en un code intermédiaire reconnu 133 par le compilateur et par l’interpréteur" 134 (cond 135 ;; literaux 136 ((and (atom expr) (constantp expr)) 137 (cons :const expr)) 138 ;; symboles 139 ((symbolp expr) 140 (let ((cell (assoc expr env))) 141 (if cell 142 `(:cvar ,(cadr cell) ,(caddr cell)) 143 (error "Variable ~S unknown" expr)))) 144 ;; lambda solitaire ex: (lambda (x) x) 145 ((eq 'lambda (car expr)) ;; TODO : ameliorer le cas du lambda 146 (if (member '&rest (second expr)) 147 `(:lclosure . (,(get-nb-params (second expr)) 148 ,(+ 1 (mposition '&rest (second expr))) 149 ,@(lisp2li (implicit-progn (cddr expr)) 150 (make-stat-env (second expr) env)))) 151 `(:lclosure . ,(cons (get-nb-params (second expr)) 152 (lisp2li (implicit-progn (cddr expr)) 153 (make-stat-env (second expr) env)))))) 154 ;; lambda ex: ((lambda (x) x) 1) 155 ((and (consp (car expr)) 156 (eq 'lambda (caar expr))) 157 `(:mcall ,(lisp2li (car expr) env) 158 ,@(mapcar (lambda (param) 159 (lisp2li param env)) 160 (cdr expr)))) 161 ;; (not-symbol ...) 162 ((not (symbolp (car expr))) 163 (warn "~S isn't a symbol" (car expr))) 164 ;; fonction meta-definie 165 ((get (car expr) :defun) 166 `(:mcall ,(car expr) 167 ,@(mapcar (lambda (x) (lisp2li x env)) (cdr expr)))) 168 ;; macro meta-definie 169 ((get (car expr) :defmacro) 170 `(:mcall ,(car expr) 171 ,@(mapcar (lambda (x) `(:const . ,x)) (cdr expr)))) 172 ;; fonction inconnue 173 ((and (not (fboundp (car expr))) 174 (not (get (car expr) :defun)) 175 (not (get (car expr) :defmacro))) 176 `(:unknown ,expr ,env)) 177 ;; if 178 ((eq 'if (car expr)) 179 (list :if 180 (lisp2li (second expr) env) 181 (lisp2li (third expr) env) 182 (lisp2li (fourth expr) env))) 183 ;; quote 184 ((eq 'quote (car expr)) 185 (cons :const (second expr))) 186 ;; quasiquote ` 187 ((eq my-quasiquote (car expr)) 188 (lisp2li (transform-quasiquote (cadr expr)) env)) 189 ;; #'fn (FUNCTION fn) 190 ((eq 'function (car expr)) 191 `(:sclosure ,(cadr expr))) 192 ;; let 193 ((eq 'let (car expr)) 194 (match (let :bindings ((:names $ :values _)*) :body _*) expr 195 (let ((new-env (make-stat-env names env))) 196 `(:let ,(length bindings) 197 ,@(mapcar 198 (lambda (name value) 199 (let ((cell (assoc name new-env))) 200 `(:set-var (,(second cell) ,(third cell)) 201 ,(lisp2li value new-env)))) 202 names values) 203 ,(lisp2li (implicit-progn body) new-env))))) 204 ((eq 'let* (car expr)) 205 (cond-match expr 206 (((? (eq x 'let*)) :bindings () :body _*) 207 (lisp2li (implicit-progn body) env)) 208 (((? (eq x 'let*)) :bindings ((:name $ :value _) :rest ($ _)*) :body _*) 209 (lisp2li `(let ((,name ,value)) 210 (let* ,rest 211 ,@body)) env)))) 212 ;; defun 213 ((eq 'defun (car expr)) 214 `(:mcall set-defun (:const . ,(second expr)) 215 ,(lisp2li `(lambda ,(third expr) ,@(cdddr expr)) env))) 216 ;; defmacro 217 ((eq 'defmacro (car expr)) 218 `(:mcall set-defmacro (:const . ,(second expr)) 219 ,(lisp2li `(lambda ,(third expr) ,@(cdddr expr)) env))) 220 ;; apply 221 ((eq 'apply (car expr)) 222 `(:sapply ,(second expr) ,@(cddr expr))) 223 ;; setf 224 ((eq 'setf (car expr)) 225 (cond ((symbolp (cadr expr)) 226 (let ((cell (assoc (cadr expr) env))) 227 `(:set-var (,(second cell) ,(third cell)) 228 ,(lisp2li (third expr) env)))) 229 ((symbolp (cdadr expr)) 230 (let ((cell (assoc (cdadr expr) env))) 231 `(:set-var (,(second cell) ,(third cell)) 232 ,(third expr)))) 233 (T 234 `(:set-fun ,(caadr expr) ,@(last expr) ,@(cdadr expr))))) 235 ;; setq 236 ((eq 'setq (car expr)) 237 (lisp2li `(setf ,@(cdr expr)) env)) 238 ;; defvar 239 ((eq 'defvar (car expr)) 240 (let ((var `(,(cadr expr) 241 ,(if (eq nil env) 0 (cadar (last env))) 242 ,(if (eq nil env) 1 (+ (caddar (last env)) 1))))) 243 (setf env (append env `(,var))) 244 (print env) 245 `(:set-var (,(second var) ,(third var)) 246 ,(third expr)))) 247 ;; progn 248 ((eq 'progn (car expr)) 249 (cons :progn (map-lisp2li (cdr expr) env))) 250 ;; declaim 251 ((eq 'declaim (car expr)) 252 (cons :const nil)) 253 ;; the 254 ((eq 'the (car expr)) 255 (lisp2li (third expr))) 256 ;; macros 257 ((macro-function (car expr)) 258 (lisp2li (macroexpand-1 expr) env)) 259 ;; foctions normales 260 ((not (special-operator-p (car expr))) 261 `(:call ,(first expr) ,@(map-lisp2li (cdr expr) env))) 262 (T 263 (error "special form not yet implemented ~S" (car expr))))) 264 265 ;; TODO : demander au prof comment corriger (or (= n 0) (= n 1)) qui rend nil car il fait 2 macroexpand 1: (COND ((= N 0)) (T (= N 1))) 2: (LET (#1=#:RESULT-7048) (IF (SETQ #1# (= N 0)) #1# (= N 1))) et 2 vaux nil car n != 0 266 267 ;; Test unitaire 268 (require 'test-unitaire "test-unitaire") 269 (erase-tests lisp2li) 270 271 (deftest (lisp2li make-stat-env) 272 (make-stat-env '(x y z)) 273 '((x 0 1) (y 0 2) (z 0 3))) 274 275 (deftest (lisp2li make-stat-env) 276 (make-stat-env '(a b c d)) 277 '((a 0 1) (b 0 2) (c 0 3) (d 0 4))) 278 279 (deftest (lisp2li make-stat-env) 280 (make-stat-env '(a b) '((x 0 1) (y 0 2))) 281 '((a 0 1) (b 0 2) (x 1 1) (y 1 2))) 282 283 (deftest (lisp2li make-stat-env) 284 (make-stat-env '(a b &optional c &rest d)) 285 '((a 0 1) (b 0 2) (c 0 3) (d 0 4))) 286 287 (deftest (lisp2li make-stat-env) 288 (make-stat-env '(x y &optional (z t))) 289 '((x 0 1) (y 0 2) (z 0 3) (z-p 0 4))) 290 291 ;; (deftest (lisp2li simplify :progn) 292 ;; (simplify '(:progn (:const . 3))) 293 ;; '(:const . 3)) 294 295 ;; (deftest (lisp2li simplify :progn) 296 ;; (simplify '(:progn (:call list (:const . 1) (:const . 2)))) 297 ;; '(:call list (:const . 1) (:const . 2))) 298 299 ;; (deftest (lisp2li simplify :progn) 300 ;; (simplify '(:progn (:progn (:const . 3) (:const . 4)))) 301 ;; '(:progn (:const . 3) (:const . 4))) 302 303 ;; (deftest (lisp2li simplify :progn) 304 ;; (simplify '(:progn (:const . 3) (:const . 4) (:progn (:const . 5) (:const . 6)))) 305 ;; '(:progn (:const . 3) (:const . 4) (:const . 5) (:const . 6))) 306 307 ;; (deftest (lisp2li simplify :progn) 308 ;; (simplify '(:progn (:const . 1) (:const . 2) (:progn (:const . 3) (:const . 4)) (:const . 5) (:const . 6))) 309 ;; '(:progn (:const . 1) (:const . 2) (:const . 3) (:const . 4) (:const . 5) (:const . 6))) 310 311 ;; (deftest (lisp2li simplify :progn) 312 ;; (simplify '(:progn (:const . 1) (:const . 2) (:progn (:const . 3) (:const . 4)) (:const . 5) (:progn (:const . 6) (:const . 7)))) 313 ;; '(:progn (:const . 1) (:const . 2) (:const . 3) (:const . 4) (:const . 5) (:const . 6) (:const . 7))) 314 315 ;; (deftest (lisp2li simplify :let-progn) 316 ;; (simplify '(:let (:progn (:const . 3) (:const . 4)))) 317 ;; '(:let (:const . 3) (:const . 4))) 318 319 ;; (deftest (lisp2li simplify :let-progn) 320 ;; (simplify '(:let (:const . 3) (:const . 4) (:progn (:const . 5) (:const . 6)))) 321 ;; '(:let (:const . 3) (:const . 4) (:const . 5) (:const . 6))) 322 323 ;; (deftest (lisp2li simplify :let-progn) 324 ;; (simplify '(:let (:const . 1) (:const . 2) (:progn (:const . 3) (:const . 4)) (:const . 5) (:const . 6))) 325 ;; '(:let (:const . 1) (:const . 2) (:const . 3) (:const . 4) (:const . 5) (:const . 6))) 326 327 ;; (deftest (lisp2li simplify :let-progn) 328 ;; (simplify '(:let (:const . 1) (:const . 2) (:progn (:const . 3) (:const . 4)) (:const . 5) (:progn (:const . 6) (:const . 7)))) 329 ;; '(:let (:const . 1) (:const . 2) (:const . 3) (:const . 4) (:const . 5) (:const . 6) (:const . 7))) 330 331 ;; (deftest (lisp2li simplify :progn-let) 332 ;; (simplify '(:progn (:let 0 (:const . 3) (:const . 4)))) 333 ;; '(:let 0 (:const . 3) (:const . 4))) 334 335 ;; (deftest (lisp2li simplify :progn-let) 336 ;; (simplify '(:progn (:let 2 (:const . 3) (:const . 4) (:progn (:const . 5) (:const . 6))))) 337 ;; '(:let 2 (:const . 3) (:const . 4) (:const . 5) (:const . 6))) 338 339 ;; (deftest (lisp2li simplify :progn-let) 340 ;; (simplify '(:progn (:const . 1) (:const . 2) (:let 1 (:const . 3) (:const . 4)) (:const . 5) (:const . 6))) 341 ;; '(:let 1 (:const . 1) (:const . 2) (:const . 3) (:const . 4) (:const . 5) (:const . 6))) 342 343 ;; (deftest (lisp2li simplify :progn-let) 344 ;; (simplify '(:progn (:const . 1) (:const . 2) (:let 5 (:const . 3) (:const . 4)) (:const . 5) (:progn (:const . 6) (:const . 7)))) 345 ;; '(:let 5 (:const . 1) (:const . 2) (:const . 3) (:const . 4) (:const . 5) (:const . 6) (:const . 7))) 346 347 ;; (deftest (lisp2li simplify :let-let) 348 ;; (simplify '(:let 1 (:let 1 (:const . 3) (:const . 4)))) 349 ;; '(:let 2 (:const . 3) (:const . 4))) 350 351 ;; (deftest (lisp2li simplify :let-let) 352 ;; (simplify '(:let 3 (:let 2 (:const . 3) (:const . 4) (:progn (:const . 5) (:const . 6))))) 353 ;; '(:let 5 (:const . 3) (:const . 4) (:const . 5) (:const . 6))) 354 355 ;; (deftest (lisp2li simplify :let-let) 356 ;; (simplify '(:let 2 (:const . 1) (:const . 2) (:let 1 (:const . 3) (:const . 4)) (:const . 5) (:const . 6))) 357 ;; '(:let 3 (:const . 1) (:const . 2) (:const . 3) (:const . 4) (:const . 5) (:const . 6))) 358 359 ;; (deftest (lisp2li simplify :let-let) 360 ;; (simplify '(:let 5 (:const . 1) (:const . 2) (:let 5 (:const . 3) (:const . 4)) (:const . 5) (:let 2 (:const . 6) (:const . 7)))) 361 ;; '(:let 12 (:const . 1) (:const . 2) (:const . 3) (:const . 4) (:const . 5) (:const . 6) (:const . 7))) 362 363 ;; (deftest (lisp2li simplify :if) 364 ;; (simplify '(:if (:const . nil) (:call list 1 2 3) (:const . T))) 365 ;; '(:const . T)) 366 367 ;; (deftest (lisp2li simplify :if) 368 ;; (simplify '(:if (:const . nil) (:progn (:let 2 (:const . 1)) (:const . 2)) (:call list (:const 1 2 3)))) 369 ;; '(:call list (:const 1 2 3))) 370 371 ;; (deftest (lisp2li simplify :if) 372 ;; (simplify '(:if (:const . nil) (:const . nil) (:progn (:let 2 (:const . 1)) (:const . 2)) )) 373 ;; '(:let 2 (:const . 1) (:const . 2))) 374 375 ;; (deftest (lisp2li simplify :if) 376 ;; (simplify '(:if (:const . 2) (:const . nil) (:const . T))) 377 ;; '(:const . nil)) 378 379 ;; (deftest (lisp2li simplify :if) 380 ;; (simplify '(:if (:const . T) (:const . 3) (:const . 4))) 381 ;; '(:const . 3)) 382 383 ;; (deftest (lisp2li simplify :if) 384 ;; (simplify '(:if (:const 1 2 3) (:progn (:let 3 (:const . 3)) (:let 4 (:const . 4))) (:const . 4))) 385 ;; '(:let 7 (:const . 3) (:const . 4))) 386 387 ;; (deftest (lisp2li simplify :let-cvar) 388 ;; (simplify '(:let 3 (:const . T) (:let 4 (:cvar 1 1) (:const . 4)))) 389 ;; '(:let 7 (:const . T) (:cvar 0 4) (:const . 4))) 390 391 ;; (deftest (lisp2li simplify :let-cvar) 392 ;; (simplify '(:progn (:cvar 0 1) 393 ;; (:LET 1 (:CONST . T) 394 ;; (:LET 2 (:CVAR 0 1) (:cvar 1 1) (:cvar 2 1) (:CONST . 4))))) 395 ;; '(:let 3 (:cvar 0 1) (:const . T) (:cvar 0 1) (:cvar 0 2) (:cvar 1 2) (:const . 4))) 396 397 398 (deftest (lisp2li constante) 399 (lisp2li '3 ()) 400 '(:const . 3)) 401 402 (deftest (lisp2li constante) 403 (lisp2li ''x ()) 404 '(:const . x)) 405 406 (deftest (lisp2li constante) 407 (lisp2li ''(1 2 3) ()) 408 '(:const 1 2 3)) 409 410 (deftest (lisp2li variables) 411 (lisp2li 'x '((x 0 1) (y 0 2))) 412 '(:cvar 0 1)) 413 414 (deftest (lisp2li fonctions-normales) 415 (lisp2li '(+ 3 4) ()) 416 '(:call + (:const . 3) (:const . 4))) 417 418 (deftest (lisp2li fonctions-normales) 419 (lisp2li '(list 3 4 (* 6 7)) ()) 420 '(:call list (:const . 3) (:const . 4) 421 (:call * (:const . 6) (:const . 7)))) 422 423 (deftest (lisp2li if) 424 (lisp2li '(if T T nil) ()) 425 '(:if (:const . T) (:const . T) (:const . nil))) 426 427 (deftest (lisp2li defun) 428 (lisp2li '(defun bar (x) x) ()) 429 '(:mcall set-defun (:const . bar) (:lclosure 1 :cvar 0 1))) 430 431 (deftest (lisp2li defun) 432 (lisp2li '(defun foo (x y z) (list x y z)) ()) 433 '(:mcall set-defun (:const . foo) 434 (:lclosure 3 :call list 435 (:cvar 0 1) 436 (:cvar 0 2) 437 (:cvar 0 3)))) 438 439 (deftest (lisp2li setf) 440 (lisp2li '(setf y 42) '((x 0 1) (y 0 2))) 441 '(:set-var (0 2) (:const . 42))) 442 443 (deftest (lisp2li setf) 444 (lisp2li '(setf (cdr '(1 2 3)) 42) ()) 445 '(:set-fun cdr 42 '(1 2 3))) 446 447 (deftest (lisp2li lambda) 448 (lisp2li '(mapcar (lambda (x y z) (list x y z)) '(1 2 3)) ()) 449 '(:call mapcar (:lclosure 3 :call list 450 (:cvar 0 1) 451 (:cvar 0 2) 452 (:cvar 0 3)) 453 (:const 1 2 3))) 454 455 (deftest (lisp2li lambda) 456 (lisp2li '((lambda (x y z) (list x y z)) 1 2 3) ()) 457 '(:mcall (:lclosure 3 :call list 458 (:cvar 0 1) 459 (:cvar 0 2) 460 (:cvar 0 3)) 461 (:const . 1) (:const . 2) (:const . 3))) 462 463 (deftest (lisp2li lambda) 464 (lisp2li `(lambda (x y z) (list x y z)) ()) 465 '(:lclosure 3 :call list 466 (:cvar 0 1) 467 (:cvar 0 2) 468 (:cvar 0 3))) 469 470 (deftest (lisp2li lambda) 471 (lisp2li `(lambda (x y z) (list x y z) (+ x y)) ()) 472 '(:lclosure 3 :progn (:call list 473 (:cvar 0 1) 474 (:cvar 0 2) 475 (:cvar 0 3)) 476 (:call + 477 (:cvar 0 1) 478 (:cvar 0 2)))) 479 480 (deftest (lisp2li rest) 481 (lisp2li `(lambda (x &rest y) (cons x y)) ()) 482 '(:lclosure 2 2 :call cons 483 (:cvar 0 1) 484 (:cvar 0 2))) 485 486 (deftest (lisp2li unknown) 487 (lisp2li '(bar 3) ()) 488 '(:unknown (bar 3) ())) 489 490 (deftest (lisp2li function) 491 (lisp2li '#'car ()) 492 '(:sclosure car)) 493 494 (deftest (lisp2li apply) 495 (lisp2li '(apply 'list '(1 2 3)) ()) 496 '(:sapply 'list '(1 2 3))) 497 498 (deftest (lisp2li apply) 499 (lisp2li '(apply #'list '(1 2 3)) ()) 500 '(:sapply #'list '(1 2 3))) 501 502 (deftest (lisp2li progn) 503 (lisp2li '(progn (list 1 2 3) (+ 3 4)) ()) 504 '(:progn (:call list 505 (:const . 1) 506 (:const . 2) 507 (:const . 3)) 508 (:call + 509 (:const . 3) 510 (:const . 4)))) 511 512 ;; TODO : on ne peut pas faire de tests sur des macros qu'on n'a pas implémentées nous-mêmes, 513 ;; car sinon le résultat dépend de l'implémentation. 514 515 ;; (deftest (lisp2li macro) 516 ;; (lisp2li '(cond ((eq (car '(1 2 3)) 1) T) 517 ;; ((eq (car '(1 2 3)) 2) 2) 518 ;; (T nil)) 519 ;; ()) 520 ;; '(:if (:call eq (:call car (:const 1 2 3)) (:const . 1)) 521 ;; (:const . T) 522 ;; (:if (:call eq (:call car (:const 1 2 3)) (:const . 2)) 523 ;; (:const . 2) 524 ;; (:const . nil)))) 525 526 ;; (deftest (lisp2li macro) 527 ;; (lisp2li '(and (eq (car '(1 2)) 1) 528 ;; T) 529 ;; ()) 530 ;; '(:if (:call not 531 ;; (:call eq (:call car (:const 1 2)) (:const . 1))) 532 ;; (:const . nil) 533 ;; (:const . T))) 534 535 (deftest (lisp2li let) 536 (lisp2li '(let ((x 1) (y 2)) 537 (cons x y)) ()) 538 '(:let 2 (:set-var (0 1) (:const . 1)) 539 (:set-var (0 2) (:const . 2)) 540 (:call cons (:cvar 0 1) (:cvar 0 2)))) 541 542 (deftest (lisp2li let) 543 (lisp2li '(let ((x 1) (y 2)) 544 (cons x y) 545 (list x y)) ()) 546 '(:let 2 (:set-var (0 1) (:const . 1)) 547 (:set-var (0 2) (:const . 2)) 548 (:progn 549 (:call cons (:cvar 0 1) (:cvar 0 2)) 550 (:call list (:cvar 0 1) (:cvar 0 2))))) 551 552 (deftest (lisp2li let) 553 (lisp2li '(let ((x z) (y 2)) 554 (cons x y)) '((z 0 1))) 555 '(:let 2 (:set-var (0 1) (:cvar 1 1)) 556 (:set-var (0 2) (:const . 2)) 557 (:call cons (:cvar 0 1) (:cvar 0 2)))) 558 559 (deftest (lisp2li let) 560 (lisp2li '(let ((x 2)) 561 (cons x z)) '((z 0 1))) 562 '(:let 1 (:set-var (0 1) (:const . 2)) 563 (:call cons (:cvar 0 1) (:cvar 1 1)))) 564 565 (provide 'lisp2li)