Created
December 3, 2025 18:53
-
-
Save Bike/72bfbf5c7fad8b92dad52cf3ca204cf0 to your computer and use it in GitHub Desktop.
quick CSE demonstration
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| (defpackage #:common-subexpression-elimination | |
| (:use #:cl) | |
| (:export #:cse)) | |
| (in-package #:common-subexpression-elimination) | |
| ;; Main entry point is the CSE function, which accepts | |
| ;; a list of statements, and returns a list of CSE'd statements. | |
| ;; Expressions are symbols (variables), numbers, or cons expressions. | |
| ;; A cons expression is (OPERATOR EXPRESSION*) where OPERATOR is a | |
| ;; symbol naming an operator (e.g. +, expt). | |
| ;; An expression is trivial if it is not a cons. | |
| ;; Statements are lists (:= SYMBOL EXPRESSION) | |
| ;; Example usage: | |
| #| | |
| (cse '((:= x (+ (* a a) (* a a))) | |
| (:= y (+ (* x x) (* x x))))) ; => | |
| ((:= #:CSE329 (* A A)) | |
| (:= X (+ #:CSE329 #:CSE329)) | |
| (:= #:CSE331 (* X X)) | |
| (:= Y (+ #:CSE331 #:CSE331))) | |
| |# | |
| (defun statement-assignee (statement) (second statement)) | |
| (defun statement-expr (statement) (third statement)) | |
| (defun trivial-expression-p (expr) (atom expr)) | |
| (defun ANF-p (expr) | |
| (or (trivial-expression-p expr) | |
| (every #'trivial-expression-p (cdr expr)))) | |
| (defun flatten-expression (expression) | |
| (if (ANF-p expression) | |
| (values nil expression) | |
| (loop for arg in (cdr expression) | |
| for temp = (if (trivial-expression-p arg) | |
| arg | |
| (gensym "CSE")) | |
| unless (trivial-expression-p arg) | |
| nconc (multiple-value-bind (rstatements rexpr) | |
| (flatten-expression arg) | |
| (nconc rstatements | |
| (list `(:= ,temp ,rexpr)))) | |
| into new-statements | |
| collect temp into new-args | |
| finally (return (values new-statements | |
| (cons (first expression) | |
| new-args)))))) | |
| ;; Given a statement, return a list of flattened statements. | |
| ;; Each flattened statement is in ANF, i.e. its expression will be | |
| ;; either trivial, or a cons expression with all trivial arguments. | |
| (defun flatten-statement (statement) | |
| (let ((expr (statement-expr statement))) | |
| ;; this IF isn't strictly necessary but saves a bit of consing | |
| ;; if STATEMENT is already ANF. | |
| (if (ANF-p expr) | |
| (list statement) | |
| (multiple-value-bind (prestatements expr) | |
| (flatten-expression expr) | |
| (nconc prestatements | |
| (list `(:= ,(statement-assignee statement) | |
| ,expr))))))) | |
| ;; Flatten a list of statements into administrative normal form. | |
| (defun flatten (statements) | |
| (mapcan #'flatten-statement statements)) | |
| ;; Find the earliest statement that defines the given expression. | |
| (defun find-definition (expression statements) | |
| (loop for statement in statements | |
| for sexpr = (statement-expr statement) | |
| when (equal expression sexpr) | |
| return (statement-assignee statement) | |
| finally (return nil))) | |
| ;; Given a list of ANF statements, apply common subexpression | |
| ;; elimination, i.e. remove any redundant statements, replacing their | |
| ;; use by the earliest statement assignee defining them. | |
| (defun %cse-pass (statements) | |
| (loop ;; table from redundant assignees to original assignees | |
| ;; or constants to use instead. | |
| with replacements = (make-hash-table) | |
| ;; These are an ugly way of collecting a list of CSE'd | |
| ;; statements (the result) in order without reversing. | |
| with new-statements-head = (list nil) | |
| with new-statements-tail = new-statements-head | |
| ;; loop over the statements | |
| for statement in statements | |
| for var = (statement-assignee statement) | |
| for expr = (statement-expr statement) | |
| if (trivial-expression-p expr) | |
| ;; assignee can be replaced by trivial expression | |
| do (setf (gethash var replacements) expr) | |
| else | |
| do (let* (;; Make a version of the expression that | |
| ;; uses the earliest assignees for all arguments. | |
| (replaced | |
| ;; expression is not trivial so it must be ANF. | |
| `(,(car expr) | |
| ,@(loop for arg in (cdr expr) | |
| collect (or (gethash arg replacements) | |
| arg)))) | |
| ;; Search to see if our expression is redundant. | |
| ;; we only need to search the statements | |
| ;; that we've already collected. | |
| (original | |
| (find-definition replaced | |
| (cdr new-statements-head)))) | |
| (if original | |
| ;; redundant | |
| (setf (gethash var replacements) original) | |
| ;; not redundant, so collect the fixed statement. | |
| (let ((new-tail (list `(:= ,var ,replaced)))) | |
| (setf (cdr new-statements-tail) new-tail | |
| new-statements-tail new-tail)))) | |
| finally (return (cdr new-statements-head)))) | |
| (defun cse (statements) | |
| (%cse-pass (flatten statements))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment