;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*- ;;; Code from Paradigms of Artificial Intelligence Programming ;;; Copyright (c) 1991 Peter Norvig ;;;; File compopt.lisp: Optimizers for Scheme compiler (compile3.lisp). (def-optimizer (:LABEL) (instr code all-code) ;; ... L ... => ... ... ;if no reference to L (when (not (find instr all-code :key #'arg1)) (setf (first code) (second code) (rest code) (rest2 code)) t)) (def-optimizer (GSET LSET) (instr code all-code) ;; ex: (begin (set! x y) (if x z)) ;; (SET X) (POP) (VAR X) ==> (SET X) (when (and (is (second code) 'POP) (is (third code) '(GVAR LVAR)) (eq (arg1 instr) (arg1 (third code)))) (setf (rest code) (nthcdr 3 code)) t)) (def-optimizer (JUMP CALL CALLJ RETURN) (instr code all-code) ;; (JUMP L1) ...dead code... L2 ==> (JUMP L1) L2 (setf (rest code) (member-if #'label-p (rest code))) ;; (JUMP L1) ... L1 (JUMP L2) ==> (JUMP L2) ... L1 (JUMP L2) (when (and (is instr 'JUMP) (is (target instr code) '(JUMP RETURN)) (setf (first code) (copy-list (target instr code))) t))) (def-optimizer (TJUMP FJUMP) (instr code all-code) ;; (FJUMP L1) ... L1 (JUMP L2) ==> (FJUMP L2) ... L1 (JUMP L2) (when (is (target instr code) 'JUMP) (setf (second instr) (arg1 (target instr code))) t)) (def-optimizer (T -1 0 1 2) (instr code all-code) (case (opcode (second code)) (NOT ;; (T) (NOT) ==> NIL (setf (first code) (gen1 'NIL) (rest code) (rest2 code)) t) (FJUMP ;; (T) (FJUMP L) ... => ... (setf (first code) (third code) (rest code) (rest3 code)) t) (TJUMP ;; (T) (TJUMP L) ... => (JUMP L) ... (setf (first code) (gen1 'JUMP (arg1 (next-instr code)))) t))) (def-optimizer (NIL) (instr code all-code) (case (opcode (second code)) (NOT ;; (NIL) (NOT) ==> T (setf (first code) (gen1 'T) (rest code) (rest2 code)) t) (TJUMP ;; (NIL) (TJUMP L) ... => ... (setf (first code) (third code) (rest code) (rest3 code)) t) (FJUMP ;; (NIL) (FJUMP L) ==> (JUMP L) (setf (first code) (gen1 'JUMP (arg1 (next-instr code)))) t)))