From 4e0a03405f1a7f844ee349f7fcd31cf83bbbb1bb Mon Sep 17 00:00:00 2001 From: Kirsten <32720576+kirstenmg@users.noreply.github.com> Date: Wed, 22 May 2024 14:54:09 -0700 Subject: [PATCH 1/7] Temp commit for debug --- dag_in_context/out.egg | 3725 ++++++++++++++++ .../src/optimizations/loop_unroll.egg | 59 +- .../src/optimizations/switch_rewrites.egg | 2 +- dag_in_context/src/schedule.rs | 2 +- out.egg | 3854 +++++++++++++++++ tests/passing/small/peel_twice.bril | 13 + .../small/peel_twice_precalc_pred.bril | 12 + 7 files changed, 7663 insertions(+), 4 deletions(-) create mode 100644 dag_in_context/out.egg create mode 100644 out.egg create mode 100644 tests/passing/small/peel_twice.bril create mode 100644 tests/passing/small/peel_twice_precalc_pred.bril diff --git a/dag_in_context/out.egg b/dag_in_context/out.egg new file mode 100644 index 000000000..dcc5f9426 --- /dev/null +++ b/dag_in_context/out.egg @@ -0,0 +1,3725 @@ + Compiling dag_in_context v0.1.0 (/Users/kirsten/GitHub/eggcc/dag_in_context) +warning: unused import: `crate::egglog_test` + --> src/optimizations/loop_unroll.rs:34:9 + | +34 | use crate::egglog_test; + | ^^^^^^^^^^^^^^^^^^ + | + = note: `#[warn(unused_imports)]` on by default + +warning: unused import: `crate::egglog_test_and_print_program` + --> src/optimizations/loop_unroll.rs:1:5 + | +1 | use crate::egglog_test_and_print_program; + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + | + = note: `#[warn(unused_imports)]` on by default + +warning: unused variable: `expected` + --> src/optimizations/loop_unroll.rs:61:9 + | +61 | let expected = parallel!(int(2), int(1)).with_arg_types(emptyt(), tuplet!(intt(), intt())); + | ^^^^^^^^ help: if this is intentional, prefix it with an underscore: `_expected` + | + = note: `#[warn(unused_variables)]` on by default + +warning: `dag_in_context` (lib) generated 1 warning (run `cargo fix --lib -p dag_in_context` to apply 1 suggestion) +warning: `dag_in_context` (lib test) generated 2 warnings (run `cargo fix --lib -p dag_in_context --tests` to apply 2 suggestions) + Finished release [optimized] target(s) in 5.98s + Running unittests src/lib.rs (target/release/deps/dag_in_context-90c12cb0a35ca697) +; Every term is an `Expr` or a `ListExpr`. +(datatype Expr) +; Used for constructing a list of branches for `Switch`es +; or a list of functions in a `Program`. +(datatype ListExpr (Cons Expr ListExpr) (Nil)) + +; ================================= +; Types +; ================================= + +(sort TypeList) + +(datatype BaseType + (IntT) + (BoolT) + (FloatT) + ; a pointer to a memory region with a particular type + (PointerT BaseType) + (StateT)) + + +(datatype Type + ; a primitive type + (Base BaseType) + ; a typed tuple. Use an empty tuple as a unit type. + ; state edge also has unit type + (TupleT TypeList) +) + +(function TNil () TypeList) +(function TCons (BaseType TypeList) TypeList) ; Head element should never be a tuple + + +; ================================= +; Assumptions +; ================================= + +(datatype Assumption + ; Assume nothing + (InFunc String) + ; The term is in a loop with `input` and `pred_output`. + ; InLoop is a special context because it describes the argument of the loop. It is a *scope context*. + ; input pred_output + (InLoop Expr Expr) + ; Branch of the switch, and what the predicate is, and what the input is + (InSwitch i64 Expr Expr) + ; If the predicate was true, and what the predicate is, and what the input is + (InIf bool Expr Expr) +) + + + +; ================================= +; Leaf nodes +; Constants, argument, and empty tuple +; ================================= + +; Only a single argument is bound- if multiple values are needed, arg will be a tuple. +; e.g. `(Get (Arg tuple_type) 1)` gets the second value in the argument with some tuple_type. +(function Arg (Type Assumption) Expr) + +; Constants +(datatype Constant + (Int i64) + (Bool bool) + (Float f64)) +; All leaf nodes need the type of the argument +; Type is the type of the bound argument in scope +(function Const (Constant Type Assumption) Expr) + +; An empty tuple. +; Type is the type of the bound argument in scope +(function Empty (Type Assumption) Expr) + + +; ================================= +; Operators +; ================================= + +(datatype TernaryOp + ; given a pointer, value, and a state edge + ; writes the value to the pointer and returns + ; the resulting state edge + (Write) + (Select)) +(datatype BinaryOp + ;; integer operators + (Add) + (Sub) + (Div) + (Mul) + (LessThan) + (GreaterThan) + (LessEq) + (GreaterEq) + (Eq) + ;; float operators + (FAdd) + (FSub) + (FDiv) + (FMul) + (FLessThan) + (FGreaterThan) + (FLessEq) + (FGreaterEq) + (FEq) + ;; logical operators + (And) + (Or) + ; given a pointer and a state edge + ; loads the value at the pointer and returns (value, state edge) + (Load) + ; Takes a pointer and an integer, and offsets + ; the pointer by the integer + (PtrAdd) + ; given and value and a state edge, prints the value as a side-effect + ; the value must be a base value, not a tuple + ; returns an empty tuple + (Print) + ; given a pointer and state edge, frees the whole memory region at the pointer + (Free)) +(datatype UnaryOp + (Not)) + +; Operators +(function Top (TernaryOp Expr Expr Expr) Expr) +(function Bop (BinaryOp Expr Expr) Expr) +(function Uop (UnaryOp Expr) Expr) +; gets from a tuple. static index +(function Get (Expr i64) Expr) +; (Alloc id amount state_edge pointer_type) +; allocate an integer amount of memory for a particular type +; returns (pointer to the allocated memory, state edge) +(function Alloc (i64 Expr Expr BaseType) Expr) +; name of func arg +(function Call (String Expr) Expr) + + + +; ================================= +; Tuple operations +; ================================= + +; `Empty`, `Single` and `Concat` create tuples. +; 1. Use `Empty` for an empty tuple. +; 2. Use `Single` for a tuple with one element. +; 3. Use `Concat` to append the elements from two tuples together. +; Nested tuples are not allowed. + + +; A tuple with a single element. +; Necessary because we only use `Concat` to add to tuples. +(function Single (Expr) Expr) +; Concat appends the elemnts from two tuples together +; e.g. (Concat (Concat (Single a) (Single b)) +; (Concat (Single c) (Single d))) = (a, b, c, d) +; expr1 expr2 +(function Concat (Expr Expr) Expr) + + + +; ================================= +; Control flow +; ================================= + +; Switch on a list of lazily-evaluated branches. +; pred must be an integer +; pred inputs branches chosen +(function Switch (Expr Expr ListExpr) Expr) +; If is like switch, but with a boolean predicate +; pred inputs then else +(function If (Expr Expr Expr Expr) Expr) + + +; A do-while loop. +; Evaluates the input, then evaluates the body. +; Keeps looping while the predicate is true. +; input must have the same type as (output1, output2, ..., outputi) +; input must be a tuple +; pred must be a boolean +; pred-and-body must be a flat tuple (pred, out1, out2, ..., outi) +; input must be the same type as (out1, out2, ..., outi) +; input pred-and-body +(function DoWhile (Expr Expr) Expr) + + +; ================================= +; Top-level expressions +; ================================= +(sort ProgramType) +; An entry function and a list of additional functions. +; entry function other functions +(function Program (Expr ListExpr) ProgramType) +; name input ty output ty output +(function Function (String Type Type Expr) Expr) + + + +; Rulesets +(ruleset always-run) +(ruleset error-checking) +(ruleset memory) +(ruleset memory-helpers) +(ruleset smem) + +;; Initliazation +(relation bop->string (BinaryOp String)) +(relation uop->string (UnaryOp String)) +(relation top->string (TernaryOp String)) +(bop->string (Add) "Add") +(bop->string (Sub) "Sub") +(bop->string (Div) "Div") +(bop->string (Mul) "Mul") +(bop->string (LessThan) "LessThan") +(bop->string (GreaterThan) "GreaterThan") +(bop->string (LessEq) "LessEq") +(bop->string (GreaterEq) "GreaterEq") +(bop->string (Eq) "Eq") +(bop->string (FAdd) "FAdd") +(bop->string (FSub) "FSub") +(bop->string (FDiv) "FDiv") +(bop->string (FMul) "FMul") +(bop->string (FLessThan) "FLessThan") +(bop->string (FGreaterThan) "FGreaterThan") +(bop->string (FLessEq) "FLessEq") +(bop->string (FGreaterEq) "FGreaterEq") +(bop->string (FEq) "FEq") +(bop->string (And) "And") +(bop->string (Or) "Or") +(bop->string (Load) "Load") +(bop->string (PtrAdd) "PtrAdd") +(bop->string (Print) "Print") +(bop->string (Free) "Free") +(ruleset type-analysis) +(ruleset type-helpers) ;; these rules need to saturate between every iter of type-analysis rules + +(function TLConcat (TypeList TypeList) TypeList :unextractable) +(rewrite (TLConcat (TNil) r) r :ruleset type-helpers) +(rewrite (TLConcat (TCons hd tl) r) + (TCons hd (TLConcat tl r)) + :ruleset type-helpers) + +(function TypeList-length (TypeList) i64 :unextractable) +(function TypeList-ith (TypeList i64) BaseType :unextractable) +(function TypeList-suffix (TypeList i64) TypeList :unextractable) + +(rule ((TupleT tylist)) ((union (TypeList-suffix tylist 0) tylist)) :ruleset type-helpers) + +(rule ((= (TypeList-suffix top n) (TCons hd tl))) + ((union (TypeList-ith top n) hd) + (union (TypeList-suffix top (+ n 1)) tl)) :ruleset type-helpers) + +(rule ((= (TypeList-suffix list n) (TNil))) + ((set (TypeList-length list) n)) :ruleset type-helpers) + +(rule ((TypeList-ith list i) + (= (TypeList-length list) n) + (>= i n)) + ((panic "TypeList-ith out of bounds")) :ruleset type-helpers) + +(relation HasType (Expr Type)) + + +;; Keep track of type expectations for error messages +(relation ExpectType (Expr Type String)) +(rule ( + (ExpectType e expected msg) + (HasType e actual) + (!= expected actual) ;; OKAY to compare types for equality because we never union types. + ) + ((extract "Expecting expression") + (extract e) + (extract "to have type") + (extract expected) + (extract "but got type") + (extract actual) + (extract "with message") + (extract msg) + (panic "type mismatch")) + :ruleset error-checking) + +(relation HasArgType (Expr Type)) + +(rule ((HasArgType (Arg t1 ctx) t2) + (!= t1 t2)) + ((panic "arg type mismatch")) + :ruleset error-checking) + +(rule ((= lhs (Function name in out body)) + (HasArgType body ty) + (HasArgType body ty2) + (!= ty ty2)) + ((panic "arg type mismatch in function")) + :ruleset error-checking) + +; Propagate arg types up +(rule ((= lhs (Uop _ e)) + (HasArgType e ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Bop _ a b)) + (HasArgType a ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Bop _ a b)) + (HasArgType b ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Get e _)) + (HasArgType e ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Alloc _id e state _)) + (HasArgType e ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Call _ e)) + (HasArgType e ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Single e)) + (HasArgType e ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Concat e1 e2)) + (HasArgType e1 ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Concat e1 e2)) + (HasArgType e2 ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Switch pred inputs (Cons branch rest))) + (HasArgType pred ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Switch pred inputs (Cons branch rest))) + (HasArgType branch ty) + (HasType inputs ty2) + (!= ty ty2)) + ((panic "switch branches then branch has incorrect input type")) + :ruleset error-checking) +;; demand with one fewer branches +(rule ((= lhs (Switch pred inputs (Cons branch rest)))) + ((Switch pred inputs rest)) + :ruleset type-analysis) +(rule ((= lhs (If c i t e)) + (HasArgType c ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (If c i t e)) + (HasType i ty) + (HasArgType t ty2) + (!= ty ty2)) + ((panic "if branches then branch has incorrect input type")) + :ruleset error-checking) +(rule ((= lhs (If c i t e)) + (HasType i ty) + (HasArgType e ty2) + (!= ty ty2)) + ((panic "if branches else branch has incorrect input type")) + :ruleset error-checking) + + +(rule ((= lhs (DoWhile ins body)) + (HasArgType ins ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +; Don't push arg types through Program, Function, DoWhile, Let exprs because +; these create new arg contexts. + +; Primitives +(rule ((= lhs (Const (Int i) ty ctx))) + ((HasType lhs (Base (IntT))) + (HasArgType lhs ty)) + :ruleset type-analysis) + +(rule ((= lhs (Const (Bool b) ty ctx))) + ((HasType lhs (Base (BoolT))) + (HasArgType lhs ty)) + :ruleset type-analysis) + +(rule ((= lhs (Const (Float b) ty ctx))) + ((HasType lhs (Base (FloatT))) + (HasArgType lhs ty)) + :ruleset type-analysis) + +(rule ((= lhs (Empty ty ctx))) + ((HasType lhs (TupleT (TNil))) + (HasArgType lhs ty)) + :ruleset type-analysis) + +; Unary Ops +(rule ( + (= lhs (Uop (Not) e)) + (HasType e (Base (BoolT))) + ) + ((HasType lhs (Base (BoolT)))) + :ruleset type-analysis) +(rule ((= lhs (Uop (Not) e))) + ((ExpectType e (Base (BoolT)) "(Not)")) + :ruleset type-analysis) + + +(rule ( + (= lhs (Bop (Print) e state)) + (HasType e _ty) ; just make sure it has some type. + ) + ((HasType lhs (Base (StateT)))) + :ruleset type-analysis) + +(rule ( + (= lhs (Bop (Print) e state)) + (HasType e (TupleT ty)) + ) + ((panic "Don't print a tuple")) + :ruleset error-checking) + +(rule ((= lhs (Bop (Free) e s)) + (HasType e (Base (PointerT _ty)))) + ((HasType lhs (Base (StateT)))) + :ruleset type-analysis) +(rule ((= lhs (Bop (Free) e s)) + (HasType e (Base (IntT)))) + ((panic "Free expected pointer, received integer")) + :ruleset error-checking) +(rule ((= lhs (Bop (Free) e s)) + (HasType e (TupleT _ty))) + ((panic "Free expected pointer, received tuple")) + :ruleset error-checking) + +(rule ( + (= lhs (Bop (Load) e state)) + (HasType e (Base (PointerT ty))) + ) + ((HasType lhs (TupleT (TCons ty (TCons (StateT) (TNil)))))) + :ruleset type-analysis) +(rule ( + (= lhs (Bop (Load) e state)) + (HasType e ty) + (= ty (Base (IntT))) + ) + ((panic "(Load) expected pointer, received int")) + :ruleset error-checking) +(rule ( + (= lhs (Bop (Load) e state)) + (HasType e ty) + (= ty (TupleT x)) + ) + ((panic "(Load) expected pointer, received tuple")) + :ruleset error-checking) + +; Binary ops + +;; Operators that have type Type -> Type -> Type +;; Note we only do this generic matching for binary +;; operator since there's a lot of them. +;; In the future we can also extend to other constructs. +(relation bop-of-type (BinaryOp Type)) +(bop-of-type (Add) (Base (IntT))) +(bop-of-type (Sub) (Base (IntT))) +(bop-of-type (Div) (Base (IntT))) +(bop-of-type (Mul) (Base (IntT))) +(bop-of-type (FAdd) (Base (FloatT))) +(bop-of-type (FSub) (Base (FloatT))) +(bop-of-type (FDiv) (Base (FloatT))) +(bop-of-type (FMul) (Base (FloatT))) + +(rule ( + (= lhs (Bop op e1 e2)) + (bop-of-type op ty) + (HasType e1 ty) + (HasType e2 ty) + ) + ((HasType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Bop op e1 e2)) + (bop-of-type op ty) + (bop->string op op-str)) + ( + (ExpectType e1 ty op-str) + (ExpectType e2 ty op-str) + ) + :ruleset type-analysis) + +;; Operators that have type Float -> Float -> Bool +(relation bpred-of-type (BinaryOp Type)) +(bpred-of-type (FLessThan) (Base (FloatT))) +(bpred-of-type (FLessEq) (Base (FloatT))) +(bpred-of-type (FGreaterThan) (Base (FloatT))) +(bpred-of-type (FGreaterEq) (Base (FloatT))) +(bpred-of-type (FEq) (Base (FloatT))) +(bpred-of-type (LessThan) (Base (IntT))) +(bpred-of-type (LessEq) (Base (IntT))) +(bpred-of-type (GreaterThan) (Base (IntT))) +(bpred-of-type (GreaterEq) (Base (IntT))) +(bpred-of-type (Eq) (Base (IntT))) +(bpred-of-type (And) (Base (BoolT))) +(bpred-of-type (Or) (Base (BoolT))) + +(rule ( + (= lhs (Bop pred e1 e2)) + (bpred-of-type pred ty) + (HasType e1 ty) + (HasType e2 ty) + ) + ((HasType lhs (Base (BoolT)))) + :ruleset type-analysis) +(rule ((= lhs (Bop pred e1 e2)) + (bpred-of-type pred ty) + (bop->string pred pred-str)) + ( + (ExpectType e1 ty pred-str) + (ExpectType e2 ty pred-str) + ) + :ruleset type-analysis) + +(rule ( + (= lhs (Top (Write) ptr val state)) + (HasType ptr (Base (PointerT ty))) + (HasType val (Base t)) ; TODO need to support pointers to pointers + ) + ((HasType lhs (Base (StateT)))) ; Write returns () + :ruleset type-analysis) + +(rule ( + (= lhs (Top (Write) ptr val state)) + (HasType ptr (Base (PointerT ty)))) + ((ExpectType val (Base ty) "(Write)")) + :ruleset type-analysis) + + + +(rule ( + (= lhs (Bop (PtrAdd) ptr n)) + (HasType ptr (Base (PointerT ty))) + (HasType n (Base (IntT))) + ) + ((HasType lhs (Base (PointerT ty)))) + :ruleset type-analysis) + +; Other ops +(rule ((= lhs (Alloc _id amt state ty))) + ((ExpectType amt (Base (IntT)) "(Alloc)")) + :ruleset type-analysis) + +(rule ( + (= lhs (Alloc _id amt state ty)) + (HasType amt (Base (IntT))) + ) + ((HasType lhs (TupleT (TCons ty (TCons (StateT) (TNil)))))) + :ruleset type-analysis) + +(rule ( + (= lhs (Get e i)) + (HasType e (TupleT tylist)) + ) + ; TypeList-ith needs to compute immediately, so we need to saturate type-helpers + ; rules between every iter of type-analysis rules. + ((HasType lhs (Base (TypeList-ith tylist i)))) + :ruleset type-analysis) + +(rule ( + (HasType (Get expr i) (TupleT tl)) + (= (TypeList-length tl) len) + (>= i len)) + ((panic "index out of bounds")) + :ruleset error-checking) +(rule ( + (HasType (Get expr i) (TupleT tl)) + (= (TypeList-length tl) len) + (< i 0) + ) + ((panic "negative index")) + :ruleset error-checking) + +; ================================= +; Tuple operations +; ================================= + +(rule ( + (= lhs (Single e)) + (HasType e (TupleT tylist)) + ) + ((panic "don't nest tuples")) + :ruleset error-checking) + +(rule ( + (= lhs (Single e)) + (HasType e (Base basety)) + ) + ((HasType lhs (TupleT (TCons basety (TNil))))) + :ruleset type-analysis) + +(rule ( + (= lhs (Concat e1 e2)) + (HasType e1 (TupleT tylist1)) + (HasType e2 (TupleT tylist2)) + ) + ; TLConcat needs to compute immediately, so we need to saturate type-helpers + ; rules between every iter of type-analysis rules. + ((HasType lhs (TupleT (TLConcat tylist1 tylist2)))) + :ruleset type-analysis) + +; ================================= +; Control flow +; ================================= +(rule ((= lhs (If pred inputs then else))) + ((ExpectType pred (Base (BoolT)) "If predicate must be boolean")) + :ruleset type-analysis) +(rule ( + (= lhs (If pred inputs then else)) + (HasType pred (Base (BoolT))) + (HasType then ty) + (HasType else ty) + ) + ((HasType lhs ty)) + :ruleset type-analysis) + +(rule ( + (= lhs (If pred inputs then else)) + (HasType pred (Base (BoolT))) + (HasType then tya) + (HasType else tyb) + (!= tya tyb) + ) + ((panic "if branches had different types")) + :ruleset error-checking) + + + +(rule ((= lhs (Switch pred inputs branches))) + ((ExpectType pred (Base (IntT)) "Switch predicate must be integer")) + :ruleset type-analysis) + +; base case: single branch switch has type of branch +(rule ( + (= lhs (Switch pred inputs (Cons branch (Nil)))) + (HasType pred (Base (IntT))) + (HasType branch ty) + ) + ((HasType lhs ty)) + :ruleset type-analysis) + +; recursive case: peel off a layer +(rule ((Switch pred inputs (Cons branch rest))) + ((Switch pred inputs rest)) + :ruleset type-analysis) + +(rule ( + (= lhs (Switch pred inputs (Cons branch rest))) + (HasType pred (Base (IntT))) + (HasType branch ty) + (HasType (Switch pred inputs rest) ty) ; rest of the branches also have type ty + ) + ((HasType lhs ty)) + :ruleset type-analysis) + +(rule ( + (= lhs (Switch pred inputs (Cons branch rest))) + (HasType pred (Base (IntT))) + (HasType branch tya) + (HasType (Switch pred inputs rest) tyb) + (!= tya tyb) + ) + ((panic "switch branches had different types")) + :ruleset error-checking) + +(rule ((Arg ty ctx)) + ( + (HasType (Arg ty ctx) ty) + (HasArgType (Arg ty ctx) ty) + ) + :ruleset type-analysis) + + +(rule ( + (= lhs (DoWhile inp pred-body)) + (HasType inp (Base ty)) + ) + ((panic "loop input must be tuple")) + :ruleset error-checking) +(rule ( + (= lhs (DoWhile inp pred-body)) + (HasType inp (Base (PointerT ty))) + ) + ((panic "loop input must be tuple")) + :ruleset error-checking) +(rule ( + (= lhs (DoWhile inp pred-body)) + (HasType pred-body (Base ty)) + ) + ((panic "loop pred-body must be tuple")) + :ruleset error-checking) +(rule ( + (= lhs (DoWhile inp pred-body)) + (HasType pred-body (Base (PointerT ty))) + ) + ((panic "loop pred-body must be tuple")) + :ruleset error-checking) + +(rule ( + (= lhs (DoWhile inp pred-body)) + (HasType inp (TupleT tylist)) + ) + ((HasArgType pred-body (TupleT tylist))) + :ruleset type-analysis) + +(rule ((= lhs (DoWhile inp pred-body))) + ((ExpectType (Get pred-body 0) (Base (BoolT)) "loop pred must be bool")) + :ruleset type-analysis) + +(rule ( + (= lhs (DoWhile inp pred-body)) + (HasType inp (TupleT tylist)) ; input is a tuple + ; pred-body is a tuple where the first elt is a bool + ; and the rest of the list matches the input type + (HasType pred-body (TupleT (TCons (BoolT) tylist))) + ) + ((HasType lhs (TupleT tylist))) ; whole thing has type of inputs/outputs + :ruleset type-analysis) + +(rule ( + (= lhs (DoWhile inp pred-body)) + (HasType inp (TupleT in-tys)) + (HasType pred-body (TupleT (TCons (BoolT) out-tys))) + (!= in-tys out-tys) + ) + ((panic "input types and output types don't match")) + :ruleset error-checking) + +; ================================= +; Functions +; ================================= + +(rule ((= lhs (Function name in-ty out-ty body))) + ( + ; Arg should have the specified type in the body + (HasArgType body in-ty) + ; Expect the body to have the specified output type + (ExpectType body out-ty "Function body had wrong type") + ) + :ruleset type-analysis) + +(rule ( + (= lhs (Call name arg)) + (Function name in-ty out-ty body) + ) + ; Expect the arg to have the right type for the function + ((ExpectType arg in-ty "function called with wrong arg type")) + :ruleset type-analysis) + +(rule ( + (= lhs (Call name arg)) + (Function name in-ty out-ty body) + (HasType arg in-ty) + ; We don't need to check the type of the function body, it will + ; be checked elsewhere. If we did require (HasType body out-ty), + ; recursive functions would not get assigned a type. + ) + ((HasType lhs out-ty)) + :ruleset type-analysis) + +; find which types are pure +(relation PureBaseType (BaseType)) +(relation PureType (Type)) +(relation PureTypeList (TypeList)) + +(PureBaseType (IntT)) +(PureBaseType (BoolT)) +(rule ((Base ty) + (PureBaseType ty)) + ((PureType (Base ty))) + :ruleset type-analysis) +(rule ((TupleT tylist) + (PureTypeList tylist)) + ((PureType (TupleT tylist))) + :ruleset type-analysis) +(rule ((TNil)) + ((PureTypeList (TNil))) + :ruleset type-analysis) +(rule ((TCons hd tl) + (PureBaseType hd) + (PureTypeList tl)) + ((PureTypeList (TCons hd tl))) + :ruleset type-analysis) + +(function ListExpr-length (ListExpr) i64) +(function ListExpr-ith (ListExpr i64) Expr :unextractable) +(function ListExpr-suffix (ListExpr i64) ListExpr :unextractable) +(function Append (ListExpr Expr) ListExpr :unextractable) + +(rule ((Switch pred inputs branch)) ((union (ListExpr-suffix branch 0) branch)) :ruleset always-run) + +(rule ((= (ListExpr-suffix top n) (Cons hd tl))) + ((union (ListExpr-ith top n) hd) + (union (ListExpr-suffix top (+ n 1)) tl)) :ruleset always-run) + +(rule ((= (ListExpr-suffix list n) (Nil))) + ((set (ListExpr-length list) n)) :ruleset always-run) + +(rewrite (Append (Cons a b) e) + (Cons a (Append b e)) + :ruleset always-run) +(rewrite (Append (Nil) e) + (Cons e (Nil)) + :ruleset always-run) + +(function tuple-length (Expr) i64 :unextractable) + +(rule ((HasType expr (TupleT tl)) + (= len (TypeList-length tl))) + ((set (tuple-length expr) len)) :ruleset always-run) + +;; Create a Get for every index, and rewrite it to see through Concat +(rule ((Single expr)) ((union (Get (Single expr) 0) expr)) :ruleset always-run) +;; initial get +(rule ((> (tuple-length tuple) 0)) + ((Get tuple 0)) + :ruleset always-run) +;; next get +(rule ((= len (tuple-length tuple)) + (= ith (Get tuple i)) + (< (+ i 1) len) + ) + ((Get tuple (+ 1 i))) + :ruleset always-run) + +;; descend left +(rule ((Get (Concat expr1 expr2) i) + (= (tuple-length expr1) len1) + (< i len1)) + ((union (Get (Concat expr1 expr2) i) + (Get expr1 i))) + :ruleset always-run) +;; descend right +(rule ((Get (Concat expr1 expr2) i) + (= (tuple-length expr1) len1) + (>= i len1)) + ((union (Get (Concat expr1 expr2) i) + (Get expr2 (- i len1)))) + :ruleset always-run) + + +;; A temporary context. +;; Be sure to delete at the end of all actions or else!!! +;; This is safer than using a persistant context, since we may miss an important part of the query. +(function TmpCtx () Assumption) + +(rule ((TmpCtx)) + ((panic "TmpCtx should not exist outside rule body")) + :ruleset always-run) + +(relation ExprIsValid (Expr)) +(relation ListExprIsValid (ListExpr)) +(rule ((ExprIsValid (Function _name _tyin _tyout _out))) ((ExprIsValid _out)) :ruleset always-run) +(rule ((ExprIsValid (Top _op _x _y _z))) ((ExprIsValid _x) +(ExprIsValid _y) +(ExprIsValid _z)) :ruleset always-run) +(rule ((ExprIsValid (Bop _op _x _y))) ((ExprIsValid _x) +(ExprIsValid _y)) :ruleset always-run) +(rule ((ExprIsValid (Uop _op _x))) ((ExprIsValid _x)) :ruleset always-run) +(rule ((ExprIsValid (Get _tup _i))) ((ExprIsValid _tup)) :ruleset always-run) +(rule ((ExprIsValid (Concat _x _y))) ((ExprIsValid _x) +(ExprIsValid _y)) :ruleset always-run) +(rule ((ExprIsValid (Single _x))) ((ExprIsValid _x)) :ruleset always-run) +(rule ((ExprIsValid (Switch _pred _inputs _branches))) ((ExprIsValid _pred) +(ExprIsValid _inputs) +(ListExprIsValid _branches)) :ruleset always-run) +(rule ((ExprIsValid (If _pred _input _then _else))) ((ExprIsValid _pred) +(ExprIsValid _input) +(ExprIsValid _then) +(ExprIsValid _else)) :ruleset always-run) +(rule ((ExprIsValid (DoWhile _in _pred-and-output))) ((ExprIsValid _in) +(ExprIsValid _pred-and-output)) :ruleset always-run) +(rule ((ExprIsValid (Call _func _arg))) ((ExprIsValid _arg)) :ruleset always-run) +(rule ((ListExprIsValid (Cons _hd _tl))) ((ExprIsValid _hd) +(ListExprIsValid _tl)) :ruleset always-run) +(rule ((ExprIsValid (Alloc _id _e _state _ty))) ((ExprIsValid _e) +(ExprIsValid _state)) :ruleset always-run) +(relation ExprIsResolved (Expr)) +(relation ListExprIsResolved (ListExpr)) +(rule ((= lhs (Function _name _tyin _tyout _out)) (ExprIsResolved _out)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Const _n _ty _ctx)) ) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Top _op _x _y _z)) (ExprIsResolved _x) +(ExprIsResolved _y) +(ExprIsResolved _z)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Bop _op _x _y)) (ExprIsResolved _x) +(ExprIsResolved _y)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Uop _op _x)) (ExprIsResolved _x)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Get _tup _i)) (ExprIsResolved _tup)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Concat _x _y)) (ExprIsResolved _x) +(ExprIsResolved _y)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Single _x)) (ExprIsResolved _x)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Switch _pred _inputs _branches)) (ExprIsResolved _pred) +(ExprIsResolved _inputs) +(ListExprIsResolved _branches)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (If _pred _input _then _else)) (ExprIsResolved _pred) +(ExprIsResolved _input) +(ExprIsResolved _then) +(ExprIsResolved _else)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (DoWhile _in _pred-and-output)) (ExprIsResolved _in) +(ExprIsResolved _pred-and-output)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Arg _ty _ctx)) ) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Call _func _arg)) (ExprIsResolved _arg)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Empty _ty _ctx)) ) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Cons _hd _tl)) (ExprIsResolved _hd) +(ListExprIsResolved _tl)) ((ListExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Nil)) ) ((ListExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Alloc _id _e _state _ty)) (ExprIsResolved _e) +(ExprIsResolved _state)) ((ExprIsResolved lhs)) :ruleset always-run) +(relation BodyContainsExpr (Expr Expr)) +(relation BodyContainsListExpr (Expr ListExpr)) +(rule ((Function _name _tyin _tyout _out)) ((BodyContainsExpr (Function _name _tyin _tyout _out) _out)) :ruleset always-run) +(rule ((If _pred _input _then _else)) ((BodyContainsExpr (If _pred _input _then _else) _then) (BodyContainsExpr (If _pred _input _then _else) _else)) :ruleset always-run) +(rule ((DoWhile _in _pred-and-output)) ((BodyContainsExpr (DoWhile _in _pred-and-output) _pred-and-output)) :ruleset always-run) +(rule ((BodyContainsExpr body (Top _op _x _y _z))) ((BodyContainsExpr body _x) (BodyContainsExpr body _y) (BodyContainsExpr body _z)) :ruleset always-run) +(rule ((BodyContainsExpr body (Bop _op _x _y))) ((BodyContainsExpr body _x) (BodyContainsExpr body _y)) :ruleset always-run) +(rule ((BodyContainsExpr body (Uop _op _x))) ((BodyContainsExpr body _x)) :ruleset always-run) +(rule ((BodyContainsExpr body (Get _tup _i))) ((BodyContainsExpr body _tup)) :ruleset always-run) +(rule ((BodyContainsExpr body (Concat _x _y))) ((BodyContainsExpr body _x) (BodyContainsExpr body _y)) :ruleset always-run) +(rule ((BodyContainsExpr body (Single _x))) ((BodyContainsExpr body _x)) :ruleset always-run) +(rule ((BodyContainsExpr body (Switch _pred _inputs _branches))) ((BodyContainsExpr body _pred) (BodyContainsExpr body _inputs)) :ruleset always-run) +(rule ((BodyContainsExpr body (If _pred _input _then _else))) ((BodyContainsExpr body _pred) (BodyContainsExpr body _input)) :ruleset always-run) +(rule ((BodyContainsExpr body (DoWhile _in _pred-and-output))) ((BodyContainsExpr body _in)) :ruleset always-run) +(rule ((BodyContainsExpr body (Call _func _arg))) ((BodyContainsExpr body _arg)) :ruleset always-run) +(rule ((BodyContainsListExpr body (Cons _hd _tl))) ((BodyContainsExpr body _hd)) :ruleset always-run) +(rule ((BodyContainsExpr body (Alloc _id _e _state _ty))) ((BodyContainsExpr body _e) (BodyContainsExpr body _state)) :ruleset always-run) + + (relation ExprIsPure (Expr)) + (relation ListExprIsPure (ListExpr)) + (relation BinaryOpIsPure (BinaryOp)) + (relation UnaryOpIsPure (UnaryOp)) + (relation TopIsPure (TernaryOp)) +(TopIsPure (Select)) +(BinaryOpIsPure (Add)) +(BinaryOpIsPure (Sub)) +(BinaryOpIsPure (Mul)) +(BinaryOpIsPure (Div)) +(BinaryOpIsPure (Eq)) +(BinaryOpIsPure (LessThan)) +(BinaryOpIsPure (GreaterThan)) +(BinaryOpIsPure (LessEq)) +(BinaryOpIsPure (GreaterEq)) +(BinaryOpIsPure (FAdd)) +(BinaryOpIsPure (FSub)) +(BinaryOpIsPure (FMul)) +(BinaryOpIsPure (FDiv)) +(BinaryOpIsPure (FEq)) +(BinaryOpIsPure (FLessThan)) +(BinaryOpIsPure (FGreaterThan)) +(BinaryOpIsPure (FLessEq)) +(BinaryOpIsPure (FGreaterEq)) +(BinaryOpIsPure (And)) +(BinaryOpIsPure (Or)) +(BinaryOpIsPure (PtrAdd)) +(UnaryOpIsPure (Not)) + + (rule ((Function _name _tyin _tyout _out) (ExprIsPure _out)) + ((ExprIsPure (Function _name _tyin _tyout _out))) + :ruleset always-run) + + (rule ((Const _n _ty _ctx)) + ((ExprIsPure (Const _n _ty _ctx))) + :ruleset always-run) + + (rule ((Top _op _x _y _z) (ExprIsPure _x) (ExprIsPure _y) (ExprIsPure _z)) + ((ExprIsPure (Top _op _x _y _z))) + :ruleset always-run) + + (rule ((Bop _op _x _y) (BinaryOpIsPure _op) (ExprIsPure _x) (ExprIsPure _y)) + ((ExprIsPure (Bop _op _x _y))) + :ruleset always-run) + + (rule ((Uop _op _x) (UnaryOpIsPure _op) (ExprIsPure _x)) + ((ExprIsPure (Uop _op _x))) + :ruleset always-run) + + (rule ((Get _tup _i) (ExprIsPure _tup)) + ((ExprIsPure (Get _tup _i))) + :ruleset always-run) + + (rule ((Concat _x _y) (ExprIsPure _x) (ExprIsPure _y)) + ((ExprIsPure (Concat _x _y))) + :ruleset always-run) + + (rule ((Single _x) (ExprIsPure _x)) + ((ExprIsPure (Single _x))) + :ruleset always-run) + + (rule ((Switch _pred _inputs _branches) (ExprIsPure _pred) (ExprIsPure _inputs) (ListExprIsPure _branches)) + ((ExprIsPure (Switch _pred _inputs _branches))) + :ruleset always-run) + + (rule ((If _pred _input _then _else) (ExprIsPure _pred) (ExprIsPure _input) (ExprIsPure _then) (ExprIsPure _else)) + ((ExprIsPure (If _pred _input _then _else))) + :ruleset always-run) + + (rule ((DoWhile _in _pred-and-output) (ExprIsPure _in) (ExprIsPure _pred-and-output)) + ((ExprIsPure (DoWhile _in _pred-and-output))) + :ruleset always-run) + + (rule ((Arg _ty _ctx)) + ((ExprIsPure (Arg _ty _ctx))) + :ruleset always-run) + + (rule ((Call _f _arg) (ExprIsPure _arg) (ExprIsPure (Function _f inty outty out))) + ((ExprIsPure (Call _f _arg))) + :ruleset always-run) + + (rule ((Empty _ty _ctx)) + ((ExprIsPure (Empty _ty _ctx))) + :ruleset always-run) + + (rule ((Cons _hd _tl) (ExprIsPure _hd) (ListExprIsPure _tl)) + ((ListExprIsPure (Cons _hd _tl))) + :ruleset always-run) + + (rule ((Nil)) + ((ListExprIsPure (Nil))) + :ruleset always-run) + +; This file provides AddContext, a helpers that copies a sub-egraph into +; a new one with a new context. +; Users of AddContext can specify how deeply to do this copy. + + +(ruleset context) + +(function AddContext (Assumption Expr) Expr :unextractable) +(function AddContextList (Assumption ListExpr) ListExpr :unextractable) + +;; ################################ saturation + +;; Adding context a second time does nothing, so union +(rule + ((= lhs (AddContext ctx inner)) + (= inner (AddContext ctx expr))) + ((union lhs inner)) + :ruleset context) + + +;; ############################## Base cases- leaf nodes + +;; replace existing contexts that are around leaf nodes +;; AddContext assumes the new context is more specific than the old one +(rule ((= lhs (AddContext ctx (Arg ty oldctx)))) + ((union lhs (Arg ty ctx))) + :ruleset context) +(rule ((= lhs (AddContext ctx (Const c ty oldctx)))) + ((union lhs (Const c ty ctx))) + :ruleset context) +(rule ((= lhs (AddContext ctx (Empty ty oldctx)))) + ((union lhs (Empty ty ctx))) + :ruleset context) + + + + +;; ######################################### Operators +(rewrite (AddContext ctx (Bop op c1 c2)) + (Bop op + (AddContext ctx c1) + (AddContext ctx c2)) + :ruleset context) +(rewrite (AddContext ctx (Uop op c1)) + (Uop op (AddContext ctx c1)) + :ruleset context) +(rewrite (AddContext ctx (Get c1 index)) + (Get (AddContext ctx c1) index) + :ruleset context) +(rewrite (AddContext ctx (Alloc id c1 state ty)) + (Alloc id (AddContext ctx c1) (AddContext ctx state) ty) + :ruleset context) +(rewrite (AddContext ctx (Call name c1)) + (Call name (AddContext ctx c1)) + :ruleset context) + +(rewrite (AddContext ctx (Single c1)) + (Single (AddContext ctx c1)) + :ruleset context) +(rewrite (AddContext ctx (Concat c1 c2)) + (Concat + (AddContext ctx c1) + (AddContext ctx c2)) + :ruleset context) + +;; ################################### List operators + +(rewrite (AddContextList ctx (Nil)) + (Nil) + :ruleset context) + +(rewrite (AddContextList ctx (Cons c1 rest)) + (Cons (AddContext ctx c1) + (AddContextList ctx rest)) + :ruleset context) + + +;; ########################################## Control flow +(rewrite (AddContext ctx (Switch pred inputs branches)) + (Switch (AddContext ctx pred) + (AddContext ctx inputs) + branches) + :ruleset context) + +;; For stop at region, still add context to inputs +(rule ((= lhs (AddContext ctx (If pred inputs c1 c2)))) + ((union lhs + (If (AddContext ctx pred) + (AddContext ctx inputs) + c1 + c2))) + :ruleset context) + + +;; For stop at loop, still add context to inputs +(rule ((= lhs (AddContext ctx (DoWhile inputs outputs)))) + ((union lhs + (DoWhile + (AddContext ctx inputs) + outputs))) + :ruleset context) + + +;; Substitution rules allow for substituting some new expression for the argument +;; in some new context. +;; It performs the substitution, copying over the equalities from the original eclass. +;; It only places context on the leaf nodes. + +(ruleset subst) +(ruleset apply-subst-unions) +(ruleset cleanup-subst) + +;; (Subst assumption to in) substitutes `to` for `(Arg ty)` in `in`. +;; It also replaces the leaf context in `to` with `assumption` using `AddContext`. +;; `assumption` *justifies* this substitution, as the context that the result is used in. +;; In other words, it must refine the equivalence relation of `in` with `to` as the argument. +(function Subst (Assumption Expr Expr) Expr :unextractable) + +;; Used to delay unions for the subst ruleset. +;; This is necessary because substitution may not terminate if it can +;; observe its own results- it may create infinitly large terms. +;; Instead, we phase substitution by delaying resulting unions in this table. +;; After applying this table, substitutions and this table are cleared. +(function DelayedSubstUnion (Expr Expr) Expr :unextractable) + +;; add a type rule to get the arg type of a substitution +;; this enables nested substitutions +(rule ((= lhs (Subst assum to in)) + (HasArgType to ty)) + ((HasArgType lhs ty)) + :ruleset subst) + +;; leaf node with context +;; replace this context- subst assumes the context is more specific +(rule ((= lhs (Subst assum to (Arg ty oldctx))) + ) + ;; add the assumption `to` + ((DelayedSubstUnion lhs (AddContext assum to))) + :ruleset subst) +(rule ((= lhs (Subst assum to (Const c ty oldctx))) + (HasArgType to newty)) + ((DelayedSubstUnion lhs (Const c newty assum))) + :ruleset subst) +(rule ((= lhs (Subst assum to (Empty ty oldctx))) + (HasArgType to newty)) + ((DelayedSubstUnion lhs (Empty newty assum))) + :ruleset subst) + +;; Operators +(rule ((= lhs (Subst assum to (Bop op c1 c2))) + (ExprIsResolved (Bop op c1 c2))) + ((DelayedSubstUnion lhs + (Bop op (Subst assum to c1) + (Subst assum to c2)))) + :ruleset subst) +(rule ((= lhs (Subst assum to (Uop op c1))) + (ExprIsResolved (Uop op c1))) + ((DelayedSubstUnion lhs + (Uop op (Subst assum to c1)))) + :ruleset subst) + +(rule ((= lhs (Subst assum to (Get c1 index))) + (ExprIsResolved (Get c1 index))) + ((DelayedSubstUnion lhs + (Get (Subst assum to c1) index))) + :ruleset subst) +(rule ((= lhs (Subst assum to (Alloc id c1 c2 ty))) + (ExprIsResolved (Alloc id c1 c2 ty))) + ((DelayedSubstUnion lhs + (Alloc id (Subst assum to c1) + (Subst assum to c2) + ty))) + :ruleset subst) +(rule ((= lhs (Subst assum to (Call name c1))) + (ExprIsResolved (Call name c1))) + ((DelayedSubstUnion lhs + (Call name (Subst assum to c1)))) + :ruleset subst) + + +;; Tuple operators +(rule ((= lhs (Subst assum to (Single c1))) + (ExprIsResolved (Single c1))) + ((DelayedSubstUnion lhs + (Single (Subst assum to c1)))) + :ruleset subst) +(rule ((= lhs (Subst assum to (Concat c1 c2))) + (ExprIsResolved (Concat c1 c2))) + ((DelayedSubstUnion lhs + (Concat (Subst assum to c1) + (Subst assum to c2)))) + :ruleset subst) + +;; Control flow +(rule ((= lhs (Subst assum to inner)) + (= inner (Switch pred inputs c1)) + (ExprIsResolved inner)) + ((DelayedSubstUnion lhs + (Switch (Subst assum to pred) + (Subst assum to inputs) + c1))) + :ruleset subst) +(rule ((= lhs (Subst assum to inner)) + (= inner (If pred inputs c1 c2)) + (ExprIsResolved inner)) + ((DelayedSubstUnion lhs + (If (Subst assum to pred) + (Subst assum to inputs) + c1 + c2))) + :ruleset subst) +(rule ((= lhs (Subst assum to (DoWhile in out))) + (ExprIsResolved (DoWhile in out))) + ((DelayedSubstUnion lhs + (DoWhile (Subst assum to in) + out))) + :ruleset subst) + +;; substitute into function (convenience for testing) +(rewrite (Subst assum to (Function name inty outty body)) + (Function name inty outty (Subst assum to body)) + :when ((ExprIsResolved body)) + :ruleset subst) + + + +;; ########################### Apply subst unions + +(rule ((DelayedSubstUnion lhs rhs)) + ((union lhs rhs)) + :ruleset apply-subst-unions) + + +;; ########################### Cleanup subst and DelayedSubstUnion + +(rule ((DelayedSubstUnion lhs rhs)) + ((subsume (DelayedSubstUnion lhs rhs))) + :ruleset cleanup-subst) + +; this cleanup is important- if we don't subsume these substitutions, they +; may oberve their own results and create infinitely sized terms. +; ex: get(parallel!(arg(), int(2)), 0) ignores the first element of the tuple +; so it's equivalent to infinite other times with any other value as the first element of the tuple. +; Check ExprIsResolved to confirm that the substitution finished (all sub-substitutions are done). +(rule ((ExprIsResolved (Subst assum to in))) + ((subsume (Subst assum to in))) + :ruleset cleanup-subst) + +; We only have context for Exprs, not ListExprs. +(relation ContextOf (Expr Assumption)) + +(rule ((Arg ty ctx)) + ((ContextOf (Arg ty ctx) ctx)) + :ruleset always-run) +(rule ((Const c ty ctx)) + ((ContextOf (Const c ty ctx) ctx)) + :ruleset always-run) +(rule ((Empty ty ctx)) + ((ContextOf (Empty ty ctx) ctx)) + :ruleset always-run) + +; Error checking - each expr should only have a single context +(rule ((ContextOf x ctx1) + (ContextOf x ctx2) + (!= ctx1 ctx2)) + ( + (panic "Equivalent expressions have nonequivalent context, breaking the single context invariant.") + ) + :ruleset error-checking) + + +(rule ((Top op x y z) (ContextOf x ctx)) + ((ContextOf (Top op x y z) ctx)) :ruleset always-run) + +(rule ((Top op x y z) (ContextOf y ctx)) + ((ContextOf (Top op x y z) ctx)) :ruleset always-run) + +(rule ((Top op x y z) (ContextOf z ctx)) + ((ContextOf (Top op x y z) ctx)) :ruleset always-run) + +(rule ((Bop op x y) (ContextOf x ctx)) + ((ContextOf (Bop op x y) ctx)) :ruleset always-run) + +(rule ((Bop op x y) (ContextOf y ctx)) + ((ContextOf (Bop op x y) ctx)) :ruleset always-run) + +(rule ((Uop op x) (ContextOf x ctx)) + ((ContextOf (Uop op x) ctx)) :ruleset always-run) + +(rule ((Get tup i) (ContextOf tup ctx)) + ((ContextOf (Get tup i) ctx)) :ruleset always-run) + +(rule ((Concat x y) (ContextOf x ctx)) + ((ContextOf (Concat x y) ctx)) :ruleset always-run) + +(rule ((Concat x y) (ContextOf y ctx)) + ((ContextOf (Concat x y) ctx)) :ruleset always-run) + +(rule ((Single x) (ContextOf x ctx)) + ((ContextOf (Single x) ctx)) :ruleset always-run) + +(rule ((Switch pred inputs branches) (ContextOf pred ctx)) + ((ContextOf (Switch pred inputs branches) ctx)) :ruleset always-run) + +(rule ((If pred inputs then else) (ContextOf pred ctx)) + ((ContextOf (If pred inputs then else) ctx)) :ruleset always-run) + +(rule ((If pred inputs then else) (ContextOf inputs ctx)) + ((ContextOf (If pred inputs then else) ctx)) :ruleset always-run) + +(rule ((DoWhile in pred-and-output) (ContextOf in ctx)) + ((ContextOf (DoWhile in pred-and-output) ctx)) :ruleset always-run) + +(rule ((Call func arg) (ContextOf arg ctx)) + ((ContextOf (Call func arg) ctx)) :ruleset always-run) + +(rule ((Alloc amt e state ty) (ContextOf e ctx)) + ((ContextOf (Alloc amt e state ty) ctx)) :ruleset always-run) + +(rule ((Alloc amt e state ty) (ContextOf state ctx)) + ((ContextOf (Alloc amt e state ty) ctx)) :ruleset always-run) + +(ruleset canon) + +; Commutativity +(rewrite (Bop (Add) x y) (Bop (Add) y x) :ruleset canon) +(rewrite (Bop (Mul) x y) (Bop (Mul) y x) :ruleset canon) +(rewrite (Bop (Eq) x y) (Bop (Eq) y x) :ruleset canon) +(rewrite (Bop (And) x y) (Bop (And) y x) :ruleset canon) +(rewrite (Bop (Or) x y) (Bop (Or) y x) :ruleset canon) + +; Canonicalize to < +; x > y ==> y < x +(rewrite (Bop (GreaterThan) x y) (Bop (LessThan) y x) :ruleset canon) + +; x >= y ==> y < x + 1 +; x >= y ==> y - 1 < x +(rule ( + (= lhs (Bop (GreaterEq) x y)) + (HasArgType x ty) + (ContextOf lhs ctx) + ) + ( + (union lhs (Bop (LessThan) y (Bop (Add) x (Const (Int 1) ty ctx)))) + (union lhs (Bop (LessThan) (Bop (Sub) y (Const (Int 1) ty ctx)) x)) + ) + :ruleset canon) + +; x <= y ==> x < y + 1 +; x <= y ==> x - 1 < y +(rule ( + (= lhs (Bop (LessEq) x y)) + (HasArgType y ty) + (ContextOf lhs ctx) + ) + ( + (union lhs (Bop (LessThan) x (Bop (Add) y (Const (Int 1) ty ctx)))) + (union lhs (Bop (LessThan) (Bop (Sub) x (Const (Int 1) ty ctx)) y)) + ) + :ruleset canon) + + +; Make Concats right-deep +(rewrite (Concat (Concat a b) c) + (Concat a (Concat b c)) + :ruleset always-run) +; Simplify Concat's with empty +(rewrite (Concat (Empty ty ctx) x) + x + :ruleset always-run) +(rewrite (Concat x (Empty ty ctx)) + x + :ruleset always-run) + +; Make a tuple that is a sub-range of another tuple +; tuple start len +(function SubTuple (Expr i64 i64) Expr :unextractable) + +(rewrite (SubTuple expr x 0) + (Empty ty ctx) + :when ((HasArgType expr ty) (ContextOf expr ctx)) + :ruleset always-run) + +(rewrite (SubTuple expr x 1) + (Single (Get expr x)) + :ruleset always-run) + +(rewrite (SubTuple expr a b) + (Concat (Single (Get expr a)) (SubTuple expr (+ a 1) (- b 1))) + :when ((> b 1)) + :ruleset always-run) + +; Helper functions to remove one element from a tuple or type list +; tuple idx +(function TupleRemoveAt (Expr i64) Expr :unextractable) +(function TypeListRemoveAt (TypeList i64) TypeList :unextractable) + +(rewrite (TupleRemoveAt tuple idx) + (Concat (SubTuple tuple 0 idx) + (SubTuple tuple (+ idx 1) (- len (+ idx 1)))) + :when ((= len (tuple-length tuple))) + :ruleset always-run) + +(rewrite (TypeListRemoveAt (TNil) _idx) (TNil) :ruleset always-run) +(rewrite (TypeListRemoveAt (TCons x xs) 0 ) xs :ruleset always-run) +(rewrite (TypeListRemoveAt (TCons x xs) idx) + (TCons x (TypeListRemoveAt xs (- idx 1))) + :when ((> idx 0)) + :ruleset always-run) + +;; Compute the tree size of program, not dag size +(function Expr-size (Expr) i64 :unextractable :merge (min old new) ) +(function ListExpr-size (ListExpr) i64 :unextractable :merge (min old new)) + +(rule ((= expr (Function name tyin tyout out)) + (= sum (Expr-size out))) + ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) + +(rule ((= expr (Const n ty assum))) + ((set (Expr-size expr) 1)) :ruleset always-run) + +(rule ((= expr (Bop op x y)) + (= sum (+ (Expr-size y) (Expr-size x)))) + ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) + +(rule ((= expr (Uop op x)) + (= sum (Expr-size x))) + ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) + +(rule ((= expr (Get tup i)) + (= sum (Expr-size tup))) + ((set (Expr-size expr) sum)) :ruleset always-run) + +(rule ((= expr (Concat x y)) + (= sum (+ (Expr-size y) (Expr-size x)))) + ((set (Expr-size expr) sum)) :ruleset always-run) + +(rule ((= expr (Single x)) + (= sum (Expr-size x))) + ((set (Expr-size expr) sum)) :ruleset always-run) + +(rule ((= expr (Switch pred inputs branches)) + (= sum (+ (Expr-size inputs) (+ (ListExpr-size branches) (Expr-size pred))))) + ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) + +(rule ((= expr (If pred inputs then else)) + (= sum (+ (Expr-size inputs) (+ (Expr-size else) (+ (Expr-size then) (Expr-size pred)))))) + ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) + +(rule ((= expr (DoWhile in pred-and-output)) + (= sum (+ (Expr-size pred-and-output) (Expr-size in)))) + ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) + +(rule ((= expr (Arg ty assum))) + ((set (Expr-size expr) 1)) :ruleset always-run) + +(rule ((= expr (Call func arg)) + (= sum (Expr-size arg))) + ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) + +(rule ((Empty ty assum)) ((set (Expr-size (Empty ty assum)) 0)) :ruleset always-run) + +(rule ((= expr (Cons hd tl)) + (= sum (+ (ListExpr-size tl) (Expr-size hd)))) + ((set (ListExpr-size expr) sum)) :ruleset always-run) + +(rule ((Nil)) + ((set (ListExpr-size (Nil)) 0)) :ruleset always-run) + +(rule ((= expr (Alloc id e state ty)) ;; do state edge's expr should be counted? + (= sum (Expr-size e))) + ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) +;; Like Subst but for dropping inputs to a region +;; See subst.egg for more implementation documentation + +(ruleset drop) +(ruleset apply-drop-unions) +(ruleset cleanup-drop) + +;; (DropAt ctx idx in) removes all references to `(Get (Arg ...) idx)` in `in`. +;; It also replaces the leaf contexts with `ctx` and fixes up argument types, +;; as well as updating `(Get (Arg ...) j)` to `(Get (Arg ...) (- j 1))` for j > idx. +(function DropAt (Assumption i64 Expr) Expr :unextractable) +(function DelayedDropUnion (Expr Expr) Expr :unextractable) + +;; Helper that precomputes the arg type that we need +(function DropAtInternal (Type Assumption i64 Expr) Expr :unextractable) +(rule ((= lhs (DropAt ctx idx in)) + (HasArgType in (TupleT oldty))) + + ((let newty (TupleT (TypeListRemoveAt oldty idx))) + (union lhs (DropAtInternal newty ctx idx in))) + :ruleset drop) + +;; Leaves +(rule ((= lhs (DropAtInternal newty newctx idx (Const c oldty oldctx)))) + ((DelayedDropUnion lhs (Const c newty newctx))) + :ruleset drop) +(rule ((= lhs (DropAtInternal newty newctx idx (Empty oldty oldctx)))) + ((DelayedDropUnion lhs (Empty newty newctx))) + :ruleset drop) +; get stuck on purpose if `i = idx` or if we find a bare `Arg` +(rule ((= lhs (DropAtInternal newty newctx idx (Get (Arg oldty oldctx) i))) + (< i idx)) + ((DelayedDropUnion lhs (Get (Arg newty newctx) i))) + :ruleset drop) +(rule ((= lhs (DropAtInternal newty newctx idx (Get (Arg oldty oldctx) i))) + (> i idx)) + ((DelayedDropUnion lhs (Get (Arg newty newctx) (- i 1)))) + :ruleset drop) + +;; Operators +(rule ((= lhs (DropAtInternal newty newctx idx (Bop op c1 c2))) + (ExprIsResolved (Bop op c1 c2))) + ((DelayedDropUnion lhs (Bop op + (DropAtInternal newty newctx idx c1) + (DropAtInternal newty newctx idx c2)))) + :ruleset drop) + +(rule ((= lhs (DropAtInternal newty newctx idx (Uop op c1))) + (ExprIsResolved (Uop op c1))) + ((DelayedDropUnion lhs (Uop op + (DropAtInternal newty newctx idx c1)))) + :ruleset drop) + +;; this is okay because we get stuck at `Arg`s +(rule ((= lhs (DropAtInternal newty newctx idx (Get c1 index))) + (ExprIsResolved (Get c1 index))) + ((DelayedDropUnion lhs (Get + (DropAtInternal newty newctx idx c1) + index))) + :ruleset drop) + +(rule ((= lhs (DropAtInternal newty newctx idx (Alloc id c1 c2 ty))) + (ExprIsResolved (Alloc id c1 c2 ty))) + ((DelayedDropUnion lhs (Alloc id + (DropAtInternal newty newctx idx c1) + (DropAtInternal newty newctx idx c2) + ty))) + :ruleset drop) + +(rule ((= lhs (DropAtInternal newty newctx idx (Call name c1))) + (ExprIsResolved (Call name c1))) + ((DelayedDropUnion lhs (Call name + (DropAtInternal newty newctx idx c1)))) + :ruleset drop) + +;; Tuple operators +(rule ((= lhs (DropAtInternal newty newctx idx (Single c1))) + (ExprIsResolved (Single c1))) + ((DelayedDropUnion lhs (Single + (DropAtInternal newty newctx idx c1)))) + :ruleset drop) + +(rule ((= lhs (DropAtInternal newty newctx idx (Concat c1 c2))) + (ExprIsResolved (Concat c1 c2))) + ((DelayedDropUnion lhs (Concat + (DropAtInternal newty newctx idx c1) + (DropAtInternal newty newctx idx c2)))) + :ruleset drop) + +;; Control flow +(rule ((= lhs (DropAtInternal newty newctx idx (Switch pred inputs c1))) + (ExprIsResolved (Switch pred inputs c1))) + ((DelayedDropUnion lhs (Switch + (DropAtInternal newty newctx idx pred) + (DropAtInternal newty newctx idx inputs) + c1))) + :ruleset drop) + +(rule ((= lhs (DropAtInternal newty newctx idx (If pred inputs c1 c2))) + (ExprIsResolved (If pred inputs c1 c2))) + ((DelayedDropUnion lhs (If + (DropAtInternal newty newctx idx pred) + (DropAtInternal newty newctx idx inputs) + c1 + c2))) + :ruleset drop) + +(rule ((= lhs (DropAtInternal newty newctx idx (DoWhile in out))) + (ExprIsResolved (DoWhile in out))) + ((DelayedDropUnion lhs (DoWhile + (DropAtInternal newty newctx idx in) + out))) + :ruleset drop) + +(rewrite (DropAtInternal newty newctx idx (Function name inty outty body)) + (Function name inty outty (DropAtInternal newty newctx idx body)) + :when ((ExprIsResolved body)) + :ruleset drop) + + + +;; ########################### Apply drop unions + +(rule ((DelayedDropUnion lhs rhs)) + ((union lhs rhs)) + :ruleset apply-drop-unions) + +;; ########################### Cleanup Dropat, DropAtInternal and DelayedDropUnion + +(rule ((ExprIsResolved (DropAt newctx idx in))) + ((subsume (DropAt newctx idx in))) + :ruleset cleanup-drop) + +(rule ((ExprIsResolved (DropAtInternal newty newctx idx in))) + ((subsume (DropAtInternal newty newctx idx in))) + :ruleset cleanup-drop) + +(rule ((DelayedDropUnion lhs rhs)) + ((subsume (DelayedDropUnion lhs rhs))) + :ruleset cleanup-drop) + +(ruleset interval-analysis) + +(datatype Bound + (IntB i64) + (BoolB bool) + (bound-max Bound Bound) + (bound-min Bound Bound)) + +; bound tables +(function lo-bound (Expr) Bound :unextractable :merge (bound-max old new)) +(function hi-bound (Expr) Bound :unextractable :merge (bound-min old new)) + +; if lo > hi, panic +; We can't run these rules because unreachable branches may have impossible intervals +; Consider re-enabling these rules if we implement an is-reachable analysis +; (rule ( +; (= (IntB lo) (lo-bound expr)) +; (= (IntB hi) (hi-bound expr)) +; (> lo hi) +; ) +; ((panic "lo bound greater than hi bound")) +; :ruleset interval-analysis) +; (rule ( +; (= (BoolB true) (lo-bound expr)) +; (= (BoolB false) (hi-bound expr)) +; ) +; ((panic "lo bound greater than hi bound")) +; :ruleset interval-analysis) + +; combinators +(rewrite (bound-max (IntB x) (IntB y)) + (IntB (max x y)) + :ruleset interval-analysis) +(rewrite (bound-min (IntB x) (IntB y)) + (IntB (min x y)) + :ruleset interval-analysis) +(rewrite (bound-max (BoolB x) (BoolB y)) + (BoolB (or x y)) + :ruleset interval-analysis) +(rewrite (bound-min (BoolB x) (BoolB y)) + (BoolB (and x y)) + :ruleset interval-analysis) + +; ================================= +; Constants +; ================================= +(rule ((= lhs (Const (Int x) ty ctx))) + ( + (set (lo-bound lhs) (IntB x)) + (set (hi-bound lhs) (IntB x)) + ) + :ruleset interval-analysis) + +(rule ((= lhs (Const (Bool x) ty ctx))) + ( + (set (lo-bound lhs) (BoolB x)) + (set (hi-bound lhs) (BoolB x)) + ) + :ruleset interval-analysis) + +; ================================= +; Constant Folding +; ================================= +(rule ( + (= (IntB x) (lo-bound expr)) + (= (IntB x) (hi-bound expr)) + (HasArgType expr ty) + (ContextOf expr ctx) + ) + ((union expr (Const (Int x) ty ctx))) + :ruleset interval-analysis) + +(rule ( + (= (BoolB x) (lo-bound expr)) + (= (BoolB x) (hi-bound expr)) + (HasArgType expr ty) + (ContextOf expr ctx) + ) + ((union expr (Const (Bool x) ty ctx))) + :ruleset interval-analysis) + +; lower bound being true means the bool must be true +(rule ( + (= (BoolB true) (lo-bound expr)) + (HasArgType expr ty) + (ContextOf expr ctx) + ) + ((union expr (Const (Bool true) ty ctx))) + :ruleset interval-analysis) + +; upper bound being false means the bool must be false +(rule ( + (= (BoolB false) (hi-bound expr)) + (HasArgType expr ty) + (ContextOf expr ctx) + ) + ((union expr (Const (Bool false) ty ctx))) + :ruleset interval-analysis) + +; ================================= +; Arithmetic +; ================================= +; + a b interval is (+ la lb) (+ ha hb) +(rule ( + (= lhs (Bop (Add) a b)) + (= (IntB la) (lo-bound a)) + (= (IntB lb) (lo-bound b)) + ) + ((set (lo-bound lhs) (IntB (+ la lb)))) + :ruleset interval-analysis) +(rule ( + (= lhs (Bop (Add) a b)) + (= (IntB ha) (hi-bound a)) + (= (IntB hb) (hi-bound b)) + ) + ((set (hi-bound lhs) (IntB (+ ha hb)))) + :ruleset interval-analysis) + +; - a b interval is (- la hb) (- ha lb) +(rule ( + (= lhs (Bop (Sub) a b)) + (= (IntB la) (lo-bound a)) + (= (IntB hb) (hi-bound b)) + ) + ((set (lo-bound lhs) (IntB (- la hb)))) + :ruleset interval-analysis) +(rule ( + (= lhs (Bop (Sub) a b)) + (= (IntB ha) (hi-bound a)) + (= (IntB lb) (lo-bound b)) + ) + ((set (hi-bound lhs) (IntB (- ha lb)))) + :ruleset interval-analysis) + +; Multiplication for two constants +; TODO: Make fancier interval analysis +(rule ( + (= lhs (Bop (Mul) a b)) + (= (IntB x) (lo-bound a)) + (= (IntB x) (hi-bound a)) + (= (IntB y) (lo-bound b)) + (= (IntB y) (hi-bound b)) + ) + ( + (set (lo-bound lhs) (IntB (* x y))) + (set (hi-bound lhs) (IntB (* x y))) + ) + :ruleset interval-analysis) + +; negative * negative is positive +(rule ( + (= lhs (Bop (Mul) x y)) + (= (IntB hi-x) (hi-bound x)) + (= (IntB hi-y) (hi-bound y)) + (<= hi-x 0) + (<= hi-y 0) + ) + ((set (lo-bound lhs) (IntB 0))) + :ruleset interval-analysis) + +; negative * positive is negative +(rule ( + (= lhs (Bop (Mul) x y)) + (= (IntB hi-x) (hi-bound x)) + (= (IntB lo-y) (lo-bound y)) + (<= hi-x 0) ; x <= 0 (x is negative) + (>= lo-y 0) ; y >= 0 (y is positive) + ) + ((set (hi-bound lhs) (IntB 0))) + :ruleset interval-analysis) + +; positive * positive is positive +(rule ( + (= lhs (Bop (Mul) x y)) + (= (IntB lo-x) (lo-bound x)) + (= (IntB lo-y) (lo-bound y)) + (>= lo-x 0) + (>= lo-y 0) + ) + ((set (lo-bound lhs) (IntB 0))) + :ruleset interval-analysis) + +; < a b interval is (< ha lb) (< la hb) +(rule ( + (= lhs (Bop (LessThan) a b)) + (= (IntB ha) (hi-bound a)) + (= (IntB lb) (lo-bound b)) + ) + ( + (set (lo-bound lhs) (BoolB (bool-< ha lb))) + ) + :ruleset interval-analysis) +(rule ( + (= lhs (Bop (LessThan) a b)) + (= (IntB la) (lo-bound a)) + (= (IntB hb) (hi-bound b)) + ) + ((set (hi-bound lhs) (BoolB (bool-< la hb)))) + :ruleset interval-analysis) + +; ================================= +; Conditionals +; ================================= +; if the predicate is true, merge with then branch +(rule ( + (= lhs (If cond inputs thn els)) + (ContextOf lhs if_ctx) + (= (BoolB true) (lo-bound cond)) + ) + ((union lhs (Subst if_ctx inputs thn))) + :ruleset interval-analysis) + +; if the predicate is false, merge with else branch +(rule ( + (= lhs (If cond inputs thn els)) + (ContextOf lhs if_ctx) + (= (BoolB false) (hi-bound cond)) + ) + ((union lhs (Subst if_ctx inputs els))) + :ruleset interval-analysis) + +; lo-bound of If is the min of the lower bounds +; hi-bound of If is the max of the upper bounds +(rule ( + (= lhs (If cond inputs thn els)) + (= lo-thn (lo-bound thn)) + (= lo-els (lo-bound els)) + ) + ((set (lo-bound lhs) (bound-min lo-thn lo-els))) + :ruleset interval-analysis) +(rule ( + (= lhs (If cond inputs thn els)) + (= hi-thn (hi-bound thn)) + (= hi-els (hi-bound els)) + ) + ((set (hi-bound lhs) (bound-max hi-thn hi-els))) + :ruleset interval-analysis) + +; Same rules, but for Ifs that have multiple outputs +(rule ( + (= lhs (Get (If pred inputs thn els) i)) + (= lo-thn (lo-bound (Get thn i))) + (= lo-els (lo-bound (Get els i))) + ) + ((set (lo-bound lhs) (bound-min lo-thn lo-els))) + :ruleset interval-analysis) +(rule ( + (= lhs (Get (If cond inputs thn els) i)) + (= hi-thn (hi-bound (Get thn i))) + (= hi-els (hi-bound (Get els i))) + ) + ((set (hi-bound lhs) (bound-max hi-thn hi-els))) + :ruleset interval-analysis) + +; If the If takes a tuple +(rule ( + ; expr < value + (= pred (Bop (LessThan) expr value)) + (= if_e (If pred inputs then else)) + ; the left operand of the < is an input to the if region + (= expr (Get inputs i)) + ; the right operand of the < has an upper bound + (= (IntB v) (hi-bound value)) + ; context node inside the if region + (= ctx (Arg ty (InIf true pred inputs))) + (HasType inputs ty) + ) + ; expr < value was true, so we know expr is at most (hi-bound value) - 1 + ((set (hi-bound (Get ctx i)) (IntB (- v 1)))) + :ruleset interval-analysis) +(rule ( + ; expr < value + (= pred (Bop (LessThan) expr value)) + (= if_e (If pred inputs then else)) + ; the left operand of the < is an input to the if region + (= expr (Get inputs i)) + ; the right operand of the < has a lower bound + (= (IntB v) (lo-bound value)) + ; context node inside the if region + (= ctx (Arg ty (InIf false pred inputs))) + (HasType inputs ty) + ) + ; expr < value was false, so we know expr is at least (lo-bound value) + ((set (lo-bound (Get ctx i)) (IntB v))) + :ruleset interval-analysis) + +(rule ( + ; value < expr + (= pred (Bop (LessThan) value expr)) + (= if_e (If pred inputs then else)) + ; the right operand of the < is an input to the if region + (= expr (Get inputs i)) + ; the left operand of the < has a lower bound + (= (IntB v) (lo-bound value)) + ; context node inside the if region + (= ctx (Arg ty (InIf true pred inputs))) + (HasType inputs ty) + ) + ; value < expr was true, so we know expr is at least (lo-bound value) + 1 + ((set (lo-bound (Get ctx i)) (IntB (+ v 1)))) + :ruleset interval-analysis) +(rule ( + ; value < expr + (= pred (Bop (LessThan) value expr)) + (= if_e (If pred inputs then else)) + ; the right operand of the < is an input to the if region + (= expr (Get inputs i)) + ; the left operand of the < has an upper bound + (= (IntB v) (hi-bound value)) + ; context node inside the if region + (= ctx (Arg ty (InIf false pred inputs))) + (HasType inputs ty) + ) + ; value < expr was false, so we know expr is at most (hi-bound value) + ((set (hi-bound (Get ctx i)) (IntB v))) + :ruleset interval-analysis) + +;; Push intervals for inputs into if region +(rule ( + (= if (If pred inputs then_ else_)) + (= ctx (Arg ty (InIf b pred inputs))) + (HasType inputs ty) + (= lo (lo-bound (Get inputs i))) + + ) + ((set (lo-bound (Get ctx i)) lo)) + :ruleset interval-analysis) +(rule ( + (= if (If pred inputs then_ else_)) + (= ctx (Arg ty (InIf b pred inputs))) + (HasType inputs ty) + (= hi (hi-bound (Get inputs i))) + + ) + ((set (hi-bound (Get ctx i)) hi)) + :ruleset interval-analysis) + +; (if (a == b) thn els) +; in the thn branch, we know that a has the same bounds as b +(rule ( + (= pred (Bop (Eq) expr val)) + (= if_e (If pred inputs thn els)) + ; the left operand of the == is an input to the if region + (= expr (Get inputs i)) + (= ctx (Arg ty (InIf true pred inputs))) + (HasType inputs ty) + (= (IntB lo) (lo-bound val)) + ) + ((set (lo-bound (Get ctx i)) (IntB lo))) + :ruleset interval-analysis) +(rule ( + (= pred (Bop (Eq) expr val)) + (= if_e (If pred inputs thn els)) + ; the left operand of the == is an input to the if region + (= expr (Get inputs i)) + (= ctx (Arg ty (InIf true pred inputs))) + (HasType inputs ty) + (= (IntB hi) (hi-bound val)) + ) + ((set (hi-bound (Get ctx i)) (IntB hi))) + :ruleset interval-analysis) + + +(rule ( + ;; argument has loop context + (Arg ty (InLoop inputs outputs)) + ;; in the loop, the argument is passed through + ;; note that some_ctx is not the same as (InLoop inputs outputs) + (= (Get (Arg ty some_ctx) ith) (Get outputs (+ 1 ith))) + ;; input has some bound + (= bound (lo-bound (Get inputs ith))) + ) + ( + (set (lo-bound (Get (Arg ty (InLoop inputs outputs)) ith)) bound) + ) + :ruleset interval-analysis) +(rule ( + ;; argument has loop context + (Arg ty (InLoop inputs outputs)) + ;; in the loop, the argument is passed through + (= (Get (Arg ty some_ctx) ith) (Get outputs (+ 1 ith))) + ;; input has some bound + (= bound (hi-bound (Get inputs ith))) + ) + ( + (set (hi-bound (Get (Arg ty (InLoop inputs outputs)) ith)) bound) + ) + :ruleset interval-analysis) + + +(ruleset switch_rewrite) + +; if (a and b) X Y ~~> if a (if b X Y) Y +(rule ((= lhs (If (Bop (And) a b) ins X Y)) + (HasType ins (TupleT ins_ty)) + (= len (tuple-length ins))) + + ((let outer_ins (Concat (Single b) ins)) + (let outer_ins_ty (TupleT (TCons (BoolT) ins_ty))) + + (let inner_pred (Get (Arg outer_ins_ty (InIf true a outer_ins)) 0)) + (let sub_arg_true (SubTuple (Arg outer_ins_ty (InIf true a outer_ins)) 1 len)) + (let sub_arg_false (SubTuple (Arg outer_ins_ty (InIf false a outer_ins)) 1 len)) + + (let inner_X (AddContext (InIf true inner_pred sub_arg_true) X)) + (let inner_Y (AddContext (InIf false inner_pred sub_arg_true) Y)) + (let outer_Y (Subst (InIf false a outer_ins) sub_arg_false Y)) + + (let inner (If inner_pred sub_arg_true inner_X inner_Y)) + (union lhs (If a outer_ins inner outer_Y))) + + :ruleset switch_rewrite) + +; if (a or b) X Y ~~> if a X (if b X Y) +(rule ((= lhs (If (Bop (Or) a b) ins X Y)) + (HasType ins (TupleT ins_ty)) + (= len (tuple-length ins))) + + ((let outer_ins (Concat (Single b) ins)) + (let outer_ins_ty (TupleT (TCons (BoolT) ins_ty))) + + (let inner_pred (Get (Arg outer_ins_ty (InIf false a outer_ins)) 0)) + (let sub_arg_true (SubTuple (Arg outer_ins_ty (InIf true a outer_ins)) 1 len)) + (let sub_arg_false (SubTuple (Arg outer_ins_ty (InIf false a outer_ins)) 1 len)) + + (let outer_X (Subst (InIf true a outer_ins) sub_arg_true X)) + (let inner_X (AddContext (InIf true inner_pred sub_arg_false) X)) + (let inner_Y (AddContext (InIf false inner_pred sub_arg_false) Y)) + + (let inner (If inner_pred sub_arg_false inner_X inner_Y)) + (union lhs (If a outer_ins outer_X inner ))) + + :ruleset switch_rewrite) + +(rewrite (If (Const (Bool true) ty ctx) ins thn els) + (Subst ctx ins thn) + :ruleset always-run) + +(rewrite (If (Const (Bool false) ty ctx) ins thn els) + (Subst ctx ins els) + :ruleset switch_rewrite) + +(rule ((= lhs (If pred ins thn els)) + (= (Get thn i) (Const (Bool true) ty ctx1)) + (= (Get els i) (Const (Bool false) ty ctx2))) + ((union (Get lhs i) pred)) :ruleset switch_rewrite) + +(rule ((= lhs (If pred ins thn els)) + (= (Get thn i) (Const (Bool false) ty ctx1)) + (= (Get els i) (Const (Bool true) ty ctx2))) + ((union (Get lhs i) (Uop (Not) pred))) :ruleset switch_rewrite) + +; Simple rewrites that don't do a ton with control flow. + +(ruleset peepholes) + +(rewrite (Bop (Mul) (Const (Int 0) ty ctx) e) (Const (Int 0) ty ctx) :ruleset peepholes) +(rewrite (Bop (Mul) e (Const (Int 0) ty ctx)) (Const (Int 0) ty ctx) :ruleset peepholes) +(rewrite (Bop (Mul) (Const (Int 1) ty ctx) e) e :ruleset peepholes) +(rewrite (Bop (Mul) e (Const (Int 1) ty ctx)) e :ruleset peepholes) +(rewrite (Bop (Add) (Const (Int 0) ty ctx) e) e :ruleset peepholes) +(rewrite (Bop (Add) e (Const (Int 0) ty ctx) ) e :ruleset peepholes) + +(rewrite (Bop (Mul) (Const (Int j) ty ctx) (Const (Int i) ty ctx)) (Const (Int (* i j)) ty ctx) :ruleset peepholes) +(rewrite (Bop (Add) (Const (Int j) ty ctx) (Const (Int i) ty ctx)) (Const (Int (+ i j)) ty ctx) :ruleset peepholes) + +(rewrite (Bop (And) (Const (Bool true) ty ctx) e) e :ruleset peepholes) +(rewrite (Bop (And) e (Const (Bool true) ty ctx)) e :ruleset peepholes) +(rewrite (Bop (And) (Const (Bool false) ty ctx) e) (Const (Bool false) ty ctx) :ruleset peepholes) +(rewrite (Bop (And) e (Const (Bool false) ty ctx)) (Const (Bool false) ty ctx) :ruleset peepholes) +(rewrite (Bop (Or) (Const (Bool false) ty ctx) e) e :ruleset peepholes) +(rewrite (Bop (Or) e (Const (Bool false) ty ctx)) e :ruleset peepholes) +(rewrite (Bop (Or) (Const (Bool true) ty ctx) e) (Const (Bool true) ty ctx) :ruleset peepholes) +(rewrite (Bop (Or) e (Const (Bool true) ty ctx)) (Const (Bool true) ty ctx) :ruleset peepholes) + + +(datatype IntOrInfinity + (Infinity) + (NegInfinity) + (I i64)) + +(function MaxIntOrInfinity (IntOrInfinity IntOrInfinity) IntOrInfinity) +(rewrite (MaxIntOrInfinity (Infinity) _) (Infinity) :ruleset always-run) +(rewrite (MaxIntOrInfinity _ (Infinity)) (Infinity) :ruleset always-run) +(rewrite (MaxIntOrInfinity (NegInfinity) x) x :ruleset always-run) +(rewrite (MaxIntOrInfinity x (NegInfinity)) x :ruleset always-run) +(rewrite (MaxIntOrInfinity (I x) (I y)) (I (max x y)) :ruleset always-run) + +(function MinIntOrInfinity (IntOrInfinity IntOrInfinity) IntOrInfinity) +(rewrite (MinIntOrInfinity (NegInfinity) _) (NegInfinity) :ruleset always-run) +(rewrite (MinIntOrInfinity _ (NegInfinity)) (NegInfinity) :ruleset always-run) +(rewrite (MinIntOrInfinity (Infinity) x) x :ruleset always-run) +(rewrite (MinIntOrInfinity x (Infinity)) x :ruleset always-run) +(rewrite (MinIntOrInfinity (I x) (I y)) (I (min x y)) :ruleset always-run) + +(function AddIntOrInfinity (IntOrInfinity IntOrInfinity) IntOrInfinity) +(rewrite (AddIntOrInfinity (Infinity) (Infinity)) (Infinity) :ruleset always-run) +(rewrite (AddIntOrInfinity (Infinity) (I _)) (Infinity) :ruleset always-run) +(rewrite (AddIntOrInfinity (I _) (Infinity)) (Infinity) :ruleset always-run) +(rewrite (AddIntOrInfinity (NegInfinity) (NegInfinity)) (NegInfinity) :ruleset always-run) +(rewrite (AddIntOrInfinity (NegInfinity) (I _)) (NegInfinity) :ruleset always-run) +(rewrite (AddIntOrInfinity (I _) (NegInfinity)) (NegInfinity) :ruleset always-run) +(rewrite (AddIntOrInfinity (I x) (I y)) (I (+ x y)) :ruleset always-run) + +(datatype IntInterval (MkIntInterval IntOrInfinity IntOrInfinity)) + +(function UnionIntInterval (IntInterval IntInterval) IntInterval) +(rewrite (UnionIntInterval (MkIntInterval lo1 hi1) (MkIntInterval lo2 hi2)) + (MkIntInterval (MinIntOrInfinity lo1 lo2) (MaxIntOrInfinity hi1 hi2)) + :ruleset always-run) + +(function IntersectIntInterval (IntInterval IntInterval) IntInterval) +(rewrite (IntersectIntInterval (MkIntInterval lo1 hi1) (MkIntInterval lo2 hi2)) + (MkIntInterval (MaxIntOrInfinity lo1 lo2) (MinIntOrInfinity hi1 hi2)) + :ruleset always-run) + +(function AddIntInterval (IntInterval IntInterval) IntInterval) +(rewrite (AddIntInterval (MkIntInterval lo1 hi1) (MkIntInterval lo2 hi2)) + (MkIntInterval (AddIntOrInfinity lo1 lo2) + (AddIntOrInfinity hi1 hi2)) + :ruleset always-run) + + +(datatype List + (Nil-List) + (Cons-List i64 IntInterval List)) + +(function Length-List (List) i64) +(rule ((= x (Nil-List))) + ((set (Length-List x) 0)) + :ruleset always-run) +(rule ((= x (Cons-List hd0 hd1 tl)) + (= l (Length-List tl))) + ((set (Length-List x) (+ l 1))) + :ruleset always-run) +(rule ((= x (Nil-List))) + ((set (Length-List x) 0)) + :ruleset memory-helpers) +(rule ((= x (Cons-List hd0 hd1 tl)) + (= l (Length-List tl))) + ((set (Length-List x) (+ l 1))) + :ruleset memory-helpers) + +(relation IsEmpty-List (List)) +(rule ((= x (Nil-List))) + ((IsEmpty-List x)) + :ruleset always-run) + +(relation IsNonEmpty-List (List)) +(rule ((= x (Cons-List hd0 hd1 tl))) + ((IsNonEmpty-List x)) + :ruleset always-run) + +(function RevConcat-List (List List) List :cost 1000) +(rewrite (RevConcat-List (Nil-List) l) + l + :ruleset always-run) +(rewrite (RevConcat-List (Cons-List hd0 hd1 tl) l) + (RevConcat-List tl (Cons-List hd0 hd1 l)) + :ruleset always-run) + +(function Rev-List (List) List :cost 1000) +(rewrite (Rev-List m) + (RevConcat-List m (Nil-List)) + :ruleset always-run) + +(function Concat-List (List List) List :cost 1000) +(rewrite (Concat-List x y) + (RevConcat-List (Rev-List x) y) + :ruleset always-run) + +; SuffixAt and At must be demanded, otherwise these are O(N^2) +(relation DemandAt-List (List)) +(relation SuffixAt-List (List i64 List)) +(relation At-List (List i64 i64 IntInterval)) +(rule ((DemandAt-List x)) + ((SuffixAt-List x 0 x)) + :ruleset always-run) +(rule ((SuffixAt-List x i (Cons-List hd0 hd1 tl))) + ((SuffixAt-List x (+ i 1) tl) + (At-List x i hd0 hd1)) + :ruleset always-run) + +(function Union-List (List List) List) + ; The third argument of the helper is a WIP result map. + ; Invariant: keys of the result map are not present in the first two and are in descending order + (function UnionHelper-List (List List List) List) + (rewrite (Union-List m1 m2) + (Rev-List (UnionHelper-List m1 m2 (Nil-List))) + :ruleset always-run) + + ; both m1 and m2 empty + (rewrite (UnionHelper-List (Nil-List) (Nil-List) res) + res + :ruleset always-run) + ; take from m1 when m2 empty and vice versa + (rewrite + (UnionHelper-List + (Nil-List) + (Cons-List hd0 hd1 tl) + res) + (UnionHelper-List + (Nil-List) + tl + (Cons-List hd0 hd1 res)) + :ruleset always-run) + (rewrite + (UnionHelper-List + (Cons-List hd0 hd1 tl) + (Nil-List) + res) + (UnionHelper-List + tl + (Nil-List) + (Cons-List hd0 hd1 res)) + :ruleset always-run) + + ; when both nonempty and smallest key different, take smaller key + (rule ((= f (UnionHelper-List l1 l2 res)) + (= l1 (Cons-List k1 a1 tl1)) + (= l2 (Cons-List k2 b1 tl2)) + (< k1 k2)) + ((union f + (UnionHelper-List tl1 l2 (Cons-List k1 a1 res)))) + :ruleset always-run) + (rule ((= f (UnionHelper-List l1 l2 res)) + (= l1 (Cons-List k1 a1 tl1)) + (= l2 (Cons-List k2 b1 tl2)) + (< k2 k1)) + ((union f + (UnionHelper-List l1 tl2 (Cons-List k2 b1 res)))) + :ruleset always-run) + + ; when shared smallest key, union interval + (rule ((= f (UnionHelper-List l1 l2 res)) + (= l1 (Cons-List k a1 tl1)) + (= l2 (Cons-List k b1 tl2))) + ((union f + (UnionHelper-List tl1 tl2 + (Cons-List k (UnionIntInterval a1 b1) res)))) + :ruleset always-run) + +(function Intersect-List (List List) List) + ; The third argument of the helper is a WIP result map. + ; Invariant: keys of the result map are not present in the first two and are in descending order + (function IntersectHelper-List (List List List) List) + (rewrite (Intersect-List m1 m2) + (Rev-List (IntersectHelper-List m1 m2 (Nil-List))) + :ruleset always-run) + + ; m1 or m2 empty + (rewrite (IntersectHelper-List (Nil-List) m2 res) + res + :ruleset always-run) + (rewrite (IntersectHelper-List m1 (Nil-List) res) + res + :ruleset always-run) + + ; when both nonempty and smallest key different, drop smaller key + (rule ((= f (IntersectHelper-List l1 l2 res)) + (= l1 (Cons-List k1 a1 tl1)) + (= l2 (Cons-List k2 b1 tl2)) + (< k1 k2)) + ((union f (IntersectHelper-List tl1 l2 res))) + :ruleset always-run) + (rule ((= f (IntersectHelper-List l1 l2 res)) + (= l1 (Cons-List k1 a1 tl1)) + (= l2 (Cons-List k2 b1 tl2)) + (< k2 k1)) + ((union f (IntersectHelper-List tl1 l2 res))) + :ruleset always-run) + +(datatype MyBool (MyTrue) (MyFalse)) + +(function IntIntervalValid (IntInterval) MyBool) +(rewrite (IntIntervalValid (MkIntInterval (I lo) (I hi))) + (MyTrue) + :when ((<= lo hi)) + :ruleset always-run) +(rewrite (IntIntervalValid (MkIntInterval (I lo) (I hi))) + (MyFalse) + :when ((> lo hi)) + :ruleset always-run) +(rewrite (IntIntervalValid (MkIntInterval (NegInfinity) _)) + (MyTrue) + :ruleset always-run) +(rewrite (IntIntervalValid (MkIntInterval _ (Infinity))) + (MyTrue) + :ruleset always-run) + +(function ConsIfNonEmpty (i64 IntInterval List) + List + :cost 100) +(rule ((ConsIfNonEmpty k v tl)) + ((IntIntervalValid v)) + :ruleset always-run) +(rule ((= f (ConsIfNonEmpty k v tl)) + (= (MyTrue) (IntIntervalValid v))) + ((union f (Cons-List k v tl))) + :ruleset always-run) +(rule ((= f (ConsIfNonEmpty k v tl)) + (= (MyFalse) (IntIntervalValid v))) + ((union f tl)) + :ruleset always-run) + + ; when shared smallest key, intersect interval + (rule ((= f (IntersectHelper-List l1 l2 res)) + (= l1 (Cons-List k a1 tl1)) + (= l2 (Cons-List k b1 tl2))) + ((union f + (IntersectHelper-List tl1 tl2 + (ConsIfNonEmpty k (IntersectIntInterval a1 b1) res)))) + :ruleset always-run) + +(function AddIntIntervalToAll (IntInterval List) + List) +(rewrite (AddIntIntervalToAll _ (Nil-List)) + (Nil-List) + :ruleset always-run) +(rewrite (AddIntIntervalToAll x (Cons-List allocid offset tl)) + (Cons-List allocid (AddIntInterval x offset) + (AddIntIntervalToAll x tl)) + :ruleset always-run) + +(datatype PtrPointees + (PointsTo List) + (PointsAnywhere)) + +(function AddIntIntervalToPtrPointees (IntInterval PtrPointees) PtrPointees) +(rewrite (AddIntIntervalToPtrPointees interval (PointsAnywhere)) + (PointsAnywhere) + :ruleset always-run) +(rewrite (AddIntIntervalToPtrPointees interval (PointsTo l)) + (PointsTo (AddIntIntervalToAll interval l)) + :ruleset always-run) + +(function Union-PtrPointees (PtrPointees PtrPointees) PtrPointees) +(rewrite (Union-PtrPointees (PointsAnywhere) _) + (PointsAnywhere) + :ruleset always-run) +(rewrite (Union-PtrPointees _ (PointsAnywhere)) + (PointsAnywhere) + :ruleset always-run) +(rewrite (Union-PtrPointees (PointsTo x) (PointsTo y)) + (PointsTo (Union-List x y)) + :ruleset always-run) +(function Intersect-PtrPointees (PtrPointees PtrPointees) PtrPointees) +(rewrite (Intersect-PtrPointees (PointsAnywhere) x) + x + :ruleset always-run) +(rewrite (Intersect-PtrPointees x (PointsAnywhere)) + x + :ruleset always-run) +(rewrite (Intersect-PtrPointees (PointsTo x) (PointsTo y)) + (PointsTo (Intersect-List x y)) + :ruleset always-run) + +(relation PointsNowhere-PtrPointees (PtrPointees)) +(rule ((= f (PointsTo x)) + (IsEmpty-List x)) + ((PointsNowhere-PtrPointees f)) + :ruleset always-run) + + +(datatype List + (Nil-List) + (Cons-List PtrPointees List)) + +(function Length-List (List) i64) +(rule ((= x (Nil-List))) + ((set (Length-List x) 0)) + :ruleset always-run) +(rule ((= x (Cons-List hd0 tl)) + (= l (Length-List tl))) + ((set (Length-List x) (+ l 1))) + :ruleset always-run) +(rule ((= x (Nil-List))) + ((set (Length-List x) 0)) + :ruleset memory-helpers) +(rule ((= x (Cons-List hd0 tl)) + (= l (Length-List tl))) + ((set (Length-List x) (+ l 1))) + :ruleset memory-helpers) + +(relation IsEmpty-List (List)) +(rule ((= x (Nil-List))) + ((IsEmpty-List x)) + :ruleset always-run) + +(relation IsNonEmpty-List (List)) +(rule ((= x (Cons-List hd0 tl))) + ((IsNonEmpty-List x)) + :ruleset always-run) + +(function RevConcat-List (List List) List :cost 1000) +(rewrite (RevConcat-List (Nil-List) l) + l + :ruleset always-run) +(rewrite (RevConcat-List (Cons-List hd0 tl) l) + (RevConcat-List tl (Cons-List hd0 l)) + :ruleset always-run) + +(function Rev-List (List) List :cost 1000) +(rewrite (Rev-List m) + (RevConcat-List m (Nil-List)) + :ruleset always-run) + +(function Concat-List (List List) List :cost 1000) +(rewrite (Concat-List x y) + (RevConcat-List (Rev-List x) y) + :ruleset always-run) + +; SuffixAt and At must be demanded, otherwise these are O(N^2) +(relation DemandAt-List (List)) +(relation SuffixAt-List (List i64 List)) +(relation At-List (List i64 PtrPointees)) +(rule ((DemandAt-List x)) + ((SuffixAt-List x 0 x)) + :ruleset always-run) +(rule ((SuffixAt-List x i (Cons-List hd0 tl))) + ((SuffixAt-List x (+ i 1) tl) + (At-List x i hd0)) + :ruleset always-run) + +(relation All (List)) +(rule ((= x (Nil-List))) + ((All x)) + :ruleset always-run) +(rule ((= x (Cons-List hd0 tl)) + (PointsNowhere-PtrPointees hd0) + (All tl)) + ((All x)) + :ruleset always-run) + + + +(function Zip (List List) List :cost 1000) +(rewrite (Zip (Nil-List) (Nil-List)) + (Nil-List) + :ruleset always-run) +(rewrite (Zip + (Cons-List x0 tl1) + (Cons-List y0 tl2)) + (Cons-List + (Union-PtrPointees x0 y0) + (Zip tl1 tl2)) + :when ((= (Length-List tl1) (Length-List tl2))) + :ruleset always-run) + +(function Zip (List List) List :cost 1000) +(rewrite (Zip (Nil-List) (Nil-List)) + (Nil-List) + :ruleset always-run) +(rewrite (Zip + (Cons-List x0 tl1) + (Cons-List y0 tl2)) + (Cons-List + (Intersect-PtrPointees x0 y0) + (Zip tl1 tl2)) + :ruleset always-run) + + +(sort ExprSetPrim (Set Expr)) + +(datatype ExprSet (ES ExprSetPrim)) + +(function ExprSet-intersect (ExprSet ExprSet) ExprSet) +(rewrite (ExprSet-intersect (ES set1) (ES set2)) (ES (set-intersect set1 set2)) + :ruleset memory-helpers) +(function ExprSet-union (ExprSet ExprSet) ExprSet) +(rewrite (ExprSet-union (ES set1) (ES set2)) (ES (set-union set1 set2)) + :ruleset memory-helpers) +(relation ExprSet-contains (ExprSet Expr)) +(rule ((ES set1) (set-contains set1 x)) + ((ExprSet-contains (ES set1) x)) + :ruleset memory-helpers) +(function ExprSet-insert (ExprSet Expr) ExprSet) +(rewrite (ExprSet-insert (ES set1) x) + (ES (set-insert set1 x)) + :ruleset memory-helpers) +(function ExprSet-length (ExprSet) i64) +(rewrite (ExprSet-length (ES set1)) (set-length set1) :ruleset memory-helpers) + +; ============================ +; Pointees +; ============================ + + +; List is used as an association list; the i64 keys +; (corresponding to alloc ids) are always unique and sorted, the IntInterval +; values correspond to offset ranges. +; +; (TuplePointsTo [{0->[4,5], 1->[0,0]}, {0->[0,0]}]) +; indicates a tuple with two components. +; - The first component might point to Alloc 0 at offsets 4 or 5, +; or Alloc 1 at offset 0 +; - The second component points to Alloc 0 at offset 0 +(datatype Pointees + (TuplePointsTo List) + (PtrPointsTo PtrPointees)) + +(function UnwrapPtrPointsTo (Pointees) PtrPointees) +(rewrite (UnwrapPtrPointsTo (PtrPointsTo x)) + x + :ruleset memory-helpers) +(function UnwrapTuplePointsTo (Pointees) List) +(rewrite (UnwrapTuplePointsTo (TuplePointsTo x)) + x + :ruleset memory-helpers) + +(relation PointsNowhere (Pointees)) +(rule ((= f (PtrPointsTo x)) + (PointsNowhere-PtrPointees x)) + ((PointsNowhere f)) + :ruleset memory-helpers) +(rule ((= f (TuplePointsTo l)) + (All l)) + ((PointsNowhere f)) + :ruleset memory-helpers) + +(function UnionPointees (Pointees Pointees) Pointees) +(rewrite (UnionPointees (PtrPointsTo x) (PtrPointsTo y)) + (PtrPointsTo (Union-PtrPointees x y)) + :ruleset memory-helpers) +(rewrite (UnionPointees (TuplePointsTo x) (TuplePointsTo y)) + (TuplePointsTo (Zip x y)) + :when ((= (Length-List x) (Length-List y))) + :ruleset memory-helpers) +(function IntersectPointees (Pointees Pointees) Pointees) +(rewrite (IntersectPointees (PtrPointsTo x) (PtrPointsTo y)) + (PtrPointsTo (Intersect-PtrPointees x y)) + :ruleset memory-helpers) +(rewrite (IntersectPointees (TuplePointsTo x) (TuplePointsTo y)) + (TuplePointsTo (Zip x y)) + :ruleset memory-helpers) + +(function GetPointees (Pointees i64) Pointees) +(rule ((= f (GetPointees (TuplePointsTo l) i)) + (At-List l i x)) + ((union f (PtrPointsTo x))) + :ruleset memory-helpers) + +(function PointeesDropFirst (Pointees) Pointees) +(rewrite (PointeesDropFirst (TuplePointsTo (Cons-List hd tl))) + (TuplePointsTo tl) + :ruleset memory-helpers) + +; ============================ +; Resolved +; ============================ + +; Resolved checks if an e-class contains a term containing only constructors and +; primitives; i.e. whether equality is decideable +(relation Resolved-IntOrInfinity (IntOrInfinity)) +(rule ((= f (I _))) + ((Resolved-IntOrInfinity f)) + :ruleset memory-helpers) +(rule ((= f (Infinity))) + ((Resolved-IntOrInfinity f)) + :ruleset memory-helpers) +(rule ((= f (NegInfinity))) + ((Resolved-IntOrInfinity f)) + :ruleset memory-helpers) + +(relation Resolved-IntInterval (IntInterval)) +(rule ((= f (MkIntInterval lo hi)) + (Resolved-IntOrInfinity lo) + (Resolved-IntOrInfinity hi)) + ((Resolved-IntInterval f)) + :ruleset memory-helpers) + +(relation Resolved-List (List)) +(rule ((= f (Nil-List))) + ((Resolved-List f)) + :ruleset memory-helpers) +(rule ((= f (Cons-List allocid offsets tl)) + (Resolved-List tl) + (Resolved-IntInterval offsets)) + ((Resolved-List f)) + :ruleset memory-helpers) + +(relation Resolved-PtrPointees (PtrPointees)) +(rule ((= f (PointsAnywhere))) + ((Resolved-PtrPointees f)) + :ruleset memory-helpers) +(rule ((= f (PointsTo x)) + (Resolved-List x)) + ((Resolved-PtrPointees f)) + :ruleset memory-helpers) + +(relation Resolved-List (List)) +(rule ((= f (Nil-List))) + ((Resolved-List f)) + :ruleset memory-helpers) +(rule ((= f (Cons-List hd tl)) + (Resolved-List tl) + (Resolved-PtrPointees hd)) + ((Resolved-List f)) + :ruleset memory-helpers) + +(relation Resolved-Pointees (Pointees)) +(rule ((= f (TuplePointsTo x)) + (Resolved-List x)) + ((Resolved-Pointees f)) + :ruleset memory-helpers) +(rule ((= f (PtrPointsTo x)) + (Resolved-PtrPointees x)) + ((Resolved-Pointees f)) + :ruleset memory-helpers) + + +;;;;; + +(function BaseTypeToPtrPointees (BaseType) PtrPointees :cost 100) +(rewrite (BaseTypeToPtrPointees (PointerT _)) + (PointsAnywhere) + :ruleset memory-helpers) +(rewrite (BaseTypeToPtrPointees (IntT)) + (PointsTo (Nil-List)) + :ruleset memory-helpers) +(rewrite (BaseTypeToPtrPointees (StateT)) + (PointsTo (Nil-List)) + :ruleset memory-helpers) +(rewrite (BaseTypeToPtrPointees (BoolT)) + (PointsTo (Nil-List)) + :ruleset memory-helpers) + +(function TypeListToList (TypeList) List :cost 1000) +(rewrite (TypeListToList (TNil)) + (Nil-List) + :ruleset memory-helpers) +(rewrite (TypeListToList (TCons hd tl)) + (Cons-List + (BaseTypeToPtrPointees hd) + (TypeListToList tl)) + :ruleset memory-helpers) + +(function TypeToPointees (Type) Pointees :cost 1000) +(rewrite (TypeToPointees (TupleT tylist)) + (TuplePointsTo (TypeListToList tylist)) + :ruleset memory-helpers) +(rewrite (TypeToPointees (Base basety)) + (PtrPointsTo (BaseTypeToPtrPointees basety)) + :ruleset memory-helpers) + +; ============================ +; Update PointerishType +; ============================ + +(relation PointerishType (Type)) +(relation PointerishTypeList (TypeList)) + +(rule ((= f (Base (PointerT ty)))) + ((PointerishType f)) + :ruleset always-run) + +(rule ((= f (TCons (PointerT ty) tl))) + ((PointerishTypeList f)) + :ruleset always-run) + +(rule ((= f (TCons hd tl)) + (PointerishTypeList tl)) + ((PointerishTypeList f)) + :ruleset always-run) + +(rule ((= f (TupleT l)) + (PointerishTypeList l)) + ((PointerishType f)) + :ruleset always-run) + +; ============================ +; Update PointsToCells +; ============================ + +; arg pointees result pointees +(function PointsToCells (Expr Pointees) Pointees :unextractable) + +; Top-level demand +(rule ((Function name in-ty out-ty body)) + ((PointsToCells body (TypeToPointees in-ty))) + :ruleset memory-helpers) + +; Demand PointsToCells along state edge and pointer-typed values +(rule ((PointsToCells (Bop (Print) e state) ap)) + ((PointsToCells state ap)) + :ruleset memory-helpers) +(rule ((PointsToCells (Bop (Load) e state) ap)) + ((PointsToCells e ap) + (PointsToCells state ap)) + :ruleset memory-helpers) +(rule ((PointsToCells (Top (Write) ptr val state) ap)) + ((PointsToCells ptr ap) + (PointsToCells state ap)) + :ruleset memory-helpers) +(rule ((PointsToCells (Alloc id sz state ty) ap)) + ((PointsToCells state ap)) + :ruleset memory-helpers) +(rule ((PointsToCells (Bop (Free) ptr state) ap)) + ((PointsToCells ptr ap) + (PointsToCells state ap)) + :ruleset memory-helpers) +(rule ((PointsToCells (Get x i) ap)) + ((PointsToCells x ap)) + :ruleset memory-helpers) +(rule ((PointsToCells (Concat x y) ap)) + ((PointsToCells x ap) + (PointsToCells y ap)) + :ruleset memory-helpers) +(rule ((PointsToCells (Single x) ap)) + ((PointsToCells x ap)) + :ruleset memory-helpers) + +; Compute and propagate PointsToCells +(rewrite (PointsToCells (Concat x y) aps) + (TuplePointsTo (Concat-List + (UnwrapTuplePointsTo (PointsToCells x aps)) + (UnwrapTuplePointsTo (PointsToCells y aps)))) + :when ((HasType (Concat x y) ty) (PointerishType ty)) + :ruleset memory-helpers) + +(rewrite (PointsToCells (Get x i) aps) + (GetPointees (PointsToCells x aps) i) + :when ((HasType (Get x i) ty) (PointerishType ty)) + :ruleset memory-helpers) + +(rewrite (PointsToCells (Single x) aps) + (TuplePointsTo + (Cons-List + (UnwrapPtrPointsTo (PointsToCells x aps)) + (Nil-List))) + :when ((HasType (Single x) ty) (PointerishType ty)) + :ruleset memory-helpers) + +(rewrite (PointsToCells (Arg ty_ ctx) aps) + aps + :when ((HasType (Arg ty_ ctx) ty) (PointerishType ty)) + :ruleset memory-helpers) + +; Allow non-pointer types to resolve +(rule ((PointsToCells x aps) + (HasType x ty)) + ((TypeToPointees ty)) + :ruleset memory-helpers) +(rule ((= f (PointsToCells x aps)) + (HasType x ty) + (= pointees (TypeToPointees ty)) + (PointsNowhere pointees)) + ((union f pointees)) + :ruleset memory-helpers) + +(rewrite (PointsToCells (Bop (PtrAdd) x e) aps) + (PtrPointsTo + (AddIntIntervalToPtrPointees + (MkIntInterval (I lo) (I hi)) + (UnwrapPtrPointsTo (PointsToCells x aps)))) + :when ((= (IntB lo) (lo-bound e)) + (= (IntB hi) (hi-bound e))) + :ruleset memory-helpers) + +(rewrite (PointsToCells (If c inputs t e) aps) + (UnionPointees + (PointsToCells t (PointsToCells inputs aps)) + (PointsToCells e (PointsToCells inputs aps))) + :when ((HasType (If c inputs t e) ty) (PointerishType ty)) + :ruleset memory) + +(rewrite (PointsToCells (Alloc id sz state ty) aps) + (TuplePointsTo + (Cons-List + (PointsTo + (Cons-List + id + (MkIntInterval (I 0) (I 0)) + (Nil-List))) + (Cons-List + (PointsTo (Nil-List)) ; state output points to nothing + (Nil-List)))) + :ruleset memory-helpers) + +; arg pointees * loop in * loop out * i64 -> result pointees +(function PointsToCellsAtIter (Pointees Expr Expr i64) Pointees) + +; compute first two +(rule ((= e (DoWhile inputs pred-body)) + (PointsToCells e aps)) + ((set (PointsToCellsAtIter aps inputs pred-body 0) + (PointsToCells inputs aps)) + (set (PointsToCellsAtIter aps inputs pred-body 1) + (UnionPointees + (PointsToCellsAtIter aps inputs pred-body 0) + (PointeesDropFirst + (PointsToCells pred-body (PointsToCellsAtIter aps inputs pred-body 0)))))) + :ruleset memory-helpers) + +; avoid quadratic query +(function succ (i64) i64 :unextractable) +(rule ((PointsToCellsAtIter aps inputs pred-body i)) + ((set (succ i) (+ i 1))) + :ruleset memory-helpers) + +; Note that this rule is bounded by ruleset memory +(rule ((= pointees0 (PointsToCellsAtIter aps inputs pred-body i)) + (= pointees1 (PointsToCellsAtIter aps inputs pred-body (succ i))) + (Resolved-Pointees pointees0) + (Resolved-Pointees pointees1) + (!= pointees0 pointees1)) + ((set (PointsToCellsAtIter aps inputs pred-body (+ i 2)) + (UnionPointees + pointees1 + (PointeesDropFirst + (PointsToCells pred-body pointees1))))) + :ruleset memory) + +(rule ((= pointees (PointsToCellsAtIter aps inputs pred-body i)) + (= pointees (PointsToCellsAtIter aps inputs pred-body (succ i)))) + ((set (PointsToCells (DoWhile inputs pred-body) aps) + pointees)) + :ruleset memory) + +(rule ((PtrPointsTo (PointsTo l))) + ((DemandAt-List l)) + :ruleset memory-helpers) +(rule ((TuplePointsTo l)) + ((DemandAt-List l)) + :ruleset memory-helpers) + +; ============================ +; Update DontAlias +; ============================ + +(relation DemandDontAlias (Expr Expr Pointees)) +; pointer, pointer, arg pointees +(relation DontAlias (Expr Expr Pointees)) + + +(rule ((DemandDontAlias ptr1 ptr2 arg-pointees) + (BodyContainsExpr body ptr1) + (BodyContainsExpr body ptr2) + (HasType ptr1 (Base (PointerT ty))) + (HasType ptr2 (Base (PointerT ty))) + (= pointees1 (PointsToCells ptr1 arg-pointees)) + (= pointees2 (PointsToCells ptr2 arg-pointees))) + ((IntersectPointees pointees1 pointees2)) + :ruleset memory-helpers) + +(rule ((PointsNowhere + (IntersectPointees + (PointsToCells ptr1 arg-pointees) + (PointsToCells ptr2 arg-pointees)))) + ((DontAlias ptr1 ptr2 arg-pointees)) + :ruleset memory-helpers) + +; ============================ +; Update PointsToExpr +; ============================ + +; program point, pointer +(function PointsToExpr (Expr Expr) Expr :unextractable) + +; After a load, the ptr points to the loaded value +(rule ((= f (Bop (Load) ptr state))) + ((set (PointsToExpr (Get f 1) ptr) (Get f 0))) + :ruleset memory-helpers) + +; If we load and we already know what the pointer points to +; TODO this rule breaks the weakly linear invariant +; when a previous load may not be on the path +;(rule ((= e (Bop (Load) addr state)) +; (= v (PointsToExpr state addr))) +; ((union (Get e 0) v) +; (union (Get e 1) state)) +; :ruleset memory-helpers) + +; Loads and prints don't affect what what pointers already point to +(rule ((= f (PointsToExpr state addr)) + (= e (Bop (Load) any-addr state))) + ((let new-state (Get e 1)) + (union (PointsToExpr new-state addr) f)) + :ruleset memory-helpers) +(rule ((= f (PointsToExpr state addr)) + (= e (Bop (Print) any-val state))) + ((let new-state e) + (union (PointsToExpr new-state addr) f)) + :ruleset memory-helpers) + +; Writes don't affect what a pointer points to if it writes to another pointer +; guaranteed to not alias. +(rule ((= e (Top (Write) addr data state)) + (HasArgType addr argty) + (= otherdata (PointsToExpr state otheraddr))) + ((DemandDontAlias addr otheraddr (TypeToPointees argty))) + :ruleset memory-helpers) +(rule ((= e (Top (Write) addr data state)) + (HasArgType addr argty) + (= otherdata (PointsToExpr state otheraddr)) + (DontAlias addr otheraddr (TypeToPointees argty))) + ((set (PointsToExpr e otheraddr) otherdata)) + :ruleset memory-helpers) + +; For a write, mark the given expression as containing `data`. +(rule ((= e (Top (Write) addr data state))) + ((union (PointsToExpr e addr) data)) + :ruleset memory-helpers) + +; ============================ +; Update CellHasValues (currently unused) +; ============================ + +; ; program point, cell +; (function CellHasValues (Expr i64) ExprSet :merge (ExprSet-intersect old new)) + +; ; At the time of an alloc, a cell doesn't contain any values +; (rule ((= f (Alloc id amt state ty))) + ; ((set (CellHasValues (Get f 1) id) (ES (set-empty)))) + ; :ruleset memory-helpers) + +; ; These two rules find (Write ptr val state) where +; ; ptr points to cells given no assumptions about where (Arg) points. +; ; TODO: make sensitive to offsets +; (rule ((= e (Top (Write) ptr val state)) + ; (HasArgType ptr argty)) + ; ((TypeToPointees argty)) + ; :ruleset memory-helpers) +; (rule ((= e (Top (Write) ptr val state)) + ; (HasArgType ptr argty) + ; (= (PtrPointsTo (PointsTo cells)) (PointsToCells ptr (TypeToPointees argty))) + ; (At-List cells any-idx alloc-id offsets) + ; (= vals (CellHasValues state cell))) + ; ((set (CellHasValues e cell) (ExprSet-insert vals val))) + ; :ruleset memory-helpers) + +;; Loop Invariant + +;; bool: whether the term in the Expr is an invariant. +(function is-inv-Expr (Expr Expr) bool :unextractable :merge (or old new)) +(function is-inv-ListExpr (Expr ListExpr) bool :unextractable :merge (or old new)) + +;; in default, when there is a find, set is-inv to false +(rule ((BodyContainsExpr loop term) + (= loop (DoWhile inputs pred_out))) + ((set (is-inv-Expr loop term) false)) :ruleset always-run) +(rule ((BodyContainsListExpr loop term) + (= loop (DoWhile inputs pred_out))) + ((set (is-inv-ListExpr loop term) false)) :ruleset always-run) + +(relation is-inv-ListExpr-helper (Expr ListExpr i64)) +(rule ((BodyContainsListExpr loop list) + (= loop (DoWhile inputs pred_out))) + ((is-inv-ListExpr-helper loop list 0)) :ruleset always-run) + +(rule ((is-inv-ListExpr-helper loop list i) + (= true (is-inv-Expr loop expr)) + (= expr (ListExpr-ith list i))) + ((is-inv-ListExpr-helper loop list (+ i 1))) :ruleset always-run) + +(rule ((is-inv-ListExpr-helper loop list i) + (= i (ListExpr-length list))) + ((set (is-inv-ListExpr loop list) true)) :ruleset always-run) + + +(ruleset boundary-analysis) +;; An Expr is on boundary when it is invariant and its parent is not +; loop invariant-expr +(relation boundary-Expr (Expr Expr)) + +;; boundary for ListExpr's children +(rule ((= true (is-inv-Expr loop expr)) + (= false (is-inv-ListExpr loop list)) + (= expr (ListExpr-ith list i))) + ((boundary-Expr loop expr)) :ruleset boundary-analysis) + +;; if a output branch/pred is invariant, it's also boundary-Expr +(rule ((= true (is-inv-Expr loop expr)) + (= loop (DoWhile in pred_out)) + (= expr (Get pred_out i))) + ((boundary-Expr loop expr)) :ruleset boundary-analysis) + + +(function hoisted-loop (Expr Expr) bool :unextractable :merge (or old new) ) +(rule ((= loop (DoWhile in pred_out))) + ((set (hoisted-loop in pred_out) false)) :ruleset always-run) + +(function InExtendedLoop (Expr Expr Expr) Assumption) + +;; mock function +(ruleset loop-inv-motion) + +(rule ((boundary-Expr loop inv) + (> (Expr-size inv) 1) + ;; TODO: replace Expr-size when cost model is ready + (= loop (DoWhile in pred_out)) + ;; the outter assumption of the loop + (ContextOf loop loop_ctx) + (HasType in in_type) + (HasType inv inv_type) + (= inv_type (Base base_inv_ty)) + (= in_type (TupleT tylist)) + (= false (hoisted-loop in pred_out)) + (= len (tuple-length in))) + ((let new_input (Concat in (Single (Subst loop_ctx in inv)))) + (let new_input_type (TupleT (TLConcat tylist (TCons base_inv_ty (TNil))))) + ;; create an virtual assume node, union it with actuall InLoop later + (let assum (InExtendedLoop in pred_out new_input)) + (let new_out_branch (Get (Arg new_input_type assum) len)) + ;; this two subst only change arg to arg with new type + (let substed_pred_out (Subst assum (Arg new_input_type assum) pred_out)) + (let inv_in_new_loop (Subst assum (Arg new_input_type assum) inv)) + (let new_pred_out (Concat substed_pred_out (Single new_out_branch))) + + (let new_loop (DoWhile new_input new_pred_out)) + (union assum (InLoop new_input new_pred_out)) + (union inv_in_new_loop new_out_branch) + (let wrapper (SubTuple new_loop 0 len)) + (union loop wrapper) + (subsume (DoWhile in pred_out)) + ;; don't hoist same loop again + (set (hoisted-loop in pred_out) true) + ) + :ruleset loop-inv-motion) + + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Const _n _ty _ctx))) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Get (Arg ty ctx) i)) + (= loop (DoWhile in pred_out)) + (= expr (Get pred_out (+ i 1)))) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Function _name _tyin _tyout _out)) + + ) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Top _op _x _y _z)) + (= true (is-inv-Expr loop _x)) (= true (is-inv-Expr loop _y)) (= true (is-inv-Expr loop _z)) + ) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Bop _op _x _y)) (BinaryOpIsPure _op) + (= true (is-inv-Expr loop _x)) (= true (is-inv-Expr loop _y)) + ) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Uop _op _x)) (UnaryOpIsPure _op) + (= true (is-inv-Expr loop _x)) + ) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Get _tup _i)) + (= true (is-inv-Expr loop _tup)) + ) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Concat _x _y)) + (= true (is-inv-Expr loop _x)) (= true (is-inv-Expr loop _y)) + ) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Single _x)) + (= true (is-inv-Expr loop _x)) + ) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Switch _pred _inputs _branches)) + (= true (is-inv-Expr loop _pred)) (= true (is-inv-Expr loop _inputs)) (= true (is-inv-ListExpr loop _branches)) + ) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (If _pred _input _then _else)) + (= true (is-inv-Expr loop _pred)) (= true (is-inv-Expr loop _input)) + ) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (DoWhile _in _pred-and-output)) + (= true (is-inv-Expr loop _in)) + (ExprIsPure expr)) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Call _func _arg)) + (= true (is-inv-Expr loop _arg)) + (ExprIsPure expr)) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Empty _ty _ctx)) + + ) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Top _op _x _y _z)) + (= expr1 _x)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Top _op _x _y _z)) + (= expr1 _y)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Top _op _x _y _z)) + (= expr1 _z)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Bop _op _x _y)) + (= expr1 _x)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Bop _op _x _y)) + (= expr1 _y)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Uop _op _x)) + (= expr1 _x)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Concat _x _y)) + (= expr1 _x)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Concat _x _y)) + (= expr1 _y)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Single _x)) + (= expr1 _x)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Switch _pred _inputs _branches)) + (= expr1 _pred)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Switch _pred _inputs _branches)) + (= expr1 _inputs)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (If _pred _input _then _else)) + (= expr1 _pred)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (If _pred _input _then _else)) + (= expr1 _input)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (DoWhile _in _pred-and-output)) + (= expr1 _in)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Call _func _arg)) + (= expr1 _arg)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Alloc _id _e _state _ty)) + (= expr1 _e)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Alloc _id _e _state _ty)) + (= expr1 _state)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) +;; Some simple simplifications of loops +(ruleset loop-simplify) + +(rewrite + (DoWhile (Arg ty ctx) + (Concat (Single (Const (Bool false) ty ctx2)) + (Single (Const constant ty ctx2)))) + (Single (Const constant ty ctx)) + :ruleset loop-simplify) +;; Some simple simplifications of loops +(ruleset loop-unroll) +(ruleset loop-peel) + +;; inputs, outputs -> number of iterations +(function LoopNumItersGuess (Expr Expr) i64 :merge (max 1 (min old new))) + +;; by default, guess that all loops run 1000 times +(rule ((DoWhile inputs outputs)) + ((set (LoopNumItersGuess inputs outputs) 1000)) + :ruleset always-run) + + +;; loop peeling rule +(rule + ((= lhs (DoWhile inputs outputs)) + (ContextOf lhs ctx) + (HasType inputs inputs-ty) + (= outputs-len (tuple-length outputs)) + (= old_cost (LoopNumItersGuess inputs outputs))) + ((let executed-once + (Subst ctx inputs outputs)) + (let executed-once-body + (SubTuple executed-once 1 (- outputs-len 1))) + (let then-ctx + (InIf true (Get executed-once 0) executed-once-body)) + (let else-ctx + (InIf false (Get executed-once 0) executed-once-body)) + (union lhs + ;; check if we need to continue executing the loop + (If (Get executed-once 0) + executed-once-body ;; inputs are the body executed once + (DoWhile (Arg inputs-ty then-ctx) + outputs) ;; right now, loop unrolling shares the same outputs, but we could add more context here + (Arg inputs-ty else-ctx))) + (set (LoopNumItersGuess (Arg inputs-ty then-ctx) outputs) (- old_cost 1)) + ) + :ruleset loop-peel) + +;; unroll a loop with constant bounds and initial value +(rule + ((= lhs (DoWhile inputs outputs)) + (= num-inputs (tuple-length inputs)) + (= pred (Get outputs 0)) + ;; iteration counter starts at start_const + (= (Const (Int start_const) _ty1 _ctx1) (Get inputs counter_i)) + ;; updated counter at counter_i + (= next_counter (Get outputs (+ counter_i 1))) + ;; increments by one each loop + (= next_counter (Bop (Add) (Get (Arg _ty _ctx) counter_i) + (Const (Int 1) _ty2 _ctx2))) + ;; while less than end_constant + (= pred (Bop (LessThan) next_counter + (Const (Int end_constant) _ty3 _ctx3))) + ;; start and end constant is a multiple of 4 and greater than start_const + (> end_constant start_const) + (= (% start_const 4) 0) + (= (% end_constant 4) 0) + (= old_cost (LoopNumItersGuess inputs outputs)) + ) + ( + (let one-iter (SubTuple outputs 1 num-inputs)) + (let unrolled + (Subst (TmpCtx) one-iter + (Subst (TmpCtx) one-iter + (Subst (TmpCtx) one-iter + outputs)))) + (union lhs + (DoWhile inputs + unrolled)) + (let actual-ctx (InLoop inputs unrolled)) + (union (TmpCtx) actual-ctx) + + (set (LoopNumItersGuess inputs unrolled) (/ old_cost 4)) + (delete (TmpCtx)) + ) + :ruleset loop-unroll) + + + +;; Pass through thetas +(rule ((= lhs (Get loop i)) + (= loop (DoWhile inputs pred-outputs)) + (= (Get pred-outputs (+ i 1)) (Get (Arg _ty _ctx) i)) + ;; only pass through pure types, since some loops don't terminate + ;; so the state edge must pass through them + (HasType (Get loop i) lhs_ty) + (PureType lhs_ty) + ) + ((union lhs (Get inputs i))) + :ruleset always-run) + +;; Pass through switch arguments +(rule ((= lhs (Get switch i)) + (= switch (Switch pred inputs branches)) + (= (ListExpr-length branches) 2) + (= branch0 (ListExpr-ith branches 0)) + (= branch1 (ListExpr-ith branches 1)) + (= (Get branch0 i) (Get (Arg _ _ctx0) j)) + (= (Get branch1 i) (Get (Arg _ _ctx1) j)) + (= passed-through (Get inputs j)) + (HasType lhs lhs_ty) + (!= lhs_ty (Base (StateT)))) + ((union lhs passed-through)) + :ruleset always-run) + +;; Pass through switch predicate +(rule ((= lhs (Get switch i)) + (= switch (Switch pred inputs branches)) + (= (ListExpr-length branches) 2) + (= branch0 (ListExpr-ith branches 0)) + (= branch1 (ListExpr-ith branches 1)) + (= (Get branch0 i) (Const (Bool false) _ _ctx0)) + (= (Get branch1 i) (Const (Bool true) _ _ctx1))) + ((union lhs pred)) + :ruleset always-run) + +;; Pass through if arguments +(rule ((= if (If pred inputs then_ else_)) + (= jth-inside (Get (Arg _ _then_ctx) j)) + (= (Get then_ i) jth-inside) + (= (Get else_ i) (Get (Arg _ _else_ctx) j)) + (HasType jth-inside lhs_ty) + (!= lhs_ty (Base (StateT)))) + ((union (Get if i) (Get inputs j))) + :ruleset always-run) + +; Pass through if state edge arguments +; To maintain the invariant, we have to union the other outputs with a pure if statement +(rule ((= lhs (Get outputs i)) + (= outputs (If pred inputs then_ else_)) + + (= (Get then_ i) (Get (Arg (TupleT arg_ty) then_ctx) j)) + (= (Get else_ i) (Get (Arg (TupleT arg_ty) else_ctx) j)) + (= passed-through (Get inputs j)) + + (HasType lhs lhs_ty) + (= lhs_ty (Base (StateT))) + + (= inputs_len (tuple-length inputs)) + (= outputs_len (tuple-length outputs))) + + ((let new_inputs (TupleRemoveAt inputs j)) + + (let new_then_ctx (InIf true pred new_inputs)) + (let new_else_ctx (InIf false pred new_inputs)) + + (let old_then (TupleRemoveAt then_ i)) + (let old_else (TupleRemoveAt else_ i)) + + (let new_then (DropAt new_then_ctx j old_then)) + (let new_else (DropAt new_else_ctx j old_else)) + + (let old_outputs (TupleRemoveAt outputs i)) + (let new_if (If pred new_inputs new_then new_else)) + (union new_if old_outputs) + + (union lhs passed-through) + (subsume (If pred inputs then_ else_))) + :ruleset always-run) + +;; Pass through if predicate +(rule ((= if (If pred inputs then_ else_)) + (= (Get then_ i) (Const (Bool true) _ _thenctx)) + (= (Get else_ i) (Const (Bool false) _ _elsectx))) + + ((let new_then (TupleRemoveAt then_ i)) + (let new_else (TupleRemoveAt else_ i)) + (let new_if (If pred inputs new_then new_else)) + + (union (Get if i) pred) + (union (TupleRemoveAt if i) new_if) + (subsume (If pred inputs then_ else_))) + :ruleset always-run) + +;; ORIGINAL +;; a = 0 +;; c = 3 +;; for i = 0 to n: +;; a = i * c +;; +;; OPTIMIZED +;; a = 0 +;; c = 3 +;; d = 0 +;; for i = 0 to n: +;; a += d +;; d += c +(ruleset loop-strength-reduction) + +; Finds invariants/constants within a body. +; Columns: body; value of invariant in inputs; value of invariant in outputs +;; Get the input and output value of an invariant, or constant int, within the loop +;; loop in out +(relation lsr-inv (Expr Expr Expr)) + +; TODO: there may be a bug with finding the invariant, or it just may not be extracted. +; Can make this work on loop_with_mul_by_inv and a rust test later. +; (rule ( +; (= loop (DoWhile inputs pred-and-body)) +; (= (Get outputs (+ i 1)) (Get (Arg arg-type assm) i))) +; ((inv loop (Get inputs i) (Get (Arg arg-type assm) i))) :ruleset always-run) +(rule ( + (= loop (DoWhile inputs pred-and-body)) + (ContextOf inputs loop-input-ctx) + (ContextOf pred-and-body loop-output-ctx) + (= constant (Const c out-type loop-output-ctx)) + (HasArgType inputs in-type) + ) + ((lsr-inv loop (Const c in-type loop-input-ctx) constant)) :ruleset always-run) + +(rule + ( + ;; Find loop + (= old-loop (DoWhile inputs pred-and-outputs)) + (ContextOf pred-and-outputs loop-ctx) + + ; Find loop variable (argument that gets incremented with an invariant) + (lsr-inv old-loop loop-incr-in loop-incr-out) + ; Since the first el of pred-and-outputs is the pred, we need to offset i + (= (Get pred-and-outputs (+ i 1)) (Bop (Add) (Get (Arg arg-type assm) i) loop-incr-out)) + + ; Find invariant where input is same as output, or constant + (lsr-inv old-loop c-in c-out) + + ; Find multiplication of loop variable and invariant + (= old-mul (Bop (Mul) c-out (Get (Arg arg-type assm) i))) + (ContextOf old-mul loop-ctx) + + (= arg-type (TupleT ty-list)) + ) + ( + ; Each time we need to update d by the product of the multiplied constant and the loop increment + (let addend (Bop (Mul) c-out loop-incr-out)) + + ; n is index of our new, temporary variable d + (let n (tuple-length inputs)) + + ; Initial value of d is i * c + (let d-init (Bop (Mul) c-in (Get inputs i))) + + ; Construct optimized theta + ; new-inputs already has the correct context + (let new-inputs (Concat inputs (Single d-init))) + + ; We need to create a new type, with one more input + (let new-arg-ty (TupleT (TLConcat ty-list (TCons (IntT) (TNil))))) + + ; Value of d in loop. Add context to addend + (let d-out (Bop (Add) (Get (Arg new-arg-ty (TmpCtx)) n) + (Subst (TmpCtx) (Arg new-arg-ty (TmpCtx)) addend))) + + ; build the old body, making sure to set the correct arg type and context + (let new-body + (Concat + (Subst (TmpCtx) (Arg new-arg-ty (TmpCtx)) pred-and-outputs) + (Single d-out))) + + (let new-loop (DoWhile new-inputs new-body)) + + ; Now that we have the new loop, union the temporary context with the actual ctx + (union (TmpCtx) (InLoop new-inputs new-body)) + + ; Substitute d for the *i expression + (let new-mul + (Bop + (Mul) + (Subst (TmpCtx) (Arg new-arg-ty (TmpCtx)) c-out) + (Get (Arg new-arg-ty (TmpCtx)) i))) + (union (Get (Arg new-arg-ty (TmpCtx)) n) new-mul) + + ; Subsume the multiplication in the new loop to prevent + ; from firing loop strength reduction again on the new loop + (subsume + (Bop + (Mul) + (Subst (TmpCtx) (Arg new-arg-ty (TmpCtx)) c-out) + (Get (Arg new-arg-ty (TmpCtx)) i))) + + ; Project all but last + (union old-loop (SubTuple new-loop 0 n)) + (delete (TmpCtx)) + ) + :ruleset loop-strength-reduction +) +(DoWhile (Concat (Single (Const (Int 0) (TupleT (TNil)) (InFunc "dummy"))) (Single (Const (Int 1) (TupleT (TNil)) (InFunc "dummy")))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 0) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 0) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))))) + +(If (Bop (LessThan) (Const (Int 0) (TupleT (TNil)) (InFunc "dummy")) (Const (Int 1) (TupleT (TNil)) (InFunc "dummy"))) (Concat (Single (Const (Int 1) (TupleT (TNil)) (InFunc "dummy"))) (Single (Const (Int 1) (TupleT (TNil)) (InFunc "dummy")))) (DoWhile (Concat (Single (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 0)) (Single (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 0) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 0) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))))) (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy"))) + + (unstable-combined-ruleset saturating + always-run + canon + type-analysis + context + interval-analysis + memory-helpers + ) + + + (unstable-combined-ruleset optimizations + loop-simplify + memory + loop-unroll + peepholes + ) + + (unstable-combined-ruleset expensive-optimizations + optimizations + ;; TODO why is this expensive? On `adler32.bril` it blows up with 3 iterations + switch_rewrite + ;loop-inv-motion + loop-strength-reduction + ) + + (run-schedule + +;; saturate all helpers first +(saturate + (saturate + (saturate type-helpers) ;; resolve type helpers, finding correct types + (saturate error-checking) ;; check for errors, relies on type-helpers saturating + saturating) + + (saturate drop) + apply-drop-unions + cleanup-drop + + (saturate subst) ;; do e-substitution + apply-subst-unions ;; apply the unions from substitution + cleanup-subst ;; clean up substitutions that are done + + (saturate boundary-analysis) ;; find boundaries of invariants +) + + + loop-peel + (repeat 2 + +;; saturate all helpers first +(saturate + (saturate + (saturate type-helpers) ;; resolve type helpers, finding correct types + (saturate error-checking) ;; check for errors, relies on type-helpers saturating + saturating) + + (saturate drop) + apply-drop-unions + cleanup-drop + + (saturate subst) ;; do e-substitution + apply-subst-unions ;; apply the unions from substitution + cleanup-subst ;; clean up substitutions that are done + + (saturate boundary-analysis) ;; find boundaries of invariants +) + + + expensive-optimizations) + (repeat 4 + +;; saturate all helpers first +(saturate + (saturate + (saturate type-helpers) ;; resolve type helpers, finding correct types + (saturate error-checking) ;; check for errors, relies on type-helpers saturating + saturating) + + (saturate drop) + apply-drop-unions + cleanup-drop + + (saturate subst) ;; do e-substitution + apply-subst-unions ;; apply the unions from substitution + cleanup-subst ;; clean up substitutions that are done + + (saturate boundary-analysis) ;; find boundaries of invariants +) + + + optimizations) + +;; saturate all helpers first +(saturate + (saturate + (saturate type-helpers) ;; resolve type helpers, finding correct types + (saturate error-checking) ;; check for errors, relies on type-helpers saturating + saturating) + + (saturate drop) + apply-drop-unions + cleanup-drop + + (saturate subst) ;; do e-substitution + apply-subst-unions ;; apply the unions from substitution + cleanup-subst ;; clean up substitutions that are done + + (saturate boundary-analysis) ;; find boundaries of invariants +) + +) + + + (query-extract :variants 5 (DoWhile (Concat (Single (Const (Int 0) (TupleT (TNil)) (InFunc "dummy"))) (Single (Const (Int 1) (TupleT (TNil)) (InFunc "dummy")))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 0) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 0) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1)))))) + ;(query-extract :variants 5 (If (Bop (LessThan) (Const (Int 0) (TupleT (TNil)) (InFunc "dummy")) (Const (Int 1) (TupleT (TNil)) (InFunc "dummy"))) (Concat (Single (Const (Int 1) (TupleT (TNil)) (InFunc "dummy"))) (Single (Const (Int 1) (TupleT (TNil)) (InFunc "dummy")))) (DoWhile (Concat (Single (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 0)) (Single (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 0) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 0) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))))) (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")))) + +;; use these rules to clean up the database, removing helpers +;; this makes the visualization easier to read + + +(rule ((HasType a b)) + ((delete (HasType a b)))) +(rule ((BodyContainsExpr a b)) + ((delete (BodyContainsExpr a b)))) +(rule ((ExprIsPure e)) + ((delete (ExprIsPure e)))) +(rule ((HasArgType e ty)) + ((delete (HasArgType e ty)))) +(rule ((is-inv-Expr e ty)) + ((delete (is-inv-Expr e ty)))) +(rule ((tuple-length e)) + ((delete (tuple-length e)))) +(rule ((BinaryOpIsPure e)) + ((delete (BinaryOpIsPure e)))) +(rule ((TypeList-suffix e a)) + ((delete (TypeList-suffix e a)))) +(rule ((ContextOf e a)) + ((delete (ContextOf e a)))) +(rule ((ExprIsResolved e)) + ((delete (ExprIsResolved e)))) +(run-schedule (saturate (run))) + + Running unittests src/main.rs (target/release/deps/dag_in_context-13fe7a7639e66d94) diff --git a/dag_in_context/src/optimizations/loop_unroll.egg b/dag_in_context/src/optimizations/loop_unroll.egg index 0b3bc16db..e04c642b9 100644 --- a/dag_in_context/src/optimizations/loop_unroll.egg +++ b/dag_in_context/src/optimizations/loop_unroll.egg @@ -3,6 +3,8 @@ (ruleset loop-peel) ;; inputs, outputs -> number of iterations +;; The minimum possible guess is 1 because of do-while loops +;; TODO: dead loop deletion can turn loops with a false condition to a body (function LoopNumItersGuess (Expr Expr) i64 :merge (max 1 (min old new))) ;; by default, guess that all loops run 1000 times @@ -10,15 +12,68 @@ ((set (LoopNumItersGuess inputs outputs) 1000)) :ruleset always-run) +;; Figure out number of iterations for a loop with constant bounds and initial value +;; and i is updated before checking pred +;; TODO: can make this work for increment by any constant +(rule + ((= lhs (DoWhile inputs outputs)) + (= num-inputs (tuple-length inputs)) + (= pred (Get outputs 0)) + ;; iteration counter starts at start_const + (= (Const (Int start_const) _ty1 _ctx1) (Get inputs counter_i)) + ;; updated counter at counter_i + (= next_counter (Get outputs (+ counter_i 1))) + ;; increments by one each loop + (= next_counter (Bop (Add) (Get (Arg _ty _ctx) counter_i) + ;; TODO: put c instead of (Int 1) and mul by c + (Const (Int 1) _ty2 _ctx2))) + ;; while next_counter less than end_constant + (= pred (Bop (LessThan) next_counter + (Const (Int end_constant) _ty3 _ctx3))) + ;; end constant is greater than start constant + (> end_constant start_const) + ) + ( + (set (LoopNumItersGuess inputs outputs) (- end_constant start_const)) + ) + :ruleset always-run) + +;; Figure out number of iterations for a loop with constant bounds and initial value +;; and i is updated after checking pred +(rule + ((= lhs (DoWhile inputs outputs)) + (= num-inputs (tuple-length inputs)) + (= pred (Get outputs 0)) + ;; iteration counter starts at start_const + (= (Const (Int start_const) _ty1 _ctx1) (Get inputs counter_i)) + ;; updated counter at counter_i + (= next_counter (Get outputs (+ counter_i 1))) + ;; increments by one each loop + (= next_counter (Bop (Add) (Get (Arg _ty _ctx) counter_i) + (Const (Int 1) _ty2 _ctx2))) + ;; while this counter less than end_constant + (= pred (Bop (LessThan) (Get (Arg _ty _ctx) counter_i) + (Const (Int end_constant) _ty3 _ctx3))) + ;; end constant is greater than start constant + (> end_constant start_const) + ) + ( + (set (LoopNumItersGuess inputs outputs) (+ (- end_constant start_const) 1)) + ) + :ruleset always-run) ;; loop peeling rule +;; Only peel loops that we know iterate < 5 times (rule ((= lhs (DoWhile inputs outputs)) (ContextOf lhs ctx) (HasType inputs inputs-ty) (= outputs-len (tuple-length outputs)) - (= old_cost (LoopNumItersGuess inputs outputs))) - ((let executed-once + (= old_cost (LoopNumItersGuess inputs outputs)) + ; (< old_cost 5) + ) + ( + (let executed-once (Subst ctx inputs outputs)) (let executed-once-body (SubTuple executed-once 1 (- outputs-len 1))) diff --git a/dag_in_context/src/optimizations/switch_rewrites.egg b/dag_in_context/src/optimizations/switch_rewrites.egg index bc68d1343..748f128d0 100644 --- a/dag_in_context/src/optimizations/switch_rewrites.egg +++ b/dag_in_context/src/optimizations/switch_rewrites.egg @@ -44,7 +44,7 @@ (rewrite (If (Const (Bool true) ty ctx) ins thn els) (Subst ctx ins thn) - :ruleset switch_rewrite) + :ruleset always-run) (rewrite (If (Const (Bool false) ty ctx) ins thn els) (Subst ctx ins els) diff --git a/dag_in_context/src/schedule.rs b/dag_in_context/src/schedule.rs index b838e9753..07f676d92 100644 --- a/dag_in_context/src/schedule.rs +++ b/dag_in_context/src/schedule.rs @@ -52,11 +52,11 @@ pub fn mk_schedule() -> String { switch_rewrite ;loop-inv-motion loop-strength-reduction + loop-peel ) (run-schedule {helpers} - loop-peel (repeat 2 {helpers} expensive-optimizations) diff --git a/out.egg b/out.egg new file mode 100644 index 000000000..f8819658a --- /dev/null +++ b/out.egg @@ -0,0 +1,3854 @@ +; Every term is an `Expr` or a `ListExpr`. +(datatype Expr) +; Used for constructing a list of branches for `Switch`es +; or a list of functions in a `Program`. +(datatype ListExpr (Cons Expr ListExpr) (Nil)) + +; ================================= +; Types +; ================================= + +(sort TypeList) + +(datatype BaseType + (IntT) + (BoolT) + (FloatT) + ; a pointer to a memory region with a particular type + (PointerT BaseType) + (StateT)) + + +(datatype Type + ; a primitive type + (Base BaseType) + ; a typed tuple. Use an empty tuple as a unit type. + ; state edge also has unit type + (TupleT TypeList) +) + +(function TNil () TypeList) +(function TCons (BaseType TypeList) TypeList) ; Head element should never be a tuple + + +; ================================= +; Assumptions +; ================================= + +(datatype Assumption + ; Assume nothing + (InFunc String) + ; The term is in a loop with `input` and `pred_output`. + ; InLoop is a special context because it describes the argument of the loop. It is a *scope context*. + ; input pred_output + (InLoop Expr Expr) + ; Branch of the switch, and what the predicate is, and what the input is + (InSwitch i64 Expr Expr) + ; If the predicate was true, and what the predicate is, and what the input is + (InIf bool Expr Expr) +) + + + +; ================================= +; Leaf nodes +; Constants, argument, and empty tuple +; ================================= + +; Only a single argument is bound- if multiple values are needed, arg will be a tuple. +; e.g. `(Get (Arg tuple_type) 1)` gets the second value in the argument with some tuple_type. +(function Arg (Type Assumption) Expr) + +; Constants +(datatype Constant + (Int i64) + (Bool bool) + (Float f64)) +; All leaf nodes need the type of the argument +; Type is the type of the bound argument in scope +(function Const (Constant Type Assumption) Expr) + +; An empty tuple. +; Type is the type of the bound argument in scope +(function Empty (Type Assumption) Expr) + + +; ================================= +; Operators +; ================================= + +(datatype TernaryOp + ; given a pointer, value, and a state edge + ; writes the value to the pointer and returns + ; the resulting state edge + (Write) + (Select)) +(datatype BinaryOp + ;; integer operators + (Add) + (Sub) + (Div) + (Mul) + (LessThan) + (GreaterThan) + (LessEq) + (GreaterEq) + (Eq) + ;; float operators + (FAdd) + (FSub) + (FDiv) + (FMul) + (FLessThan) + (FGreaterThan) + (FLessEq) + (FGreaterEq) + (FEq) + ;; logical operators + (And) + (Or) + ; given a pointer and a state edge + ; loads the value at the pointer and returns (value, state edge) + (Load) + ; Takes a pointer and an integer, and offsets + ; the pointer by the integer + (PtrAdd) + ; given and value and a state edge, prints the value as a side-effect + ; the value must be a base value, not a tuple + ; returns an empty tuple + (Print) + ; given a pointer and state edge, frees the whole memory region at the pointer + (Free)) +(datatype UnaryOp + (Not)) + +; Operators +(function Top (TernaryOp Expr Expr Expr) Expr) +(function Bop (BinaryOp Expr Expr) Expr) +(function Uop (UnaryOp Expr) Expr) +; gets from a tuple. static index +(function Get (Expr i64) Expr) +; (Alloc id amount state_edge pointer_type) +; allocate an integer amount of memory for a particular type +; returns (pointer to the allocated memory, state edge) +(function Alloc (i64 Expr Expr BaseType) Expr) +; name of func arg +(function Call (String Expr) Expr) + + + +; ================================= +; Tuple operations +; ================================= + +; `Empty`, `Single` and `Concat` create tuples. +; 1. Use `Empty` for an empty tuple. +; 2. Use `Single` for a tuple with one element. +; 3. Use `Concat` to append the elements from two tuples together. +; Nested tuples are not allowed. + + +; A tuple with a single element. +; Necessary because we only use `Concat` to add to tuples. +(function Single (Expr) Expr) +; Concat appends the elemnts from two tuples together +; e.g. (Concat (Concat (Single a) (Single b)) +; (Concat (Single c) (Single d))) = (a, b, c, d) +; expr1 expr2 +(function Concat (Expr Expr) Expr) + + + +; ================================= +; Control flow +; ================================= + +; Switch on a list of lazily-evaluated branches. +; pred must be an integer +; pred inputs branches chosen +(function Switch (Expr Expr ListExpr) Expr) +; If is like switch, but with a boolean predicate +; pred inputs then else +(function If (Expr Expr Expr Expr) Expr) + + +; A do-while loop. +; Evaluates the input, then evaluates the body. +; Keeps looping while the predicate is true. +; input must have the same type as (output1, output2, ..., outputi) +; input must be a tuple +; pred must be a boolean +; pred-and-body must be a flat tuple (pred, out1, out2, ..., outi) +; input must be the same type as (out1, out2, ..., outi) +; input pred-and-body +(function DoWhile (Expr Expr) Expr) + + +; ================================= +; Top-level expressions +; ================================= +(sort ProgramType) +; An entry function and a list of additional functions. +; entry function other functions +(function Program (Expr ListExpr) ProgramType) +; name input ty output ty output +(function Function (String Type Type Expr) Expr) + + + +; Rulesets +(ruleset always-run) +(ruleset error-checking) +(ruleset memory) +(ruleset memory-helpers) +(ruleset smem) + +;; Initliazation +(relation bop->string (BinaryOp String)) +(relation uop->string (UnaryOp String)) +(relation top->string (TernaryOp String)) +(bop->string (Add) "Add") +(bop->string (Sub) "Sub") +(bop->string (Div) "Div") +(bop->string (Mul) "Mul") +(bop->string (LessThan) "LessThan") +(bop->string (GreaterThan) "GreaterThan") +(bop->string (LessEq) "LessEq") +(bop->string (GreaterEq) "GreaterEq") +(bop->string (Eq) "Eq") +(bop->string (FAdd) "FAdd") +(bop->string (FSub) "FSub") +(bop->string (FDiv) "FDiv") +(bop->string (FMul) "FMul") +(bop->string (FLessThan) "FLessThan") +(bop->string (FGreaterThan) "FGreaterThan") +(bop->string (FLessEq) "FLessEq") +(bop->string (FGreaterEq) "FGreaterEq") +(bop->string (FEq) "FEq") +(bop->string (And) "And") +(bop->string (Or) "Or") +(bop->string (Load) "Load") +(bop->string (PtrAdd) "PtrAdd") +(bop->string (Print) "Print") +(bop->string (Free) "Free") +(ruleset type-analysis) +(ruleset type-helpers) ;; these rules need to saturate between every iter of type-analysis rules + +(function TLConcat (TypeList TypeList) TypeList :unextractable) +(rewrite (TLConcat (TNil) r) r :ruleset type-helpers) +(rewrite (TLConcat (TCons hd tl) r) + (TCons hd (TLConcat tl r)) + :ruleset type-helpers) + +(function TypeList-length (TypeList) i64 :unextractable) +(function TypeList-ith (TypeList i64) BaseType :unextractable) +(function TypeList-suffix (TypeList i64) TypeList :unextractable) + +(rule ((TupleT tylist)) ((union (TypeList-suffix tylist 0) tylist)) :ruleset type-helpers) + +(rule ((= (TypeList-suffix top n) (TCons hd tl))) + ((union (TypeList-ith top n) hd) + (union (TypeList-suffix top (+ n 1)) tl)) :ruleset type-helpers) + +(rule ((= (TypeList-suffix list n) (TNil))) + ((set (TypeList-length list) n)) :ruleset type-helpers) + +(rule ((TypeList-ith list i) + (= (TypeList-length list) n) + (>= i n)) + ((panic "TypeList-ith out of bounds")) :ruleset type-helpers) + +(relation HasType (Expr Type)) + + +;; Keep track of type expectations for error messages +(relation ExpectType (Expr Type String)) +(rule ( + (ExpectType e expected msg) + (HasType e actual) + (!= expected actual) ;; OKAY to compare types for equality because we never union types. + ) + ((extract "Expecting expression") + (extract e) + (extract "to have type") + (extract expected) + (extract "but got type") + (extract actual) + (extract "with message") + (extract msg) + (panic "type mismatch")) + :ruleset error-checking) + +(relation HasArgType (Expr Type)) + +(rule ((HasArgType (Arg t1 ctx) t2) + (!= t1 t2)) + ((panic "arg type mismatch")) + :ruleset error-checking) + +(rule ((= lhs (Function name in out body)) + (HasArgType body ty) + (HasArgType body ty2) + (!= ty ty2)) + ((panic "arg type mismatch in function")) + :ruleset error-checking) + +; Propagate arg types up +(rule ((= lhs (Uop _ e)) + (HasArgType e ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Bop _ a b)) + (HasArgType a ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Bop _ a b)) + (HasArgType b ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Get e _)) + (HasArgType e ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Alloc _id e state _)) + (HasArgType e ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Call _ e)) + (HasArgType e ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Single e)) + (HasArgType e ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Concat e1 e2)) + (HasArgType e1 ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Concat e1 e2)) + (HasArgType e2 ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Switch pred inputs (Cons branch rest))) + (HasArgType pred ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Switch pred inputs (Cons branch rest))) + (HasArgType branch ty) + (HasType inputs ty2) + (!= ty ty2)) + ((panic "switch branches then branch has incorrect input type")) + :ruleset error-checking) +;; demand with one fewer branches +(rule ((= lhs (Switch pred inputs (Cons branch rest)))) + ((Switch pred inputs rest)) + :ruleset type-analysis) +(rule ((= lhs (If c i t e)) + (HasArgType c ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (If c i t e)) + (HasType i ty) + (HasArgType t ty2) + (!= ty ty2)) + ((panic "if branches then branch has incorrect input type")) + :ruleset error-checking) +(rule ((= lhs (If c i t e)) + (HasType i ty) + (HasArgType e ty2) + (!= ty ty2)) + ((panic "if branches else branch has incorrect input type")) + :ruleset error-checking) + + +(rule ((= lhs (DoWhile ins body)) + (HasArgType ins ty)) + ((HasArgType lhs ty)) + :ruleset type-analysis) +; Don't push arg types through Program, Function, DoWhile, Let exprs because +; these create new arg contexts. + +; Primitives +(rule ((= lhs (Const (Int i) ty ctx))) + ((HasType lhs (Base (IntT))) + (HasArgType lhs ty)) + :ruleset type-analysis) + +(rule ((= lhs (Const (Bool b) ty ctx))) + ((HasType lhs (Base (BoolT))) + (HasArgType lhs ty)) + :ruleset type-analysis) + +(rule ((= lhs (Const (Float b) ty ctx))) + ((HasType lhs (Base (FloatT))) + (HasArgType lhs ty)) + :ruleset type-analysis) + +(rule ((= lhs (Empty ty ctx))) + ((HasType lhs (TupleT (TNil))) + (HasArgType lhs ty)) + :ruleset type-analysis) + +; Unary Ops +(rule ( + (= lhs (Uop (Not) e)) + (HasType e (Base (BoolT))) + ) + ((HasType lhs (Base (BoolT)))) + :ruleset type-analysis) +(rule ((= lhs (Uop (Not) e))) + ((ExpectType e (Base (BoolT)) "(Not)")) + :ruleset type-analysis) + + +(rule ( + (= lhs (Bop (Print) e state)) + (HasType e _ty) ; just make sure it has some type. + ) + ((HasType lhs (Base (StateT)))) + :ruleset type-analysis) + +(rule ( + (= lhs (Bop (Print) e state)) + (HasType e (TupleT ty)) + ) + ((panic "Don't print a tuple")) + :ruleset error-checking) + +(rule ((= lhs (Bop (Free) e s)) + (HasType e (Base (PointerT _ty)))) + ((HasType lhs (Base (StateT)))) + :ruleset type-analysis) +(rule ((= lhs (Bop (Free) e s)) + (HasType e (Base (IntT)))) + ((panic "Free expected pointer, received integer")) + :ruleset error-checking) +(rule ((= lhs (Bop (Free) e s)) + (HasType e (TupleT _ty))) + ((panic "Free expected pointer, received tuple")) + :ruleset error-checking) + +(rule ( + (= lhs (Bop (Load) e state)) + (HasType e (Base (PointerT ty))) + ) + ((HasType lhs (TupleT (TCons ty (TCons (StateT) (TNil)))))) + :ruleset type-analysis) +(rule ( + (= lhs (Bop (Load) e state)) + (HasType e ty) + (= ty (Base (IntT))) + ) + ((panic "(Load) expected pointer, received int")) + :ruleset error-checking) +(rule ( + (= lhs (Bop (Load) e state)) + (HasType e ty) + (= ty (TupleT x)) + ) + ((panic "(Load) expected pointer, received tuple")) + :ruleset error-checking) + +; Binary ops + +;; Operators that have type Type -> Type -> Type +;; Note we only do this generic matching for binary +;; operator since there's a lot of them. +;; In the future we can also extend to other constructs. +(relation bop-of-type (BinaryOp Type)) +(bop-of-type (Add) (Base (IntT))) +(bop-of-type (Sub) (Base (IntT))) +(bop-of-type (Div) (Base (IntT))) +(bop-of-type (Mul) (Base (IntT))) +(bop-of-type (FAdd) (Base (FloatT))) +(bop-of-type (FSub) (Base (FloatT))) +(bop-of-type (FDiv) (Base (FloatT))) +(bop-of-type (FMul) (Base (FloatT))) + +(rule ( + (= lhs (Bop op e1 e2)) + (bop-of-type op ty) + (HasType e1 ty) + (HasType e2 ty) + ) + ((HasType lhs ty)) + :ruleset type-analysis) +(rule ((= lhs (Bop op e1 e2)) + (bop-of-type op ty) + (bop->string op op-str)) + ( + (ExpectType e1 ty op-str) + (ExpectType e2 ty op-str) + ) + :ruleset type-analysis) + +;; Operators that have type Float -> Float -> Bool +(relation bpred-of-type (BinaryOp Type)) +(bpred-of-type (FLessThan) (Base (FloatT))) +(bpred-of-type (FLessEq) (Base (FloatT))) +(bpred-of-type (FGreaterThan) (Base (FloatT))) +(bpred-of-type (FGreaterEq) (Base (FloatT))) +(bpred-of-type (FEq) (Base (FloatT))) +(bpred-of-type (LessThan) (Base (IntT))) +(bpred-of-type (LessEq) (Base (IntT))) +(bpred-of-type (GreaterThan) (Base (IntT))) +(bpred-of-type (GreaterEq) (Base (IntT))) +(bpred-of-type (Eq) (Base (IntT))) +(bpred-of-type (And) (Base (BoolT))) +(bpred-of-type (Or) (Base (BoolT))) + +(rule ( + (= lhs (Bop pred e1 e2)) + (bpred-of-type pred ty) + (HasType e1 ty) + (HasType e2 ty) + ) + ((HasType lhs (Base (BoolT)))) + :ruleset type-analysis) +(rule ((= lhs (Bop pred e1 e2)) + (bpred-of-type pred ty) + (bop->string pred pred-str)) + ( + (ExpectType e1 ty pred-str) + (ExpectType e2 ty pred-str) + ) + :ruleset type-analysis) + +(rule ( + (= lhs (Top (Write) ptr val state)) + (HasType ptr (Base (PointerT ty))) + (HasType val (Base t)) ; TODO need to support pointers to pointers + ) + ((HasType lhs (Base (StateT)))) ; Write returns () + :ruleset type-analysis) + +(rule ( + (= lhs (Top (Write) ptr val state)) + (HasType ptr (Base (PointerT ty)))) + ((ExpectType val (Base ty) "(Write)")) + :ruleset type-analysis) + + + +(rule ( + (= lhs (Bop (PtrAdd) ptr n)) + (HasType ptr (Base (PointerT ty))) + (HasType n (Base (IntT))) + ) + ((HasType lhs (Base (PointerT ty)))) + :ruleset type-analysis) + +; Other ops +(rule ((= lhs (Alloc _id amt state ty))) + ((ExpectType amt (Base (IntT)) "(Alloc)")) + :ruleset type-analysis) + +(rule ( + (= lhs (Alloc _id amt state ty)) + (HasType amt (Base (IntT))) + ) + ((HasType lhs (TupleT (TCons ty (TCons (StateT) (TNil)))))) + :ruleset type-analysis) + +(rule ( + (= lhs (Get e i)) + (HasType e (TupleT tylist)) + ) + ; TypeList-ith needs to compute immediately, so we need to saturate type-helpers + ; rules between every iter of type-analysis rules. + ((HasType lhs (Base (TypeList-ith tylist i)))) + :ruleset type-analysis) + +(rule ( + (HasType (Get expr i) (TupleT tl)) + (= (TypeList-length tl) len) + (>= i len)) + ((panic "index out of bounds")) + :ruleset error-checking) +(rule ( + (HasType (Get expr i) (TupleT tl)) + (= (TypeList-length tl) len) + (< i 0) + ) + ((panic "negative index")) + :ruleset error-checking) + +; ================================= +; Tuple operations +; ================================= + +(rule ( + (= lhs (Single e)) + (HasType e (TupleT tylist)) + ) + ((panic "don't nest tuples")) + :ruleset error-checking) + +(rule ( + (= lhs (Single e)) + (HasType e (Base basety)) + ) + ((HasType lhs (TupleT (TCons basety (TNil))))) + :ruleset type-analysis) + +(rule ( + (= lhs (Concat e1 e2)) + (HasType e1 (TupleT tylist1)) + (HasType e2 (TupleT tylist2)) + ) + ; TLConcat needs to compute immediately, so we need to saturate type-helpers + ; rules between every iter of type-analysis rules. + ((HasType lhs (TupleT (TLConcat tylist1 tylist2)))) + :ruleset type-analysis) + +; ================================= +; Control flow +; ================================= +(rule ((= lhs (If pred inputs then else))) + ((ExpectType pred (Base (BoolT)) "If predicate must be boolean")) + :ruleset type-analysis) +(rule ( + (= lhs (If pred inputs then else)) + (HasType pred (Base (BoolT))) + (HasType then ty) + (HasType else ty) + ) + ((HasType lhs ty)) + :ruleset type-analysis) + +(rule ( + (= lhs (If pred inputs then else)) + (HasType pred (Base (BoolT))) + (HasType then tya) + (HasType else tyb) + (!= tya tyb) + ) + ((panic "if branches had different types")) + :ruleset error-checking) + + + +(rule ((= lhs (Switch pred inputs branches))) + ((ExpectType pred (Base (IntT)) "Switch predicate must be integer")) + :ruleset type-analysis) + +; base case: single branch switch has type of branch +(rule ( + (= lhs (Switch pred inputs (Cons branch (Nil)))) + (HasType pred (Base (IntT))) + (HasType branch ty) + ) + ((HasType lhs ty)) + :ruleset type-analysis) + +; recursive case: peel off a layer +(rule ((Switch pred inputs (Cons branch rest))) + ((Switch pred inputs rest)) + :ruleset type-analysis) + +(rule ( + (= lhs (Switch pred inputs (Cons branch rest))) + (HasType pred (Base (IntT))) + (HasType branch ty) + (HasType (Switch pred inputs rest) ty) ; rest of the branches also have type ty + ) + ((HasType lhs ty)) + :ruleset type-analysis) + +(rule ( + (= lhs (Switch pred inputs (Cons branch rest))) + (HasType pred (Base (IntT))) + (HasType branch tya) + (HasType (Switch pred inputs rest) tyb) + (!= tya tyb) + ) + ((panic "switch branches had different types")) + :ruleset error-checking) + +(rule ((Arg ty ctx)) + ( + (HasType (Arg ty ctx) ty) + (HasArgType (Arg ty ctx) ty) + ) + :ruleset type-analysis) + + +(rule ( + (= lhs (DoWhile inp pred-body)) + (HasType inp (Base ty)) + ) + ((panic "loop input must be tuple")) + :ruleset error-checking) +(rule ( + (= lhs (DoWhile inp pred-body)) + (HasType inp (Base (PointerT ty))) + ) + ((panic "loop input must be tuple")) + :ruleset error-checking) +(rule ( + (= lhs (DoWhile inp pred-body)) + (HasType pred-body (Base ty)) + ) + ((panic "loop pred-body must be tuple")) + :ruleset error-checking) +(rule ( + (= lhs (DoWhile inp pred-body)) + (HasType pred-body (Base (PointerT ty))) + ) + ((panic "loop pred-body must be tuple")) + :ruleset error-checking) + +(rule ( + (= lhs (DoWhile inp pred-body)) + (HasType inp (TupleT tylist)) + ) + ((HasArgType pred-body (TupleT tylist))) + :ruleset type-analysis) + +(rule ((= lhs (DoWhile inp pred-body))) + ((ExpectType (Get pred-body 0) (Base (BoolT)) "loop pred must be bool")) + :ruleset type-analysis) + +(rule ( + (= lhs (DoWhile inp pred-body)) + (HasType inp (TupleT tylist)) ; input is a tuple + ; pred-body is a tuple where the first elt is a bool + ; and the rest of the list matches the input type + (HasType pred-body (TupleT (TCons (BoolT) tylist))) + ) + ((HasType lhs (TupleT tylist))) ; whole thing has type of inputs/outputs + :ruleset type-analysis) + +(rule ( + (= lhs (DoWhile inp pred-body)) + (HasType inp (TupleT in-tys)) + (HasType pred-body (TupleT (TCons (BoolT) out-tys))) + (!= in-tys out-tys) + ) + ((panic "input types and output types don't match")) + :ruleset error-checking) + +; ================================= +; Functions +; ================================= + +(rule ((= lhs (Function name in-ty out-ty body))) + ( + ; Arg should have the specified type in the body + (HasArgType body in-ty) + ; Expect the body to have the specified output type + (ExpectType body out-ty "Function body had wrong type") + ) + :ruleset type-analysis) + +(rule ( + (= lhs (Call name arg)) + (Function name in-ty out-ty body) + ) + ; Expect the arg to have the right type for the function + ((ExpectType arg in-ty "function called with wrong arg type")) + :ruleset type-analysis) + +(rule ( + (= lhs (Call name arg)) + (Function name in-ty out-ty body) + (HasType arg in-ty) + ; We don't need to check the type of the function body, it will + ; be checked elsewhere. If we did require (HasType body out-ty), + ; recursive functions would not get assigned a type. + ) + ((HasType lhs out-ty)) + :ruleset type-analysis) + +; find which types are pure +(relation PureBaseType (BaseType)) +(relation PureType (Type)) +(relation PureTypeList (TypeList)) + +(PureBaseType (IntT)) +(PureBaseType (BoolT)) +(rule ((Base ty) + (PureBaseType ty)) + ((PureType (Base ty))) + :ruleset type-analysis) +(rule ((TupleT tylist) + (PureTypeList tylist)) + ((PureType (TupleT tylist))) + :ruleset type-analysis) +(rule ((TNil)) + ((PureTypeList (TNil))) + :ruleset type-analysis) +(rule ((TCons hd tl) + (PureBaseType hd) + (PureTypeList tl)) + ((PureTypeList (TCons hd tl))) + :ruleset type-analysis) + +(function ListExpr-length (ListExpr) i64) +(function ListExpr-ith (ListExpr i64) Expr :unextractable) +(function ListExpr-suffix (ListExpr i64) ListExpr :unextractable) +(function Append (ListExpr Expr) ListExpr :unextractable) + +(rule ((Switch pred inputs branch)) ((union (ListExpr-suffix branch 0) branch)) :ruleset always-run) + +(rule ((= (ListExpr-suffix top n) (Cons hd tl))) + ((union (ListExpr-ith top n) hd) + (union (ListExpr-suffix top (+ n 1)) tl)) :ruleset always-run) + +(rule ((= (ListExpr-suffix list n) (Nil))) + ((set (ListExpr-length list) n)) :ruleset always-run) + +(rewrite (Append (Cons a b) e) + (Cons a (Append b e)) + :ruleset always-run) +(rewrite (Append (Nil) e) + (Cons e (Nil)) + :ruleset always-run) + +(function tuple-length (Expr) i64 :unextractable) + +(rule ((HasType expr (TupleT tl)) + (= len (TypeList-length tl))) + ((set (tuple-length expr) len)) :ruleset always-run) + +;; Create a Get for every index, and rewrite it to see through Concat +(rule ((Single expr)) ((union (Get (Single expr) 0) expr)) :ruleset always-run) +;; initial get +(rule ((> (tuple-length tuple) 0)) + ((Get tuple 0)) + :ruleset always-run) +;; next get +(rule ((= len (tuple-length tuple)) + (= ith (Get tuple i)) + (< (+ i 1) len) + ) + ((Get tuple (+ 1 i))) + :ruleset always-run) + +;; descend left +(rule ((Get (Concat expr1 expr2) i) + (= (tuple-length expr1) len1) + (< i len1)) + ((union (Get (Concat expr1 expr2) i) + (Get expr1 i))) + :ruleset always-run) +;; descend right +(rule ((Get (Concat expr1 expr2) i) + (= (tuple-length expr1) len1) + (>= i len1)) + ((union (Get (Concat expr1 expr2) i) + (Get expr2 (- i len1)))) + :ruleset always-run) + + +;; A temporary context. +;; Be sure to delete at the end of all actions or else!!! +;; This is safer than using a persistant context, since we may miss an important part of the query. +(function TmpCtx () Assumption) + +(rule ((TmpCtx)) + ((panic "TmpCtx should not exist outside rule body")) + :ruleset always-run) + + +(ruleset subsume-after-helpers) +;; After running the `saturating` ruleset, these if statements can be subsumed +(relation ToSubsumeIf (Expr Expr Expr Expr)) +; (rule ((ToSubsumeIf a b c d)) +; ((subsume (If a b c d))) +; :ruleset subsume-after-helpers) + + + +(relation ExprIsValid (Expr)) +(relation ListExprIsValid (ListExpr)) +(rule ((ExprIsValid (Function _name _tyin _tyout _out))) ((ExprIsValid _out)) :ruleset always-run) +(rule ((ExprIsValid (Top _op _x _y _z))) ((ExprIsValid _x) +(ExprIsValid _y) +(ExprIsValid _z)) :ruleset always-run) +(rule ((ExprIsValid (Bop _op _x _y))) ((ExprIsValid _x) +(ExprIsValid _y)) :ruleset always-run) +(rule ((ExprIsValid (Uop _op _x))) ((ExprIsValid _x)) :ruleset always-run) +(rule ((ExprIsValid (Get _tup _i))) ((ExprIsValid _tup)) :ruleset always-run) +(rule ((ExprIsValid (Concat _x _y))) ((ExprIsValid _x) +(ExprIsValid _y)) :ruleset always-run) +(rule ((ExprIsValid (Single _x))) ((ExprIsValid _x)) :ruleset always-run) +(rule ((ExprIsValid (Switch _pred _inputs _branches))) ((ExprIsValid _pred) +(ExprIsValid _inputs) +(ListExprIsValid _branches)) :ruleset always-run) +(rule ((ExprIsValid (If _pred _input _then _else))) ((ExprIsValid _pred) +(ExprIsValid _input) +(ExprIsValid _then) +(ExprIsValid _else)) :ruleset always-run) +(rule ((ExprIsValid (DoWhile _in _pred-and-output))) ((ExprIsValid _in) +(ExprIsValid _pred-and-output)) :ruleset always-run) +(rule ((ExprIsValid (Call _func _arg))) ((ExprIsValid _arg)) :ruleset always-run) +(rule ((ListExprIsValid (Cons _hd _tl))) ((ExprIsValid _hd) +(ListExprIsValid _tl)) :ruleset always-run) +(rule ((ExprIsValid (Alloc _id _e _state _ty))) ((ExprIsValid _e) +(ExprIsValid _state)) :ruleset always-run) +(relation ExprIsResolved (Expr)) +(relation ListExprIsResolved (ListExpr)) +(rule ((= lhs (Function _name _tyin _tyout _out)) (ExprIsResolved _out)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Const _n _ty _ctx)) ) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Top _op _x _y _z)) (ExprIsResolved _x) +(ExprIsResolved _y) +(ExprIsResolved _z)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Bop _op _x _y)) (ExprIsResolved _x) +(ExprIsResolved _y)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Uop _op _x)) (ExprIsResolved _x)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Get _tup _i)) (ExprIsResolved _tup)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Concat _x _y)) (ExprIsResolved _x) +(ExprIsResolved _y)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Single _x)) (ExprIsResolved _x)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Switch _pred _inputs _branches)) (ExprIsResolved _pred) +(ExprIsResolved _inputs) +(ListExprIsResolved _branches)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (If _pred _input _then _else)) (ExprIsResolved _pred) +(ExprIsResolved _input) +(ExprIsResolved _then) +(ExprIsResolved _else)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (DoWhile _in _pred-and-output)) (ExprIsResolved _in) +(ExprIsResolved _pred-and-output)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Arg _ty _ctx)) ) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Call _func _arg)) (ExprIsResolved _arg)) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Empty _ty _ctx)) ) ((ExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Cons _hd _tl)) (ExprIsResolved _hd) +(ListExprIsResolved _tl)) ((ListExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Nil)) ) ((ListExprIsResolved lhs)) :ruleset always-run) +(rule ((= lhs (Alloc _id _e _state _ty)) (ExprIsResolved _e) +(ExprIsResolved _state)) ((ExprIsResolved lhs)) :ruleset always-run) +(relation BodyContainsExpr (Expr Expr)) +(relation BodyContainsListExpr (Expr ListExpr)) +(rule ((Function _name _tyin _tyout _out)) ((BodyContainsExpr (Function _name _tyin _tyout _out) _out)) :ruleset always-run) +(rule ((If _pred _input _then _else)) ((BodyContainsExpr (If _pred _input _then _else) _then) (BodyContainsExpr (If _pred _input _then _else) _else)) :ruleset always-run) +(rule ((DoWhile _in _pred-and-output)) ((BodyContainsExpr (DoWhile _in _pred-and-output) _pred-and-output)) :ruleset always-run) +(rule ((BodyContainsExpr body (Top _op _x _y _z))) ((BodyContainsExpr body _x) (BodyContainsExpr body _y) (BodyContainsExpr body _z)) :ruleset always-run) +(rule ((BodyContainsExpr body (Bop _op _x _y))) ((BodyContainsExpr body _x) (BodyContainsExpr body _y)) :ruleset always-run) +(rule ((BodyContainsExpr body (Uop _op _x))) ((BodyContainsExpr body _x)) :ruleset always-run) +(rule ((BodyContainsExpr body (Get _tup _i))) ((BodyContainsExpr body _tup)) :ruleset always-run) +(rule ((BodyContainsExpr body (Concat _x _y))) ((BodyContainsExpr body _x) (BodyContainsExpr body _y)) :ruleset always-run) +(rule ((BodyContainsExpr body (Single _x))) ((BodyContainsExpr body _x)) :ruleset always-run) +(rule ((BodyContainsExpr body (Switch _pred _inputs _branches))) ((BodyContainsExpr body _pred) (BodyContainsExpr body _inputs)) :ruleset always-run) +(rule ((BodyContainsExpr body (If _pred _input _then _else))) ((BodyContainsExpr body _pred) (BodyContainsExpr body _input)) :ruleset always-run) +(rule ((BodyContainsExpr body (DoWhile _in _pred-and-output))) ((BodyContainsExpr body _in)) :ruleset always-run) +(rule ((BodyContainsExpr body (Call _func _arg))) ((BodyContainsExpr body _arg)) :ruleset always-run) +(rule ((BodyContainsListExpr body (Cons _hd _tl))) ((BodyContainsExpr body _hd)) :ruleset always-run) +(rule ((BodyContainsExpr body (Alloc _id _e _state _ty))) ((BodyContainsExpr body _e) (BodyContainsExpr body _state)) :ruleset always-run) + + (relation ExprIsPure (Expr)) + (relation ListExprIsPure (ListExpr)) + (relation BinaryOpIsPure (BinaryOp)) + (relation UnaryOpIsPure (UnaryOp)) + (relation TopIsPure (TernaryOp)) +(TopIsPure (Select)) +(BinaryOpIsPure (Add)) +(BinaryOpIsPure (Sub)) +(BinaryOpIsPure (Mul)) +(BinaryOpIsPure (Div)) +(BinaryOpIsPure (Eq)) +(BinaryOpIsPure (LessThan)) +(BinaryOpIsPure (GreaterThan)) +(BinaryOpIsPure (LessEq)) +(BinaryOpIsPure (GreaterEq)) +(BinaryOpIsPure (FAdd)) +(BinaryOpIsPure (FSub)) +(BinaryOpIsPure (FMul)) +(BinaryOpIsPure (FDiv)) +(BinaryOpIsPure (FEq)) +(BinaryOpIsPure (FLessThan)) +(BinaryOpIsPure (FGreaterThan)) +(BinaryOpIsPure (FLessEq)) +(BinaryOpIsPure (FGreaterEq)) +(BinaryOpIsPure (And)) +(BinaryOpIsPure (Or)) +(BinaryOpIsPure (PtrAdd)) +(UnaryOpIsPure (Not)) + + (rule ((Function _name _tyin _tyout _out) (ExprIsPure _out)) + ((ExprIsPure (Function _name _tyin _tyout _out))) + :ruleset always-run) + + (rule ((Const _n _ty _ctx)) + ((ExprIsPure (Const _n _ty _ctx))) + :ruleset always-run) + + (rule ((Top _op _x _y _z) (ExprIsPure _x) (ExprIsPure _y) (ExprIsPure _z)) + ((ExprIsPure (Top _op _x _y _z))) + :ruleset always-run) + + (rule ((Bop _op _x _y) (BinaryOpIsPure _op) (ExprIsPure _x) (ExprIsPure _y)) + ((ExprIsPure (Bop _op _x _y))) + :ruleset always-run) + + (rule ((Uop _op _x) (UnaryOpIsPure _op) (ExprIsPure _x)) + ((ExprIsPure (Uop _op _x))) + :ruleset always-run) + + (rule ((Get _tup _i) (ExprIsPure _tup)) + ((ExprIsPure (Get _tup _i))) + :ruleset always-run) + + (rule ((Concat _x _y) (ExprIsPure _x) (ExprIsPure _y)) + ((ExprIsPure (Concat _x _y))) + :ruleset always-run) + + (rule ((Single _x) (ExprIsPure _x)) + ((ExprIsPure (Single _x))) + :ruleset always-run) + + (rule ((Switch _pred _inputs _branches) (ExprIsPure _pred) (ExprIsPure _inputs) (ListExprIsPure _branches)) + ((ExprIsPure (Switch _pred _inputs _branches))) + :ruleset always-run) + + (rule ((If _pred _input _then _else) (ExprIsPure _pred) (ExprIsPure _input) (ExprIsPure _then) (ExprIsPure _else)) + ((ExprIsPure (If _pred _input _then _else))) + :ruleset always-run) + + (rule ((DoWhile _in _pred-and-output) (ExprIsPure _in) (ExprIsPure _pred-and-output)) + ((ExprIsPure (DoWhile _in _pred-and-output))) + :ruleset always-run) + + (rule ((Arg _ty _ctx)) + ((ExprIsPure (Arg _ty _ctx))) + :ruleset always-run) + + (rule ((Call _f _arg) (ExprIsPure _arg) (ExprIsPure (Function _f inty outty out))) + ((ExprIsPure (Call _f _arg))) + :ruleset always-run) + + (rule ((Empty _ty _ctx)) + ((ExprIsPure (Empty _ty _ctx))) + :ruleset always-run) + + (rule ((Cons _hd _tl) (ExprIsPure _hd) (ListExprIsPure _tl)) + ((ListExprIsPure (Cons _hd _tl))) + :ruleset always-run) + + (rule ((Nil)) + ((ListExprIsPure (Nil))) + :ruleset always-run) + +; This file provides AddContext, a helpers that copies a sub-egraph into +; a new one with a new context. +; Users of AddContext can specify how deeply to do this copy. + + +(ruleset context) + +(function AddContext (Assumption Expr) Expr :unextractable) +(function AddContextList (Assumption ListExpr) ListExpr :unextractable) + +;; ################################ saturation + +;; Adding context a second time does nothing, so union +(rule + ((= lhs (AddContext ctx inner)) + (= inner (AddContext ctx expr))) + ((union lhs inner)) + :ruleset context) + + +;; ############################## Base cases- leaf nodes + +;; replace existing contexts that are around leaf nodes +;; AddContext assumes the new context is more specific than the old one +(rule ((= lhs (AddContext ctx (Arg ty oldctx)))) + ((union lhs (Arg ty ctx))) + :ruleset context) +(rule ((= lhs (AddContext ctx (Const c ty oldctx)))) + ((union lhs (Const c ty ctx))) + :ruleset context) +(rule ((= lhs (AddContext ctx (Empty ty oldctx)))) + ((union lhs (Empty ty ctx))) + :ruleset context) + + + + +;; ######################################### Operators +(rewrite (AddContext ctx (Bop op c1 c2)) + (Bop op + (AddContext ctx c1) + (AddContext ctx c2)) + :ruleset context) +(rewrite (AddContext ctx (Uop op c1)) + (Uop op (AddContext ctx c1)) + :ruleset context) +(rewrite (AddContext ctx (Get c1 index)) + (Get (AddContext ctx c1) index) + :ruleset context) +(rewrite (AddContext ctx (Alloc id c1 state ty)) + (Alloc id (AddContext ctx c1) (AddContext ctx state) ty) + :ruleset context) +(rewrite (AddContext ctx (Call name c1)) + (Call name (AddContext ctx c1)) + :ruleset context) + +(rewrite (AddContext ctx (Single c1)) + (Single (AddContext ctx c1)) + :ruleset context) +(rewrite (AddContext ctx (Concat c1 c2)) + (Concat + (AddContext ctx c1) + (AddContext ctx c2)) + :ruleset context) + +;; ################################### List operators + +(rewrite (AddContextList ctx (Nil)) + (Nil) + :ruleset context) + +(rewrite (AddContextList ctx (Cons c1 rest)) + (Cons (AddContext ctx c1) + (AddContextList ctx rest)) + :ruleset context) + + +;; ########################################## Control flow +(rewrite (AddContext ctx (Switch pred inputs branches)) + (Switch (AddContext ctx pred) + (AddContext ctx inputs) + branches) + :ruleset context) + +;; For stop at region, still add context to inputs +(rule ((= lhs (AddContext ctx (If pred inputs c1 c2)))) + ((union lhs + (If (AddContext ctx pred) + (AddContext ctx inputs) + c1 + c2))) + :ruleset context) + + +;; For stop at loop, still add context to inputs +(rule ((= lhs (AddContext ctx (DoWhile inputs outputs)))) + ((union lhs + (DoWhile + (AddContext ctx inputs) + outputs))) + :ruleset context) + + +;; Substitution rules allow for substituting some new expression for the argument +;; in some new context. +;; It performs the substitution, copying over the equalities from the original eclass. +;; It only places context on the leaf nodes. + +(ruleset subst) +(ruleset apply-subst-unions) +(ruleset cleanup-subst) + +;; (Subst assumption to in) substitutes `to` for `(Arg ty)` in `in`. +;; It also replaces the leaf context in `to` with `assumption` using `AddContext`. +;; `assumption` *justifies* this substitution, as the context that the result is used in. +;; In other words, it must refine the equivalence relation of `in` with `to` as the argument. +(function Subst (Assumption Expr Expr) Expr ) + +;; Used to delay unions for the subst ruleset. +;; This is necessary because substitution may not terminate if it can +;; observe its own results- it may create infinitly large terms. +;; Instead, we phase substitution by delaying resulting unions in this table. +;; After applying this table, substitutions and this table are cleared. +(function DelayedSubstUnion (Expr Expr) Expr ) + +;; add a type rule to get the arg type of a substitution +;; this enables nested substitutions +(rule ((= lhs (Subst assum to in)) + (HasArgType to ty)) + ((HasArgType lhs ty)) + :ruleset subst) + +;; leaf node with context +;; replace this context- subst assumes the context is more specific +(rule ((= lhs (Subst assum to (Arg ty oldctx))) + ) + ;; add the assumption `to` + ((DelayedSubstUnion lhs (AddContext assum to))) + :ruleset subst) +(rule ((= lhs (Subst assum to (Const c ty oldctx))) + (HasArgType to newty)) + ((DelayedSubstUnion lhs (Const c newty assum))) + :ruleset subst) +(rule ((= lhs (Subst assum to (Empty ty oldctx))) + (HasArgType to newty)) + ((DelayedSubstUnion lhs (Empty newty assum))) + :ruleset subst) + +;; Operators +(rule ((= lhs (Subst assum to (Bop op c1 c2))) + (ExprIsResolved (Bop op c1 c2))) + ((DelayedSubstUnion lhs + (Bop op (Subst assum to c1) + (Subst assum to c2)))) + :ruleset subst) +(rule ((= lhs (Subst assum to (Uop op c1))) + (ExprIsResolved (Uop op c1))) + ((DelayedSubstUnion lhs + (Uop op (Subst assum to c1)))) + :ruleset subst) + +(rule ((= lhs (Subst assum to (Get c1 index))) + (ExprIsResolved (Get c1 index))) + ((DelayedSubstUnion lhs + (Get (Subst assum to c1) index))) + :ruleset subst) +(rule ((= lhs (Subst assum to (Alloc id c1 c2 ty))) + (ExprIsResolved (Alloc id c1 c2 ty))) + ((DelayedSubstUnion lhs + (Alloc id (Subst assum to c1) + (Subst assum to c2) + ty))) + :ruleset subst) +(rule ((= lhs (Subst assum to (Call name c1))) + (ExprIsResolved (Call name c1))) + ((DelayedSubstUnion lhs + (Call name (Subst assum to c1)))) + :ruleset subst) + + +;; Tuple operators +(rule ((= lhs (Subst assum to (Single c1))) + (ExprIsResolved (Single c1))) + ((DelayedSubstUnion lhs + (Single (Subst assum to c1)))) + :ruleset subst) +(rule ((= lhs (Subst assum to (Concat c1 c2))) + (ExprIsResolved (Concat c1 c2))) + ((DelayedSubstUnion lhs + (Concat (Subst assum to c1) + (Subst assum to c2)))) + :ruleset subst) + +;; Control flow +(rule ((= lhs (Subst assum to inner)) + (= inner (Switch pred inputs c1)) + (ExprIsResolved inner)) + ((DelayedSubstUnion lhs + (Switch (Subst assum to pred) + (Subst assum to inputs) + c1))) + :ruleset subst) +(rule ((= lhs (Subst assum to inner)) + (= inner (If pred inputs c1 c2)) + (ExprIsResolved inner)) + ((DelayedSubstUnion lhs + (If (Subst assum to pred) + (Subst assum to inputs) + c1 + c2))) + :ruleset subst) +(rule ((= lhs (Subst assum to (DoWhile in out))) + (ExprIsResolved (DoWhile in out))) + ((DelayedSubstUnion lhs + (DoWhile (Subst assum to in) + out))) + :ruleset subst) + +;; substitute into function (convenience for testing) +(rewrite (Subst assum to (Function name inty outty body)) + (Function name inty outty (Subst assum to body)) + :when ((ExprIsResolved body)) + :ruleset subst) + + + +;; ########################### Apply subst unions + +(rule ((DelayedSubstUnion lhs rhs)) + ((union lhs rhs)) + :ruleset apply-subst-unions) + + +;; ########################### Cleanup subst and DelayedSubstUnion + +(rule ((DelayedSubstUnion lhs rhs)) + ((subsume (DelayedSubstUnion lhs rhs))) + :ruleset cleanup-subst) + +; this cleanup is important- if we don't subsume these substitutions, they +; may oberve their own results and create infinitely sized terms. +; ex: get(parallel!(arg(), int(2)), 0) ignores the first element of the tuple +; so it's equivalent to infinite other times with any other value as the first element of the tuple. +; Check ExprIsResolved to confirm that the substitution finished (all sub-substitutions are done). +(rule ((ExprIsResolved (Subst assum to in))) + ((subsume (Subst assum to in))) + :ruleset cleanup-subst) + +; We only have context for Exprs, not ListExprs. +(relation ContextOf (Expr Assumption)) + +(rule ((Arg ty ctx)) + ((ContextOf (Arg ty ctx) ctx)) + :ruleset always-run) +(rule ((Const c ty ctx)) + ((ContextOf (Const c ty ctx) ctx)) + :ruleset always-run) +(rule ((Empty ty ctx)) + ((ContextOf (Empty ty ctx) ctx)) + :ruleset always-run) + +; Error checking - each expr should only have a single context +(rule ((ContextOf x ctx1) + (ContextOf x ctx2) + (!= ctx1 ctx2)) + ( + (panic "Equivalent expressions have nonequivalent context, breaking the single context invariant.") + ) + :ruleset error-checking) + + +(rule ((Top op x y z) (ContextOf x ctx)) + ((ContextOf (Top op x y z) ctx)) :ruleset always-run) + +(rule ((Top op x y z) (ContextOf y ctx)) + ((ContextOf (Top op x y z) ctx)) :ruleset always-run) + +(rule ((Top op x y z) (ContextOf z ctx)) + ((ContextOf (Top op x y z) ctx)) :ruleset always-run) + +(rule ((Bop op x y) (ContextOf x ctx)) + ((ContextOf (Bop op x y) ctx)) :ruleset always-run) + +(rule ((Bop op x y) (ContextOf y ctx)) + ((ContextOf (Bop op x y) ctx)) :ruleset always-run) + +(rule ((Uop op x) (ContextOf x ctx)) + ((ContextOf (Uop op x) ctx)) :ruleset always-run) + +(rule ((Get tup i) (ContextOf tup ctx)) + ((ContextOf (Get tup i) ctx)) :ruleset always-run) + +(rule ((Concat x y) (ContextOf x ctx)) + ((ContextOf (Concat x y) ctx)) :ruleset always-run) + +(rule ((Concat x y) (ContextOf y ctx)) + ((ContextOf (Concat x y) ctx)) :ruleset always-run) + +(rule ((Single x) (ContextOf x ctx)) + ((ContextOf (Single x) ctx)) :ruleset always-run) + +(rule ((Switch pred inputs branches) (ContextOf pred ctx)) + ((ContextOf (Switch pred inputs branches) ctx)) :ruleset always-run) + +(rule ((If pred inputs then else) (ContextOf pred ctx)) + ((ContextOf (If pred inputs then else) ctx)) :ruleset always-run) + +(rule ((If pred inputs then else) (ContextOf inputs ctx)) + ((ContextOf (If pred inputs then else) ctx)) :ruleset always-run) + +(rule ((DoWhile in pred-and-output) (ContextOf in ctx)) + ((ContextOf (DoWhile in pred-and-output) ctx)) :ruleset always-run) + +(rule ((Call func arg) (ContextOf arg ctx)) + ((ContextOf (Call func arg) ctx)) :ruleset always-run) + +(rule ((Alloc amt e state ty) (ContextOf e ctx)) + ((ContextOf (Alloc amt e state ty) ctx)) :ruleset always-run) + +(rule ((Alloc amt e state ty) (ContextOf state ctx)) + ((ContextOf (Alloc amt e state ty) ctx)) :ruleset always-run) + +(ruleset canon) + +; Commutativity +(rewrite (Bop (Add) x y) (Bop (Add) y x) :ruleset canon) +(rewrite (Bop (Mul) x y) (Bop (Mul) y x) :ruleset canon) +(rewrite (Bop (Eq) x y) (Bop (Eq) y x) :ruleset canon) +(rewrite (Bop (And) x y) (Bop (And) y x) :ruleset canon) +(rewrite (Bop (Or) x y) (Bop (Or) y x) :ruleset canon) + +; Canonicalize to < +; x > y ==> y < x +(rewrite (Bop (GreaterThan) x y) (Bop (LessThan) y x) :ruleset canon) + +; x >= y ==> y < x + 1 +; x >= y ==> y - 1 < x +(rule ( + (= lhs (Bop (GreaterEq) x y)) + (HasArgType x ty) + (ContextOf lhs ctx) + ) + ( + (union lhs (Bop (LessThan) y (Bop (Add) x (Const (Int 1) ty ctx)))) + (union lhs (Bop (LessThan) (Bop (Sub) y (Const (Int 1) ty ctx)) x)) + ) + :ruleset canon) + +; x <= y ==> x < y + 1 +; x <= y ==> x - 1 < y +(rule ( + (= lhs (Bop (LessEq) x y)) + (HasArgType y ty) + (ContextOf lhs ctx) + ) + ( + (union lhs (Bop (LessThan) x (Bop (Add) y (Const (Int 1) ty ctx)))) + (union lhs (Bop (LessThan) (Bop (Sub) x (Const (Int 1) ty ctx)) y)) + ) + :ruleset canon) + + +; Make Concats right-deep +(rewrite (Concat (Concat a b) c) + (Concat a (Concat b c)) + :ruleset always-run) +; Simplify Concat's with empty +(rewrite (Concat (Empty ty ctx) x) + x + :ruleset always-run) +(rewrite (Concat x (Empty ty ctx)) + x + :ruleset always-run) + +; Make a tuple that is a sub-range of another tuple +; tuple start len +(function SubTuple (Expr i64 i64) Expr :unextractable) + +(rewrite (SubTuple expr x 0) + (Empty ty ctx) + :when ((HasArgType expr ty) (ContextOf expr ctx)) + :ruleset always-run) + +(rewrite (SubTuple expr x 1) + (Single (Get expr x)) + :ruleset always-run) + +(rewrite (SubTuple expr a b) + (Concat (Single (Get expr a)) (SubTuple expr (+ a 1) (- b 1))) + :when ((> b 1)) + :ruleset always-run) + +; Helper functions to remove one element from a tuple or type list +; tuple idx +(function TupleRemoveAt (Expr i64) Expr :unextractable) +(function TypeListRemoveAt (TypeList i64) TypeList :unextractable) + +(rewrite (TupleRemoveAt tuple idx) + (Concat (SubTuple tuple 0 idx) + (SubTuple tuple (+ idx 1) (- len (+ idx 1)))) + :when ((= len (tuple-length tuple))) + :ruleset always-run) + +(rewrite (TypeListRemoveAt (TNil) _idx) (TNil) :ruleset always-run) +(rewrite (TypeListRemoveAt (TCons x xs) 0 ) xs :ruleset always-run) +(rewrite (TypeListRemoveAt (TCons x xs) idx) + (TCons x (TypeListRemoveAt xs (- idx 1))) + :when ((> idx 0)) + :ruleset always-run) + +;; Compute the tree size of program, not dag size +(function Expr-size (Expr) i64 :unextractable :merge (min old new) ) +(function ListExpr-size (ListExpr) i64 :unextractable :merge (min old new)) + +(rule ((= expr (Function name tyin tyout out)) + (= sum (Expr-size out))) + ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) + +(rule ((= expr (Const n ty assum))) + ((set (Expr-size expr) 1)) :ruleset always-run) + +(rule ((= expr (Bop op x y)) + (= sum (+ (Expr-size y) (Expr-size x)))) + ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) + +(rule ((= expr (Uop op x)) + (= sum (Expr-size x))) + ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) + +(rule ((= expr (Get tup i)) + (= sum (Expr-size tup))) + ((set (Expr-size expr) sum)) :ruleset always-run) + +(rule ((= expr (Concat x y)) + (= sum (+ (Expr-size y) (Expr-size x)))) + ((set (Expr-size expr) sum)) :ruleset always-run) + +(rule ((= expr (Single x)) + (= sum (Expr-size x))) + ((set (Expr-size expr) sum)) :ruleset always-run) + +(rule ((= expr (Switch pred inputs branches)) + (= sum (+ (Expr-size inputs) (+ (ListExpr-size branches) (Expr-size pred))))) + ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) + +(rule ((= expr (If pred inputs then else)) + (= sum (+ (Expr-size inputs) (+ (Expr-size else) (+ (Expr-size then) (Expr-size pred)))))) + ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) + +(rule ((= expr (DoWhile in pred-and-output)) + (= sum (+ (Expr-size pred-and-output) (Expr-size in)))) + ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) + +(rule ((= expr (Arg ty assum))) + ((set (Expr-size expr) 1)) :ruleset always-run) + +(rule ((= expr (Call func arg)) + (= sum (Expr-size arg))) + ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) + +(rule ((Empty ty assum)) ((set (Expr-size (Empty ty assum)) 0)) :ruleset always-run) + +(rule ((= expr (Cons hd tl)) + (= sum (+ (ListExpr-size tl) (Expr-size hd)))) + ((set (ListExpr-size expr) sum)) :ruleset always-run) + +(rule ((Nil)) + ((set (ListExpr-size (Nil)) 0)) :ruleset always-run) + +(rule ((= expr (Alloc id e state ty)) ;; do state edge's expr should be counted? + (= sum (Expr-size e))) + ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) +;; Like Subst but for dropping inputs to a region +;; See subst.egg for more implementation documentation + +(ruleset drop) +(ruleset apply-drop-unions) +(ruleset cleanup-drop) + +;; (DropAt ctx idx in) removes all references to `(Get (Arg ...) idx)` in `in`. +;; It also replaces the leaf contexts with `ctx` and fixes up argument types, +;; as well as updating `(Get (Arg ...) j)` to `(Get (Arg ...) (- j 1))` for j > idx. +(function DropAt (Assumption i64 Expr) Expr :unextractable) +(function DelayedDropUnion (Expr Expr) Expr :unextractable) + +;; Helper that precomputes the arg type that we need +(function DropAtInternal (Type Assumption i64 Expr) Expr :unextractable) +(rule ((= lhs (DropAt ctx idx in)) + (HasArgType in (TupleT oldty))) + + ((let newty (TupleT (TypeListRemoveAt oldty idx))) + (union lhs (DropAtInternal newty ctx idx in))) + :ruleset drop) + +;; Leaves +(rule ((= lhs (DropAtInternal newty newctx idx (Const c oldty oldctx)))) + ((DelayedDropUnion lhs (Const c newty newctx))) + :ruleset drop) +(rule ((= lhs (DropAtInternal newty newctx idx (Empty oldty oldctx)))) + ((DelayedDropUnion lhs (Empty newty newctx))) + :ruleset drop) +; get stuck on purpose if `i = idx` or if we find a bare `Arg` +(rule ((= lhs (DropAtInternal newty newctx idx (Get (Arg oldty oldctx) i))) + (< i idx)) + ((DelayedDropUnion lhs (Get (Arg newty newctx) i))) + :ruleset drop) +(rule ((= lhs (DropAtInternal newty newctx idx (Get (Arg oldty oldctx) i))) + (> i idx)) + ((DelayedDropUnion lhs (Get (Arg newty newctx) (- i 1)))) + :ruleset drop) + +;; Operators +(rule ((= lhs (DropAtInternal newty newctx idx (Bop op c1 c2))) + (ExprIsResolved (Bop op c1 c2))) + ((DelayedDropUnion lhs (Bop op + (DropAtInternal newty newctx idx c1) + (DropAtInternal newty newctx idx c2)))) + :ruleset drop) + +(rule ((= lhs (DropAtInternal newty newctx idx (Uop op c1))) + (ExprIsResolved (Uop op c1))) + ((DelayedDropUnion lhs (Uop op + (DropAtInternal newty newctx idx c1)))) + :ruleset drop) + +;; this is okay because we get stuck at `Arg`s +(rule ((= lhs (DropAtInternal newty newctx idx (Get c1 index))) + (ExprIsResolved (Get c1 index))) + ((DelayedDropUnion lhs (Get + (DropAtInternal newty newctx idx c1) + index))) + :ruleset drop) + +(rule ((= lhs (DropAtInternal newty newctx idx (Alloc id c1 c2 ty))) + (ExprIsResolved (Alloc id c1 c2 ty))) + ((DelayedDropUnion lhs (Alloc id + (DropAtInternal newty newctx idx c1) + (DropAtInternal newty newctx idx c2) + ty))) + :ruleset drop) + +(rule ((= lhs (DropAtInternal newty newctx idx (Call name c1))) + (ExprIsResolved (Call name c1))) + ((DelayedDropUnion lhs (Call name + (DropAtInternal newty newctx idx c1)))) + :ruleset drop) + +;; Tuple operators +(rule ((= lhs (DropAtInternal newty newctx idx (Single c1))) + (ExprIsResolved (Single c1))) + ((DelayedDropUnion lhs (Single + (DropAtInternal newty newctx idx c1)))) + :ruleset drop) + +(rule ((= lhs (DropAtInternal newty newctx idx (Concat c1 c2))) + (ExprIsResolved (Concat c1 c2))) + ((DelayedDropUnion lhs (Concat + (DropAtInternal newty newctx idx c1) + (DropAtInternal newty newctx idx c2)))) + :ruleset drop) + +;; Control flow +(rule ((= lhs (DropAtInternal newty newctx idx (Switch pred inputs c1))) + (ExprIsResolved (Switch pred inputs c1))) + ((DelayedDropUnion lhs (Switch + (DropAtInternal newty newctx idx pred) + (DropAtInternal newty newctx idx inputs) + c1))) + :ruleset drop) + +(rule ((= lhs (DropAtInternal newty newctx idx (If pred inputs c1 c2))) + (ExprIsResolved (If pred inputs c1 c2))) + ((DelayedDropUnion lhs (If + (DropAtInternal newty newctx idx pred) + (DropAtInternal newty newctx idx inputs) + c1 + c2))) + :ruleset drop) + +(rule ((= lhs (DropAtInternal newty newctx idx (DoWhile in out))) + (ExprIsResolved (DoWhile in out))) + ((DelayedDropUnion lhs (DoWhile + (DropAtInternal newty newctx idx in) + out))) + :ruleset drop) + +(rewrite (DropAtInternal newty newctx idx (Function name inty outty body)) + (Function name inty outty (DropAtInternal newty newctx idx body)) + :when ((ExprIsResolved body)) + :ruleset drop) + + + +;; ########################### Apply drop unions + +(rule ((DelayedDropUnion lhs rhs)) + ((union lhs rhs)) + :ruleset apply-drop-unions) + +;; ########################### Cleanup Dropat, DropAtInternal and DelayedDropUnion + +(rule ((ExprIsResolved (DropAt newctx idx in))) + ((subsume (DropAt newctx idx in))) + :ruleset cleanup-drop) + +(rule ((ExprIsResolved (DropAtInternal newty newctx idx in))) + ((subsume (DropAtInternal newty newctx idx in))) + :ruleset cleanup-drop) + +(rule ((DelayedDropUnion lhs rhs)) + ((subsume (DelayedDropUnion lhs rhs))) + :ruleset cleanup-drop) + +(ruleset interval-analysis) + +(datatype Bound + (IntB i64) + (BoolB bool) + (bound-max Bound Bound) + (bound-min Bound Bound)) + +; bound tables +(function lo-bound (Expr) Bound :unextractable :merge (bound-max old new)) +(function hi-bound (Expr) Bound :unextractable :merge (bound-min old new)) + +; if lo > hi, panic +; We can't run these rules because unreachable branches may have impossible intervals +; Consider re-enabling these rules if we implement an is-reachable analysis +; (rule ( +; (= (IntB lo) (lo-bound expr)) +; (= (IntB hi) (hi-bound expr)) +; (> lo hi) +; ) +; ((panic "lo bound greater than hi bound")) +; :ruleset interval-analysis) +; (rule ( +; (= (BoolB true) (lo-bound expr)) +; (= (BoolB false) (hi-bound expr)) +; ) +; ((panic "lo bound greater than hi bound")) +; :ruleset interval-analysis) + +; combinators +(rewrite (bound-max (IntB x) (IntB y)) + (IntB (max x y)) + :ruleset interval-analysis) +(rewrite (bound-min (IntB x) (IntB y)) + (IntB (min x y)) + :ruleset interval-analysis) +(rewrite (bound-max (BoolB x) (BoolB y)) + (BoolB (or x y)) + :ruleset interval-analysis) +(rewrite (bound-min (BoolB x) (BoolB y)) + (BoolB (and x y)) + :ruleset interval-analysis) + +; ================================= +; Constants +; ================================= +(rule ((= lhs (Const (Int x) ty ctx))) + ( + (set (lo-bound lhs) (IntB x)) + (set (hi-bound lhs) (IntB x)) + ) + :ruleset interval-analysis) + +(rule ((= lhs (Const (Bool x) ty ctx))) + ( + (set (lo-bound lhs) (BoolB x)) + (set (hi-bound lhs) (BoolB x)) + ) + :ruleset interval-analysis) + +; ================================= +; Constant Folding +; ================================= +(rule ( + (= (IntB x) (lo-bound expr)) + (= (IntB x) (hi-bound expr)) + (HasArgType expr ty) + (ContextOf expr ctx) + ) + ((union expr (Const (Int x) ty ctx))) + :ruleset interval-analysis) + +(rule ( + (= (BoolB x) (lo-bound expr)) + (= (BoolB x) (hi-bound expr)) + (HasArgType expr ty) + (ContextOf expr ctx) + ) + ((union expr (Const (Bool x) ty ctx))) + :ruleset interval-analysis) + +; lower bound being true means the bool must be true +(rule ( + (= (BoolB true) (lo-bound expr)) + (HasArgType expr ty) + (ContextOf expr ctx) + ) + ((union expr (Const (Bool true) ty ctx))) + :ruleset interval-analysis) + +; upper bound being false means the bool must be false +(rule ( + (= (BoolB false) (hi-bound expr)) + (HasArgType expr ty) + (ContextOf expr ctx) + ) + ((union expr (Const (Bool false) ty ctx))) + :ruleset interval-analysis) + +; ================================= +; Arithmetic +; ================================= +; + a b interval is (+ la lb) (+ ha hb) +(rule ( + (= lhs (Bop (Add) a b)) + (= (IntB la) (lo-bound a)) + (= (IntB lb) (lo-bound b)) + ) + ((set (lo-bound lhs) (IntB (+ la lb)))) + :ruleset interval-analysis) +(rule ( + (= lhs (Bop (Add) a b)) + (= (IntB ha) (hi-bound a)) + (= (IntB hb) (hi-bound b)) + ) + ((set (hi-bound lhs) (IntB (+ ha hb)))) + :ruleset interval-analysis) + +; - a b interval is (- la hb) (- ha lb) +(rule ( + (= lhs (Bop (Sub) a b)) + (= (IntB la) (lo-bound a)) + (= (IntB hb) (hi-bound b)) + ) + ((set (lo-bound lhs) (IntB (- la hb)))) + :ruleset interval-analysis) +(rule ( + (= lhs (Bop (Sub) a b)) + (= (IntB ha) (hi-bound a)) + (= (IntB lb) (lo-bound b)) + ) + ((set (hi-bound lhs) (IntB (- ha lb)))) + :ruleset interval-analysis) + +; Multiplication for two constants +; TODO: Make fancier interval analysis +(rule ( + (= lhs (Bop (Mul) a b)) + (= (IntB x) (lo-bound a)) + (= (IntB x) (hi-bound a)) + (= (IntB y) (lo-bound b)) + (= (IntB y) (hi-bound b)) + ) + ( + (set (lo-bound lhs) (IntB (* x y))) + (set (hi-bound lhs) (IntB (* x y))) + ) + :ruleset interval-analysis) + +; negative * negative is positive +(rule ( + (= lhs (Bop (Mul) x y)) + (= (IntB hi-x) (hi-bound x)) + (= (IntB hi-y) (hi-bound y)) + (<= hi-x 0) + (<= hi-y 0) + ) + ((set (lo-bound lhs) (IntB 0))) + :ruleset interval-analysis) + +; negative * positive is negative +(rule ( + (= lhs (Bop (Mul) x y)) + (= (IntB hi-x) (hi-bound x)) + (= (IntB lo-y) (lo-bound y)) + (<= hi-x 0) ; x <= 0 (x is negative) + (>= lo-y 0) ; y >= 0 (y is positive) + ) + ((set (hi-bound lhs) (IntB 0))) + :ruleset interval-analysis) + +; positive * positive is positive +(rule ( + (= lhs (Bop (Mul) x y)) + (= (IntB lo-x) (lo-bound x)) + (= (IntB lo-y) (lo-bound y)) + (>= lo-x 0) + (>= lo-y 0) + ) + ((set (lo-bound lhs) (IntB 0))) + :ruleset interval-analysis) + +; < a b interval is (< ha lb) (< la hb) +(rule ( + (= lhs (Bop (LessThan) a b)) + (= (IntB ha) (hi-bound a)) + (= (IntB lb) (lo-bound b)) + ) + ( + (set (lo-bound lhs) (BoolB (bool-< ha lb))) + ) + :ruleset interval-analysis) +(rule ( + (= lhs (Bop (LessThan) a b)) + (= (IntB la) (lo-bound a)) + (= (IntB hb) (hi-bound b)) + ) + ((set (hi-bound lhs) (BoolB (bool-< la hb)))) + :ruleset interval-analysis) + +; ================================= +; Conditionals +; ================================= +; if the predicate is true, merge with then branch +(rule ( + (= lhs (If cond inputs thn els)) + (ContextOf lhs if_ctx) + (= (BoolB true) (lo-bound cond)) + ) + ((union lhs (Subst if_ctx inputs thn))) + :ruleset interval-analysis) + +; if the predicate is false, merge with else branch +(rule ( + (= lhs (If cond inputs thn els)) + (ContextOf lhs if_ctx) + (= (BoolB false) (hi-bound cond)) + ) + ((union lhs (Subst if_ctx inputs els))) + :ruleset interval-analysis) + +; lo-bound of If is the min of the lower bounds +; hi-bound of If is the max of the upper bounds +(rule ( + (= lhs (If cond inputs thn els)) + (= lo-thn (lo-bound thn)) + (= lo-els (lo-bound els)) + ) + ((set (lo-bound lhs) (bound-min lo-thn lo-els))) + :ruleset interval-analysis) +(rule ( + (= lhs (If cond inputs thn els)) + (= hi-thn (hi-bound thn)) + (= hi-els (hi-bound els)) + ) + ((set (hi-bound lhs) (bound-max hi-thn hi-els))) + :ruleset interval-analysis) + +; Same rules, but for Ifs that have multiple outputs +(rule ( + (= lhs (If pred inputs thn els)) + (= lo-thn (lo-bound (Get thn i))) + (= lo-els (lo-bound (Get els i))) + ) + ((set (lo-bound (Get lhs i)) (bound-min lo-thn lo-els))) + :ruleset interval-analysis) +(rule ( + (= lhs (If cond inputs thn els)) + (= hi-thn (hi-bound (Get thn i))) + (= hi-els (hi-bound (Get els i))) + ) + ((set (hi-bound (Get lhs i)) (bound-max hi-thn hi-els))) + :ruleset interval-analysis) + +; If the If takes a tuple +(rule ( + ; expr < value + (= pred (Bop (LessThan) expr value)) + (= if_e (If pred inputs then else)) + ; the left operand of the < is an input to the if region + (= expr (Get inputs i)) + ; the right operand of the < has an upper bound + (= (IntB v) (hi-bound value)) + ; context node inside the if region + (= ctx (Arg ty (InIf true pred inputs))) + (HasType inputs ty) + ) + ; expr < value was true, so we know expr is at most (hi-bound value) - 1 + ((set (hi-bound (Get ctx i)) (IntB (- v 1)))) + :ruleset interval-analysis) +(rule ( + ; expr < value + (= pred (Bop (LessThan) expr value)) + (= if_e (If pred inputs then else)) + ; the left operand of the < is an input to the if region + (= expr (Get inputs i)) + ; the right operand of the < has a lower bound + (= (IntB v) (lo-bound value)) + ; context node inside the if region + (= ctx (Arg ty (InIf false pred inputs))) + (HasType inputs ty) + ) + ; expr < value was false, so we know expr is at least (lo-bound value) + ((set (lo-bound (Get ctx i)) (IntB v))) + :ruleset interval-analysis) + +(rule ( + ; value < expr + (= pred (Bop (LessThan) value expr)) + (= if_e (If pred inputs then else)) + ; the right operand of the < is an input to the if region + (= expr (Get inputs i)) + ; the left operand of the < has a lower bound + (= (IntB v) (lo-bound value)) + ; context node inside the if region + (= ctx (Arg ty (InIf true pred inputs))) + (HasType inputs ty) + ) + ; value < expr was true, so we know expr is at least (lo-bound value) + 1 + ((set (lo-bound (Get ctx i)) (IntB (+ v 1)))) + :ruleset interval-analysis) +(rule ( + ; value < expr + (= pred (Bop (LessThan) value expr)) + (= if_e (If pred inputs then else)) + ; the right operand of the < is an input to the if region + (= expr (Get inputs i)) + ; the left operand of the < has an upper bound + (= (IntB v) (hi-bound value)) + ; context node inside the if region + (= ctx (Arg ty (InIf false pred inputs))) + (HasType inputs ty) + ) + ; value < expr was false, so we know expr is at most (hi-bound value) + ((set (hi-bound (Get ctx i)) (IntB v))) + :ruleset interval-analysis) + +;; Push intervals for inputs into if region +(rule ( + (= if (If pred inputs then_ else_)) + (= ctx (Arg ty (InIf b pred inputs))) + (HasType inputs ty) + (= lo (lo-bound (Get inputs i))) + + ) + ((set (lo-bound (Get ctx i)) lo)) + :ruleset interval-analysis) +(rule ( + (= if (If pred inputs then_ else_)) + (= ctx (Arg ty (InIf b pred inputs))) + (HasType inputs ty) + (= hi (hi-bound (Get inputs i))) + + ) + ((set (hi-bound (Get ctx i)) hi)) + :ruleset interval-analysis) + +; (if (a == b) thn els) +; in the thn branch, we know that a has the same bounds as b +(rule ( + (= pred (Bop (Eq) expr val)) + (= if_e (If pred inputs thn els)) + ; the left operand of the == is an input to the if region + (= expr (Get inputs i)) + (= ctx (Arg ty (InIf true pred inputs))) + (HasType inputs ty) + (= (IntB lo) (lo-bound val)) + ) + ((set (lo-bound (Get ctx i)) (IntB lo))) + :ruleset interval-analysis) +(rule ( + (= pred (Bop (Eq) expr val)) + (= if_e (If pred inputs thn els)) + ; the left operand of the == is an input to the if region + (= expr (Get inputs i)) + (= ctx (Arg ty (InIf true pred inputs))) + (HasType inputs ty) + (= (IntB hi) (hi-bound val)) + ) + ((set (hi-bound (Get ctx i)) (IntB hi))) + :ruleset interval-analysis) + + +(rule ( + ;; argument has loop context + (Arg ty (InLoop inputs outputs)) + ;; in the loop, the argument is passed through + ;; note that some_ctx is not the same as (InLoop inputs outputs) + (= (Get (Arg ty some_ctx) ith) (Get outputs (+ 1 ith))) + ;; input has some bound + (= bound (lo-bound (Get inputs ith))) + ) + ( + (set (lo-bound (Get (Arg ty (InLoop inputs outputs)) ith)) bound) + ) + :ruleset interval-analysis) +(rule ( + ;; argument has loop context + (Arg ty (InLoop inputs outputs)) + ;; in the loop, the argument is passed through + (= (Get (Arg ty some_ctx) ith) (Get outputs (+ 1 ith))) + ;; input has some bound + (= bound (hi-bound (Get inputs ith))) + ) + ( + (set (hi-bound (Get (Arg ty (InLoop inputs outputs)) ith)) bound) + ) + :ruleset interval-analysis) + + +(ruleset switch_rewrite) + +; if (a and b) X Y ~~> if a (if b X Y) Y +(rule ((= lhs (If (Bop (And) a b) ins X Y)) + (HasType ins (TupleT ins_ty)) + (= len (tuple-length ins))) + + ((let outer_ins (Concat (Single b) ins)) + (let outer_ins_ty (TupleT (TCons (BoolT) ins_ty))) + + (let inner_pred (Get (Arg outer_ins_ty (InIf true a outer_ins)) 0)) + (let sub_arg_true (SubTuple (Arg outer_ins_ty (InIf true a outer_ins)) 1 len)) + (let sub_arg_false (SubTuple (Arg outer_ins_ty (InIf false a outer_ins)) 1 len)) + + (let inner_X (AddContext (InIf true inner_pred sub_arg_true) X)) + (let inner_Y (AddContext (InIf false inner_pred sub_arg_true) Y)) + (let outer_Y (Subst (InIf false a outer_ins) sub_arg_false Y)) + + (let inner (If inner_pred sub_arg_true inner_X inner_Y)) + (union lhs (If a outer_ins inner outer_Y))) + + :ruleset switch_rewrite) + +; if (a or b) X Y ~~> if a X (if b X Y) +(rule ((= lhs (If (Bop (Or) a b) ins X Y)) + (HasType ins (TupleT ins_ty)) + (= len (tuple-length ins))) + + ((let outer_ins (Concat (Single b) ins)) + (let outer_ins_ty (TupleT (TCons (BoolT) ins_ty))) + + (let inner_pred (Get (Arg outer_ins_ty (InIf false a outer_ins)) 0)) + (let sub_arg_true (SubTuple (Arg outer_ins_ty (InIf true a outer_ins)) 1 len)) + (let sub_arg_false (SubTuple (Arg outer_ins_ty (InIf false a outer_ins)) 1 len)) + + (let outer_X (Subst (InIf true a outer_ins) sub_arg_true X)) + (let inner_X (AddContext (InIf true inner_pred sub_arg_false) X)) + (let inner_Y (AddContext (InIf false inner_pred sub_arg_false) Y)) + + (let inner (If inner_pred sub_arg_false inner_X inner_Y)) + (union lhs (If a outer_ins outer_X inner ))) + + :ruleset switch_rewrite) + +(relation Debug (Assumption Expr Expr)) +(rule ((If (Const (Bool true) ty ctx) ins thn els)) +( + (Debug ctx ins thn) +) + :ruleset always-run) + +(rewrite (If (Const (Bool true) ty ctx) ins thn els) + (Subst ctx ins thn) + :ruleset always-run) + +(rewrite (If (Const (Bool false) ty ctx) ins thn els) + (Subst ctx ins els) + :ruleset switch_rewrite) + +(rule ((= lhs (If pred ins thn els)) + (= (Get thn i) (Const (Bool true) ty ctx1)) + (= (Get els i) (Const (Bool false) ty ctx2))) + ((union (Get lhs i) pred)) :ruleset switch_rewrite) + +(rule ((= lhs (If pred ins thn els)) + (= (Get thn i) (Const (Bool false) ty ctx1)) + (= (Get els i) (Const (Bool true) ty ctx2))) + ((union (Get lhs i) (Uop (Not) pred))) :ruleset switch_rewrite) + +; Simple rewrites that don't do a ton with control flow. + +(ruleset peepholes) + +(rewrite (Bop (Mul) (Const (Int 0) ty ctx) e) (Const (Int 0) ty ctx) :ruleset peepholes) +(rewrite (Bop (Mul) e (Const (Int 0) ty ctx)) (Const (Int 0) ty ctx) :ruleset peepholes) +(rewrite (Bop (Mul) (Const (Int 1) ty ctx) e) e :ruleset peepholes) +(rewrite (Bop (Mul) e (Const (Int 1) ty ctx)) e :ruleset peepholes) +(rewrite (Bop (Add) (Const (Int 0) ty ctx) e) e :ruleset peepholes) +(rewrite (Bop (Add) e (Const (Int 0) ty ctx) ) e :ruleset peepholes) + +(rewrite (Bop (Mul) (Const (Int j) ty ctx) (Const (Int i) ty ctx)) (Const (Int (* i j)) ty ctx) :ruleset peepholes) +(rewrite (Bop (Add) (Const (Int j) ty ctx) (Const (Int i) ty ctx)) (Const (Int (+ i j)) ty ctx) :ruleset peepholes) + +(rewrite (Bop (And) (Const (Bool true) ty ctx) e) e :ruleset peepholes) +(rewrite (Bop (And) e (Const (Bool true) ty ctx)) e :ruleset peepholes) +(rewrite (Bop (And) (Const (Bool false) ty ctx) e) (Const (Bool false) ty ctx) :ruleset peepholes) +(rewrite (Bop (And) e (Const (Bool false) ty ctx)) (Const (Bool false) ty ctx) :ruleset peepholes) +(rewrite (Bop (Or) (Const (Bool false) ty ctx) e) e :ruleset peepholes) +(rewrite (Bop (Or) e (Const (Bool false) ty ctx)) e :ruleset peepholes) +(rewrite (Bop (Or) (Const (Bool true) ty ctx) e) (Const (Bool true) ty ctx) :ruleset peepholes) +(rewrite (Bop (Or) e (Const (Bool true) ty ctx)) (Const (Bool true) ty ctx) :ruleset peepholes) + + +(datatype IntOrInfinity + (Infinity) + (NegInfinity) + (I i64)) + +(function MaxIntOrInfinity (IntOrInfinity IntOrInfinity) IntOrInfinity) +(rewrite (MaxIntOrInfinity (Infinity) _) (Infinity) :ruleset always-run) +(rewrite (MaxIntOrInfinity _ (Infinity)) (Infinity) :ruleset always-run) +(rewrite (MaxIntOrInfinity (NegInfinity) x) x :ruleset always-run) +(rewrite (MaxIntOrInfinity x (NegInfinity)) x :ruleset always-run) +(rewrite (MaxIntOrInfinity (I x) (I y)) (I (max x y)) :ruleset always-run) + +(function MinIntOrInfinity (IntOrInfinity IntOrInfinity) IntOrInfinity) +(rewrite (MinIntOrInfinity (NegInfinity) _) (NegInfinity) :ruleset always-run) +(rewrite (MinIntOrInfinity _ (NegInfinity)) (NegInfinity) :ruleset always-run) +(rewrite (MinIntOrInfinity (Infinity) x) x :ruleset always-run) +(rewrite (MinIntOrInfinity x (Infinity)) x :ruleset always-run) +(rewrite (MinIntOrInfinity (I x) (I y)) (I (min x y)) :ruleset always-run) + +(function AddIntOrInfinity (IntOrInfinity IntOrInfinity) IntOrInfinity) +(rewrite (AddIntOrInfinity (Infinity) (Infinity)) (Infinity) :ruleset always-run) +(rewrite (AddIntOrInfinity (Infinity) (I _)) (Infinity) :ruleset always-run) +(rewrite (AddIntOrInfinity (I _) (Infinity)) (Infinity) :ruleset always-run) +(rewrite (AddIntOrInfinity (NegInfinity) (NegInfinity)) (NegInfinity) :ruleset always-run) +(rewrite (AddIntOrInfinity (NegInfinity) (I _)) (NegInfinity) :ruleset always-run) +(rewrite (AddIntOrInfinity (I _) (NegInfinity)) (NegInfinity) :ruleset always-run) +(rewrite (AddIntOrInfinity (I x) (I y)) (I (+ x y)) :ruleset always-run) + +(datatype IntInterval (MkIntInterval IntOrInfinity IntOrInfinity)) + +(function UnionIntInterval (IntInterval IntInterval) IntInterval) +(rewrite (UnionIntInterval (MkIntInterval lo1 hi1) (MkIntInterval lo2 hi2)) + (MkIntInterval (MinIntOrInfinity lo1 lo2) (MaxIntOrInfinity hi1 hi2)) + :ruleset always-run) + +(function IntersectIntInterval (IntInterval IntInterval) IntInterval) +(rewrite (IntersectIntInterval (MkIntInterval lo1 hi1) (MkIntInterval lo2 hi2)) + (MkIntInterval (MaxIntOrInfinity lo1 lo2) (MinIntOrInfinity hi1 hi2)) + :ruleset always-run) + +(function AddIntInterval (IntInterval IntInterval) IntInterval) +(rewrite (AddIntInterval (MkIntInterval lo1 hi1) (MkIntInterval lo2 hi2)) + (MkIntInterval (AddIntOrInfinity lo1 lo2) + (AddIntOrInfinity hi1 hi2)) + :ruleset always-run) + + +(datatype List + (Nil-List) + (Cons-List i64 IntInterval List)) + +(function Length-List (List) i64) +(rule ((= x (Nil-List))) + ((set (Length-List x) 0)) + :ruleset always-run) +(rule ((= x (Cons-List hd0 hd1 tl)) + (= l (Length-List tl))) + ((set (Length-List x) (+ l 1))) + :ruleset always-run) +(rule ((= x (Nil-List))) + ((set (Length-List x) 0)) + :ruleset memory-helpers) +(rule ((= x (Cons-List hd0 hd1 tl)) + (= l (Length-List tl))) + ((set (Length-List x) (+ l 1))) + :ruleset memory-helpers) + +(relation IsEmpty-List (List)) +(rule ((= x (Nil-List))) + ((IsEmpty-List x)) + :ruleset always-run) + +(relation IsNonEmpty-List (List)) +(rule ((= x (Cons-List hd0 hd1 tl))) + ((IsNonEmpty-List x)) + :ruleset always-run) + +(function RevConcat-List (List List) List :cost 1000) +(rewrite (RevConcat-List (Nil-List) l) + l + :ruleset always-run) +(rewrite (RevConcat-List (Cons-List hd0 hd1 tl) l) + (RevConcat-List tl (Cons-List hd0 hd1 l)) + :ruleset always-run) + +(function Rev-List (List) List :cost 1000) +(rewrite (Rev-List m) + (RevConcat-List m (Nil-List)) + :ruleset always-run) + +(function Concat-List (List List) List :cost 1000) +(rewrite (Concat-List x y) + (RevConcat-List (Rev-List x) y) + :ruleset always-run) + +; SuffixAt and At must be demanded, otherwise these are O(N^2) +(relation DemandAt-List (List)) +(relation SuffixAt-List (List i64 List)) +(relation At-List (List i64 i64 IntInterval)) +(rule ((DemandAt-List x)) + ((SuffixAt-List x 0 x)) + :ruleset always-run) +(rule ((SuffixAt-List x i (Cons-List hd0 hd1 tl))) + ((SuffixAt-List x (+ i 1) tl) + (At-List x i hd0 hd1)) + :ruleset always-run) + +(function Union-List (List List) List) + ; The third argument of the helper is a WIP result map. + ; Invariant: keys of the result map are not present in the first two and are in descending order + (function UnionHelper-List (List List List) List) + (rewrite (Union-List m1 m2) + (Rev-List (UnionHelper-List m1 m2 (Nil-List))) + :ruleset always-run) + + ; both m1 and m2 empty + (rewrite (UnionHelper-List (Nil-List) (Nil-List) res) + res + :ruleset always-run) + ; take from m1 when m2 empty and vice versa + (rewrite + (UnionHelper-List + (Nil-List) + (Cons-List hd0 hd1 tl) + res) + (UnionHelper-List + (Nil-List) + tl + (Cons-List hd0 hd1 res)) + :ruleset always-run) + (rewrite + (UnionHelper-List + (Cons-List hd0 hd1 tl) + (Nil-List) + res) + (UnionHelper-List + tl + (Nil-List) + (Cons-List hd0 hd1 res)) + :ruleset always-run) + + ; when both nonempty and smallest key different, take smaller key + (rule ((= f (UnionHelper-List l1 l2 res)) + (= l1 (Cons-List k1 a1 tl1)) + (= l2 (Cons-List k2 b1 tl2)) + (< k1 k2)) + ((union f + (UnionHelper-List tl1 l2 (Cons-List k1 a1 res)))) + :ruleset always-run) + (rule ((= f (UnionHelper-List l1 l2 res)) + (= l1 (Cons-List k1 a1 tl1)) + (= l2 (Cons-List k2 b1 tl2)) + (< k2 k1)) + ((union f + (UnionHelper-List l1 tl2 (Cons-List k2 b1 res)))) + :ruleset always-run) + + ; when shared smallest key, union interval + (rule ((= f (UnionHelper-List l1 l2 res)) + (= l1 (Cons-List k a1 tl1)) + (= l2 (Cons-List k b1 tl2))) + ((union f + (UnionHelper-List tl1 tl2 + (Cons-List k (UnionIntInterval a1 b1) res)))) + :ruleset always-run) + +(function Intersect-List (List List) List) + ; The third argument of the helper is a WIP result map. + ; Invariant: keys of the result map are not present in the first two and are in descending order + (function IntersectHelper-List (List List List) List) + (rewrite (Intersect-List m1 m2) + (Rev-List (IntersectHelper-List m1 m2 (Nil-List))) + :ruleset always-run) + + ; m1 or m2 empty + (rewrite (IntersectHelper-List (Nil-List) m2 res) + res + :ruleset always-run) + (rewrite (IntersectHelper-List m1 (Nil-List) res) + res + :ruleset always-run) + + ; when both nonempty and smallest key different, drop smaller key + (rule ((= f (IntersectHelper-List l1 l2 res)) + (= l1 (Cons-List k1 a1 tl1)) + (= l2 (Cons-List k2 b1 tl2)) + (< k1 k2)) + ((union f (IntersectHelper-List tl1 l2 res))) + :ruleset always-run) + (rule ((= f (IntersectHelper-List l1 l2 res)) + (= l1 (Cons-List k1 a1 tl1)) + (= l2 (Cons-List k2 b1 tl2)) + (< k2 k1)) + ((union f (IntersectHelper-List tl1 l2 res))) + :ruleset always-run) + +(datatype MyBool (MyTrue) (MyFalse)) + +(function IntIntervalValid (IntInterval) MyBool) +(rewrite (IntIntervalValid (MkIntInterval (I lo) (I hi))) + (MyTrue) + :when ((<= lo hi)) + :ruleset always-run) +(rewrite (IntIntervalValid (MkIntInterval (I lo) (I hi))) + (MyFalse) + :when ((> lo hi)) + :ruleset always-run) +(rewrite (IntIntervalValid (MkIntInterval (NegInfinity) _)) + (MyTrue) + :ruleset always-run) +(rewrite (IntIntervalValid (MkIntInterval _ (Infinity))) + (MyTrue) + :ruleset always-run) + +(function ConsIfNonEmpty (i64 IntInterval List) + List + :cost 100) +(rule ((ConsIfNonEmpty k v tl)) + ((IntIntervalValid v)) + :ruleset always-run) +(rule ((= f (ConsIfNonEmpty k v tl)) + (= (MyTrue) (IntIntervalValid v))) + ((union f (Cons-List k v tl))) + :ruleset always-run) +(rule ((= f (ConsIfNonEmpty k v tl)) + (= (MyFalse) (IntIntervalValid v))) + ((union f tl)) + :ruleset always-run) + + ; when shared smallest key, intersect interval + (rule ((= f (IntersectHelper-List l1 l2 res)) + (= l1 (Cons-List k a1 tl1)) + (= l2 (Cons-List k b1 tl2))) + ((union f + (IntersectHelper-List tl1 tl2 + (ConsIfNonEmpty k (IntersectIntInterval a1 b1) res)))) + :ruleset always-run) + +(function AddIntIntervalToAll (IntInterval List) + List) +(rewrite (AddIntIntervalToAll _ (Nil-List)) + (Nil-List) + :ruleset always-run) +(rewrite (AddIntIntervalToAll x (Cons-List allocid offset tl)) + (Cons-List allocid (AddIntInterval x offset) + (AddIntIntervalToAll x tl)) + :ruleset always-run) + +(datatype PtrPointees + (PointsTo List) + (PointsAnywhere)) + +(function AddIntIntervalToPtrPointees (IntInterval PtrPointees) PtrPointees) +(rewrite (AddIntIntervalToPtrPointees interval (PointsAnywhere)) + (PointsAnywhere) + :ruleset always-run) +(rewrite (AddIntIntervalToPtrPointees interval (PointsTo l)) + (PointsTo (AddIntIntervalToAll interval l)) + :ruleset always-run) + +(function Union-PtrPointees (PtrPointees PtrPointees) PtrPointees) +(rewrite (Union-PtrPointees (PointsAnywhere) _) + (PointsAnywhere) + :ruleset always-run) +(rewrite (Union-PtrPointees _ (PointsAnywhere)) + (PointsAnywhere) + :ruleset always-run) +(rewrite (Union-PtrPointees (PointsTo x) (PointsTo y)) + (PointsTo (Union-List x y)) + :ruleset always-run) +(function Intersect-PtrPointees (PtrPointees PtrPointees) PtrPointees) +(rewrite (Intersect-PtrPointees (PointsAnywhere) x) + x + :ruleset always-run) +(rewrite (Intersect-PtrPointees x (PointsAnywhere)) + x + :ruleset always-run) +(rewrite (Intersect-PtrPointees (PointsTo x) (PointsTo y)) + (PointsTo (Intersect-List x y)) + :ruleset always-run) + +(relation PointsNowhere-PtrPointees (PtrPointees)) +(rule ((= f (PointsTo x)) + (IsEmpty-List x)) + ((PointsNowhere-PtrPointees f)) + :ruleset always-run) + + +(datatype List + (Nil-List) + (Cons-List PtrPointees List)) + +(function Length-List (List) i64) +(rule ((= x (Nil-List))) + ((set (Length-List x) 0)) + :ruleset always-run) +(rule ((= x (Cons-List hd0 tl)) + (= l (Length-List tl))) + ((set (Length-List x) (+ l 1))) + :ruleset always-run) +(rule ((= x (Nil-List))) + ((set (Length-List x) 0)) + :ruleset memory-helpers) +(rule ((= x (Cons-List hd0 tl)) + (= l (Length-List tl))) + ((set (Length-List x) (+ l 1))) + :ruleset memory-helpers) + +(relation IsEmpty-List (List)) +(rule ((= x (Nil-List))) + ((IsEmpty-List x)) + :ruleset always-run) + +(relation IsNonEmpty-List (List)) +(rule ((= x (Cons-List hd0 tl))) + ((IsNonEmpty-List x)) + :ruleset always-run) + +(function RevConcat-List (List List) List :cost 1000) +(rewrite (RevConcat-List (Nil-List) l) + l + :ruleset always-run) +(rewrite (RevConcat-List (Cons-List hd0 tl) l) + (RevConcat-List tl (Cons-List hd0 l)) + :ruleset always-run) + +(function Rev-List (List) List :cost 1000) +(rewrite (Rev-List m) + (RevConcat-List m (Nil-List)) + :ruleset always-run) + +(function Concat-List (List List) List :cost 1000) +(rewrite (Concat-List x y) + (RevConcat-List (Rev-List x) y) + :ruleset always-run) + +; SuffixAt and At must be demanded, otherwise these are O(N^2) +(relation DemandAt-List (List)) +(relation SuffixAt-List (List i64 List)) +(relation At-List (List i64 PtrPointees)) +(rule ((DemandAt-List x)) + ((SuffixAt-List x 0 x)) + :ruleset always-run) +(rule ((SuffixAt-List x i (Cons-List hd0 tl))) + ((SuffixAt-List x (+ i 1) tl) + (At-List x i hd0)) + :ruleset always-run) + +(relation All (List)) +(rule ((= x (Nil-List))) + ((All x)) + :ruleset always-run) +(rule ((= x (Cons-List hd0 tl)) + (PointsNowhere-PtrPointees hd0) + (All tl)) + ((All x)) + :ruleset always-run) + + + +(function Zip (List List) List :cost 1000) +(rewrite (Zip (Nil-List) (Nil-List)) + (Nil-List) + :ruleset always-run) +(rewrite (Zip + (Cons-List x0 tl1) + (Cons-List y0 tl2)) + (Cons-List + (Union-PtrPointees x0 y0) + (Zip tl1 tl2)) + :when ((= (Length-List tl1) (Length-List tl2))) + :ruleset always-run) + +(function Zip (List List) List :cost 1000) +(rewrite (Zip (Nil-List) (Nil-List)) + (Nil-List) + :ruleset always-run) +(rewrite (Zip + (Cons-List x0 tl1) + (Cons-List y0 tl2)) + (Cons-List + (Intersect-PtrPointees x0 y0) + (Zip tl1 tl2)) + :ruleset always-run) + + +(sort ExprSetPrim (Set Expr)) + +(datatype ExprSet (ES ExprSetPrim)) + +(function ExprSet-intersect (ExprSet ExprSet) ExprSet) +(rewrite (ExprSet-intersect (ES set1) (ES set2)) (ES (set-intersect set1 set2)) + :ruleset memory-helpers) +(function ExprSet-union (ExprSet ExprSet) ExprSet) +(rewrite (ExprSet-union (ES set1) (ES set2)) (ES (set-union set1 set2)) + :ruleset memory-helpers) +(relation ExprSet-contains (ExprSet Expr)) +(rule ((ES set1) (set-contains set1 x)) + ((ExprSet-contains (ES set1) x)) + :ruleset memory-helpers) +(function ExprSet-insert (ExprSet Expr) ExprSet) +(rewrite (ExprSet-insert (ES set1) x) + (ES (set-insert set1 x)) + :ruleset memory-helpers) +(function ExprSet-length (ExprSet) i64) +(rewrite (ExprSet-length (ES set1)) (set-length set1) :ruleset memory-helpers) + +; ============================ +; Pointees +; ============================ + + +; List is used as an association list; the i64 keys +; (corresponding to alloc ids) are always unique and sorted, the IntInterval +; values correspond to offset ranges. +; +; (TuplePointsTo [{0->[4,5], 1->[0,0]}, {0->[0,0]}]) +; indicates a tuple with two components. +; - The first component might point to Alloc 0 at offsets 4 or 5, +; or Alloc 1 at offset 0 +; - The second component points to Alloc 0 at offset 0 +(datatype Pointees + (TuplePointsTo List) + (PtrPointsTo PtrPointees)) + +(function UnwrapPtrPointsTo (Pointees) PtrPointees) +(rewrite (UnwrapPtrPointsTo (PtrPointsTo x)) + x + :ruleset memory-helpers) +(function UnwrapTuplePointsTo (Pointees) List) +(rewrite (UnwrapTuplePointsTo (TuplePointsTo x)) + x + :ruleset memory-helpers) + +(relation PointsNowhere (Pointees)) +(rule ((= f (PtrPointsTo x)) + (PointsNowhere-PtrPointees x)) + ((PointsNowhere f)) + :ruleset memory-helpers) +(rule ((= f (TuplePointsTo l)) + (All l)) + ((PointsNowhere f)) + :ruleset memory-helpers) + +(function UnionPointees (Pointees Pointees) Pointees) +(rewrite (UnionPointees (PtrPointsTo x) (PtrPointsTo y)) + (PtrPointsTo (Union-PtrPointees x y)) + :ruleset memory-helpers) +(rewrite (UnionPointees (TuplePointsTo x) (TuplePointsTo y)) + (TuplePointsTo (Zip x y)) + :when ((= (Length-List x) (Length-List y))) + :ruleset memory-helpers) +(function IntersectPointees (Pointees Pointees) Pointees) +(rewrite (IntersectPointees (PtrPointsTo x) (PtrPointsTo y)) + (PtrPointsTo (Intersect-PtrPointees x y)) + :ruleset memory-helpers) +(rewrite (IntersectPointees (TuplePointsTo x) (TuplePointsTo y)) + (TuplePointsTo (Zip x y)) + :ruleset memory-helpers) + +(function GetPointees (Pointees i64) Pointees) +(rule ((= f (GetPointees (TuplePointsTo l) i)) + (At-List l i x)) + ((union f (PtrPointsTo x))) + :ruleset memory-helpers) + +(function PointeesDropFirst (Pointees) Pointees) +(rewrite (PointeesDropFirst (TuplePointsTo (Cons-List hd tl))) + (TuplePointsTo tl) + :ruleset memory-helpers) + +; ============================ +; Resolved +; ============================ + +; Resolved checks if an e-class contains a term containing only constructors and +; primitives; i.e. whether equality is decideable +(relation Resolved-IntOrInfinity (IntOrInfinity)) +(rule ((= f (I _))) + ((Resolved-IntOrInfinity f)) + :ruleset memory-helpers) +(rule ((= f (Infinity))) + ((Resolved-IntOrInfinity f)) + :ruleset memory-helpers) +(rule ((= f (NegInfinity))) + ((Resolved-IntOrInfinity f)) + :ruleset memory-helpers) + +(relation Resolved-IntInterval (IntInterval)) +(rule ((= f (MkIntInterval lo hi)) + (Resolved-IntOrInfinity lo) + (Resolved-IntOrInfinity hi)) + ((Resolved-IntInterval f)) + :ruleset memory-helpers) + +(relation Resolved-List (List)) +(rule ((= f (Nil-List))) + ((Resolved-List f)) + :ruleset memory-helpers) +(rule ((= f (Cons-List allocid offsets tl)) + (Resolved-List tl) + (Resolved-IntInterval offsets)) + ((Resolved-List f)) + :ruleset memory-helpers) + +(relation Resolved-PtrPointees (PtrPointees)) +(rule ((= f (PointsAnywhere))) + ((Resolved-PtrPointees f)) + :ruleset memory-helpers) +(rule ((= f (PointsTo x)) + (Resolved-List x)) + ((Resolved-PtrPointees f)) + :ruleset memory-helpers) + +(relation Resolved-List (List)) +(rule ((= f (Nil-List))) + ((Resolved-List f)) + :ruleset memory-helpers) +(rule ((= f (Cons-List hd tl)) + (Resolved-List tl) + (Resolved-PtrPointees hd)) + ((Resolved-List f)) + :ruleset memory-helpers) + +(relation Resolved-Pointees (Pointees)) +(rule ((= f (TuplePointsTo x)) + (Resolved-List x)) + ((Resolved-Pointees f)) + :ruleset memory-helpers) +(rule ((= f (PtrPointsTo x)) + (Resolved-PtrPointees x)) + ((Resolved-Pointees f)) + :ruleset memory-helpers) + + +;;;;; + +(function BaseTypeToPtrPointees (BaseType) PtrPointees :cost 100) +(rewrite (BaseTypeToPtrPointees (PointerT _)) + (PointsAnywhere) + :ruleset memory-helpers) +(rewrite (BaseTypeToPtrPointees (IntT)) + (PointsTo (Nil-List)) + :ruleset memory-helpers) +(rewrite (BaseTypeToPtrPointees (StateT)) + (PointsTo (Nil-List)) + :ruleset memory-helpers) +(rewrite (BaseTypeToPtrPointees (BoolT)) + (PointsTo (Nil-List)) + :ruleset memory-helpers) + +(function TypeListToList (TypeList) List :cost 1000) +(rewrite (TypeListToList (TNil)) + (Nil-List) + :ruleset memory-helpers) +(rewrite (TypeListToList (TCons hd tl)) + (Cons-List + (BaseTypeToPtrPointees hd) + (TypeListToList tl)) + :ruleset memory-helpers) + +(function TypeToPointees (Type) Pointees :cost 1000) +(rewrite (TypeToPointees (TupleT tylist)) + (TuplePointsTo (TypeListToList tylist)) + :ruleset memory-helpers) +(rewrite (TypeToPointees (Base basety)) + (PtrPointsTo (BaseTypeToPtrPointees basety)) + :ruleset memory-helpers) + +; ============================ +; Update PointerishType +; ============================ + +(relation PointerishType (Type)) +(relation PointerishTypeList (TypeList)) + +(rule ((= f (Base (PointerT ty)))) + ((PointerishType f)) + :ruleset always-run) + +(rule ((= f (TCons (PointerT ty) tl))) + ((PointerishTypeList f)) + :ruleset always-run) + +(rule ((= f (TCons hd tl)) + (PointerishTypeList tl)) + ((PointerishTypeList f)) + :ruleset always-run) + +(rule ((= f (TupleT l)) + (PointerishTypeList l)) + ((PointerishType f)) + :ruleset always-run) + +; ============================ +; Update PointsToCells +; ============================ + +; arg pointees result pointees +(function PointsToCells (Expr Pointees) Pointees :unextractable) + +; Top-level demand +(rule ((Function name in-ty out-ty body)) + ((PointsToCells body (TypeToPointees in-ty))) + :ruleset memory-helpers) + +; Demand PointsToCells along state edge and pointer-typed values +(rule ((PointsToCells (Bop (Print) e state) ap)) + ((PointsToCells state ap)) + :ruleset memory-helpers) +(rule ((PointsToCells (Bop (Load) e state) ap)) + ((PointsToCells e ap) + (PointsToCells state ap)) + :ruleset memory-helpers) +(rule ((PointsToCells (Top (Write) ptr val state) ap)) + ((PointsToCells ptr ap) + (PointsToCells state ap)) + :ruleset memory-helpers) +(rule ((PointsToCells (Alloc id sz state ty) ap)) + ((PointsToCells state ap)) + :ruleset memory-helpers) +(rule ((PointsToCells (Bop (Free) ptr state) ap)) + ((PointsToCells ptr ap) + (PointsToCells state ap)) + :ruleset memory-helpers) +(rule ((PointsToCells (Get x i) ap)) + ((PointsToCells x ap)) + :ruleset memory-helpers) +(rule ((PointsToCells (Concat x y) ap)) + ((PointsToCells x ap) + (PointsToCells y ap)) + :ruleset memory-helpers) +(rule ((PointsToCells (Single x) ap)) + ((PointsToCells x ap)) + :ruleset memory-helpers) + +; Compute and propagate PointsToCells +(rewrite (PointsToCells (Concat x y) aps) + (TuplePointsTo (Concat-List + (UnwrapTuplePointsTo (PointsToCells x aps)) + (UnwrapTuplePointsTo (PointsToCells y aps)))) + :when ((HasType (Concat x y) ty) (PointerishType ty)) + :ruleset memory-helpers) + +(rewrite (PointsToCells (Get x i) aps) + (GetPointees (PointsToCells x aps) i) + :when ((HasType (Get x i) ty) (PointerishType ty)) + :ruleset memory-helpers) + +(rewrite (PointsToCells (Single x) aps) + (TuplePointsTo + (Cons-List + (UnwrapPtrPointsTo (PointsToCells x aps)) + (Nil-List))) + :when ((HasType (Single x) ty) (PointerishType ty)) + :ruleset memory-helpers) + +(rewrite (PointsToCells (Arg ty_ ctx) aps) + aps + :when ((HasType (Arg ty_ ctx) ty) (PointerishType ty)) + :ruleset memory-helpers) + +; Allow non-pointer types to resolve +(rule ((PointsToCells x aps) + (HasType x ty)) + ((TypeToPointees ty)) + :ruleset memory-helpers) +(rule ((= f (PointsToCells x aps)) + (HasType x ty) + (= pointees (TypeToPointees ty)) + (PointsNowhere pointees)) + ((union f pointees)) + :ruleset memory-helpers) + +(rewrite (PointsToCells (Bop (PtrAdd) x e) aps) + (PtrPointsTo + (AddIntIntervalToPtrPointees + (MkIntInterval (I lo) (I hi)) + (UnwrapPtrPointsTo (PointsToCells x aps)))) + :when ((= (IntB lo) (lo-bound e)) + (= (IntB hi) (hi-bound e))) + :ruleset memory-helpers) + +(rewrite (PointsToCells (If c inputs t e) aps) + (UnionPointees + (PointsToCells t (PointsToCells inputs aps)) + (PointsToCells e (PointsToCells inputs aps))) + :when ((HasType (If c inputs t e) ty) (PointerishType ty)) + :ruleset memory) + +(rewrite (PointsToCells (Alloc id sz state ty) aps) + (TuplePointsTo + (Cons-List + (PointsTo + (Cons-List + id + (MkIntInterval (I 0) (I 0)) + (Nil-List))) + (Cons-List + (PointsTo (Nil-List)) ; state output points to nothing + (Nil-List)))) + :ruleset memory-helpers) + +; arg pointees * loop in * loop out * i64 -> result pointees +(function PointsToCellsAtIter (Pointees Expr Expr i64) Pointees) + +; compute first two +(rule ((= e (DoWhile inputs pred-body)) + (PointsToCells e aps)) + ((set (PointsToCellsAtIter aps inputs pred-body 0) + (PointsToCells inputs aps)) + (set (PointsToCellsAtIter aps inputs pred-body 1) + (UnionPointees + (PointsToCellsAtIter aps inputs pred-body 0) + (PointeesDropFirst + (PointsToCells pred-body (PointsToCellsAtIter aps inputs pred-body 0)))))) + :ruleset memory-helpers) + +; avoid quadratic query +(function succ (i64) i64 :unextractable) +(rule ((PointsToCellsAtIter aps inputs pred-body i)) + ((set (succ i) (+ i 1))) + :ruleset memory-helpers) + +; Note that this rule is bounded by ruleset memory +(rule ((= pointees0 (PointsToCellsAtIter aps inputs pred-body i)) + (= pointees1 (PointsToCellsAtIter aps inputs pred-body (succ i))) + (Resolved-Pointees pointees0) + (Resolved-Pointees pointees1) + (!= pointees0 pointees1)) + ((set (PointsToCellsAtIter aps inputs pred-body (+ i 2)) + (UnionPointees + pointees1 + (PointeesDropFirst + (PointsToCells pred-body pointees1))))) + :ruleset memory) + +(rule ((= pointees (PointsToCellsAtIter aps inputs pred-body i)) + (= pointees (PointsToCellsAtIter aps inputs pred-body (succ i)))) + ((set (PointsToCells (DoWhile inputs pred-body) aps) + pointees)) + :ruleset memory) + +(rule ((PtrPointsTo (PointsTo l))) + ((DemandAt-List l)) + :ruleset memory-helpers) +(rule ((TuplePointsTo l)) + ((DemandAt-List l)) + :ruleset memory-helpers) + +; ============================ +; Update DontAlias +; ============================ + +(relation DemandDontAlias (Expr Expr Pointees)) +; pointer, pointer, arg pointees +(relation DontAlias (Expr Expr Pointees)) + + +(rule ((DemandDontAlias ptr1 ptr2 arg-pointees) + (BodyContainsExpr body ptr1) + (BodyContainsExpr body ptr2) + (HasType ptr1 (Base (PointerT ty))) + (HasType ptr2 (Base (PointerT ty))) + (= pointees1 (PointsToCells ptr1 arg-pointees)) + (= pointees2 (PointsToCells ptr2 arg-pointees))) + ((IntersectPointees pointees1 pointees2)) + :ruleset memory-helpers) + +(rule ((PointsNowhere + (IntersectPointees + (PointsToCells ptr1 arg-pointees) + (PointsToCells ptr2 arg-pointees)))) + ((DontAlias ptr1 ptr2 arg-pointees)) + :ruleset memory-helpers) + +; ============================ +; Update PointsToExpr +; ============================ + +; program point, pointer +(function PointsToExpr (Expr Expr) Expr :unextractable) + +; After a load, the ptr points to the loaded value +(rule ((= f (Bop (Load) ptr state))) + ((set (PointsToExpr (Get f 1) ptr) (Get f 0))) + :ruleset memory-helpers) + +; If we load and we already know what the pointer points to +; TODO this rule breaks the weakly linear invariant +; when a previous load may not be on the path +;(rule ((= e (Bop (Load) addr state)) +; (= v (PointsToExpr state addr))) +; ((union (Get e 0) v) +; (union (Get e 1) state)) +; :ruleset memory-helpers) + +; Loads and prints don't affect what what pointers already point to +(rule ((= f (PointsToExpr state addr)) + (= e (Bop (Load) any-addr state))) + ((let new-state (Get e 1)) + (union (PointsToExpr new-state addr) f)) + :ruleset memory-helpers) +(rule ((= f (PointsToExpr state addr)) + (= e (Bop (Print) any-val state))) + ((let new-state e) + (union (PointsToExpr new-state addr) f)) + :ruleset memory-helpers) + +; Writes don't affect what a pointer points to if it writes to another pointer +; guaranteed to not alias. +(rule ((= e (Top (Write) addr data state)) + (HasArgType addr argty) + (= otherdata (PointsToExpr state otheraddr))) + ((DemandDontAlias addr otheraddr (TypeToPointees argty))) + :ruleset memory-helpers) +(rule ((= e (Top (Write) addr data state)) + (HasArgType addr argty) + (= otherdata (PointsToExpr state otheraddr)) + (DontAlias addr otheraddr (TypeToPointees argty))) + ((set (PointsToExpr e otheraddr) otherdata)) + :ruleset memory-helpers) + +; For a write, mark the given expression as containing `data`. +(rule ((= e (Top (Write) addr data state))) + ((union (PointsToExpr e addr) data)) + :ruleset memory-helpers) + +; ============================ +; Update CellHasValues (currently unused) +; ============================ + +; ; program point, cell +; (function CellHasValues (Expr i64) ExprSet :merge (ExprSet-intersect old new)) + +; ; At the time of an alloc, a cell doesn't contain any values +; (rule ((= f (Alloc id amt state ty))) + ; ((set (CellHasValues (Get f 1) id) (ES (set-empty)))) + ; :ruleset memory-helpers) + +; ; These two rules find (Write ptr val state) where +; ; ptr points to cells given no assumptions about where (Arg) points. +; ; TODO: make sensitive to offsets +; (rule ((= e (Top (Write) ptr val state)) + ; (HasArgType ptr argty)) + ; ((TypeToPointees argty)) + ; :ruleset memory-helpers) +; (rule ((= e (Top (Write) ptr val state)) + ; (HasArgType ptr argty) + ; (= (PtrPointsTo (PointsTo cells)) (PointsToCells ptr (TypeToPointees argty))) + ; (At-List cells any-idx alloc-id offsets) + ; (= vals (CellHasValues state cell))) + ; ((set (CellHasValues e cell) (ExprSet-insert vals val))) + ; :ruleset memory-helpers) + +;; Loop Invariant + +;; bool: whether the term in the Expr is an invariant. +(function is-inv-Expr (Expr Expr) bool :unextractable :merge (or old new)) +(function is-inv-ListExpr (Expr ListExpr) bool :unextractable :merge (or old new)) + +;; in default, when there is a find, set is-inv to false +(rule ((BodyContainsExpr loop term) + (= loop (DoWhile inputs pred_out))) + ((set (is-inv-Expr loop term) false)) :ruleset always-run) +(rule ((BodyContainsListExpr loop term) + (= loop (DoWhile inputs pred_out))) + ((set (is-inv-ListExpr loop term) false)) :ruleset always-run) + +(relation is-inv-ListExpr-helper (Expr ListExpr i64)) +(rule ((BodyContainsListExpr loop list) + (= loop (DoWhile inputs pred_out))) + ((is-inv-ListExpr-helper loop list 0)) :ruleset always-run) + +(rule ((is-inv-ListExpr-helper loop list i) + (= true (is-inv-Expr loop expr)) + (= expr (ListExpr-ith list i))) + ((is-inv-ListExpr-helper loop list (+ i 1))) :ruleset always-run) + +(rule ((is-inv-ListExpr-helper loop list i) + (= i (ListExpr-length list))) + ((set (is-inv-ListExpr loop list) true)) :ruleset always-run) + + +(ruleset boundary-analysis) +;; An Expr is on boundary when it is invariant and its parent is not +; loop invariant-expr +(relation boundary-Expr (Expr Expr)) + +;; boundary for ListExpr's children +(rule ((= true (is-inv-Expr loop expr)) + (= false (is-inv-ListExpr loop list)) + (= expr (ListExpr-ith list i))) + ((boundary-Expr loop expr)) :ruleset boundary-analysis) + +;; if a output branch/pred is invariant, it's also boundary-Expr +(rule ((= true (is-inv-Expr loop expr)) + (= loop (DoWhile in pred_out)) + (= expr (Get pred_out i))) + ((boundary-Expr loop expr)) :ruleset boundary-analysis) + + +(function hoisted-loop (Expr Expr) bool :unextractable :merge (or old new) ) +(rule ((= loop (DoWhile in pred_out))) + ((set (hoisted-loop in pred_out) false)) :ruleset always-run) + +(function InExtendedLoop (Expr Expr Expr) Assumption) + +;; mock function +(ruleset loop-inv-motion) + +(rule ((boundary-Expr loop inv) + (> (Expr-size inv) 1) + ;; TODO: replace Expr-size when cost model is ready + (= loop (DoWhile in pred_out)) + ;; the outter assumption of the loop + (ContextOf loop loop_ctx) + (HasType in in_type) + (HasType inv inv_type) + (= inv_type (Base base_inv_ty)) + (= in_type (TupleT tylist)) + (= false (hoisted-loop in pred_out)) + (= len (tuple-length in))) + ((let new_input (Concat in (Single (Subst loop_ctx in inv)))) + (let new_input_type (TupleT (TLConcat tylist (TCons base_inv_ty (TNil))))) + ;; create an virtual assume node, union it with actuall InLoop later + (let assum (InExtendedLoop in pred_out new_input)) + (let new_out_branch (Get (Arg new_input_type assum) len)) + ;; this two subst only change arg to arg with new type + (let substed_pred_out (Subst assum (Arg new_input_type assum) pred_out)) + (let inv_in_new_loop (Subst assum (Arg new_input_type assum) inv)) + (let new_pred_out (Concat substed_pred_out (Single new_out_branch))) + + (let new_loop (DoWhile new_input new_pred_out)) + (union assum (InLoop new_input new_pred_out)) + (union inv_in_new_loop new_out_branch) + (let wrapper (SubTuple new_loop 0 len)) + (union loop wrapper) + (subsume (DoWhile in pred_out)) + ;; don't hoist same loop again + (set (hoisted-loop in pred_out) true) + ) + :ruleset loop-inv-motion) + + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Const _n _ty _ctx))) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Get (Arg ty ctx) i)) + (= loop (DoWhile in pred_out)) + (= expr (Get pred_out (+ i 1)))) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Function _name _tyin _tyout _out)) + + ) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Top _op _x _y _z)) + (= true (is-inv-Expr loop _x)) (= true (is-inv-Expr loop _y)) (= true (is-inv-Expr loop _z)) + ) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Bop _op _x _y)) (BinaryOpIsPure _op) + (= true (is-inv-Expr loop _x)) (= true (is-inv-Expr loop _y)) + ) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Uop _op _x)) (UnaryOpIsPure _op) + (= true (is-inv-Expr loop _x)) + ) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Get _tup _i)) + (= true (is-inv-Expr loop _tup)) + ) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Concat _x _y)) + (= true (is-inv-Expr loop _x)) (= true (is-inv-Expr loop _y)) + ) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Single _x)) + (= true (is-inv-Expr loop _x)) + ) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Switch _pred _inputs _branches)) + (= true (is-inv-Expr loop _pred)) (= true (is-inv-Expr loop _inputs)) (= true (is-inv-ListExpr loop _branches)) + ) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (If _pred _input _then _else)) + (= true (is-inv-Expr loop _pred)) (= true (is-inv-Expr loop _input)) + ) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (DoWhile _in _pred-and-output)) + (= true (is-inv-Expr loop _in)) + (ExprIsPure expr)) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Call _func _arg)) + (= true (is-inv-Expr loop _arg)) + (ExprIsPure expr)) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + +(rule ((BodyContainsExpr loop expr) + (= loop (DoWhile in out)) + (= expr (Empty _ty _ctx)) + + ) + ((set (is-inv-Expr loop expr) true)) :ruleset always-run) + + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Top _op _x _y _z)) + (= expr1 _x)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Top _op _x _y _z)) + (= expr1 _y)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Top _op _x _y _z)) + (= expr1 _z)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Bop _op _x _y)) + (= expr1 _x)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Bop _op _x _y)) + (= expr1 _y)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Uop _op _x)) + (= expr1 _x)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Concat _x _y)) + (= expr1 _x)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Concat _x _y)) + (= expr1 _y)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Single _x)) + (= expr1 _x)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Switch _pred _inputs _branches)) + (= expr1 _pred)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Switch _pred _inputs _branches)) + (= expr1 _inputs)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (If _pred _input _then _else)) + (= expr1 _pred)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (If _pred _input _then _else)) + (= expr1 _input)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (DoWhile _in _pred-and-output)) + (= expr1 _in)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Call _func _arg)) + (= expr1 _arg)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Alloc _id _e _state _ty)) + (= expr1 _e)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) + +(rule ((= true (is-inv-Expr loop expr1)) + (= false (is-inv-Expr loop expr2)) + (= expr2 (Alloc _id _e _state _ty)) + (= expr1 _state)) + ((boundary-Expr loop expr1)) :ruleset boundary-analysis) +;; Some simple simplifications of loops +(ruleset loop-simplify) + +(rewrite + (DoWhile (Arg ty ctx) + (Concat (Single (Const (Bool false) ty ctx2)) + (Single (Const constant ty ctx2)))) + (Single (Const constant ty ctx)) + :ruleset loop-simplify) +;; Some simple simplifications of loops +(ruleset loop-unroll) +(ruleset loop-peel) + +;; inputs, outputs -> number of iterations +;; The minimum possible guess is 1 because of do-while loops +;; TODO: dead loop deletion can turn loops with a false condition to a body +(function LoopNumItersGuess (Expr Expr) i64 :merge (max 1 (min old new))) + +;; by default, guess that all loops run 1000 times +(rule ((DoWhile inputs outputs)) + ((set (LoopNumItersGuess inputs outputs) 1000)) + :ruleset always-run) + +;; Figure out number of iterations for a loop with constant bounds and initial value +;; and i is updated before checking pred +;; TODO: can make this work for increment by any constant +(rule + ((= lhs (DoWhile inputs outputs)) + (= num-inputs (tuple-length inputs)) + (= pred (Get outputs 0)) + ;; iteration counter starts at start_const + (= (Const (Int start_const) _ty1 _ctx1) (Get inputs counter_i)) + ;; updated counter at counter_i + (= next_counter (Get outputs (+ counter_i 1))) + ;; increments by one each loop + (= next_counter (Bop (Add) (Get (Arg _ty _ctx) counter_i) + ;; TODO: put c instead of (Int 1) and mul by c + (Const (Int 1) _ty2 _ctx2))) + ;; while next_counter less than end_constant + (= pred (Bop (LessThan) next_counter + (Const (Int end_constant) _ty3 _ctx3))) + ;; end constant is greater than start constant + (> end_constant start_const) + ) + ( + (set (LoopNumItersGuess inputs outputs) (- end_constant start_const)) + ) + :ruleset always-run) + +;; Figure out number of iterations for a loop with constant bounds and initial value +;; and i is updated after checking pred +(rule + ((= lhs (DoWhile inputs outputs)) + (= num-inputs (tuple-length inputs)) + (= pred (Get outputs 0)) + ;; iteration counter starts at start_const + (= (Const (Int start_const) _ty1 _ctx1) (Get inputs counter_i)) + ;; updated counter at counter_i + (= next_counter (Get outputs (+ counter_i 1))) + ;; increments by one each loop + (= next_counter (Bop (Add) (Get (Arg _ty _ctx) counter_i) + (Const (Int 1) _ty2 _ctx2))) + ;; while this counter less than end_constant + (= pred (Bop (LessThan) (Get (Arg _ty _ctx) counter_i) + (Const (Int end_constant) _ty3 _ctx3))) + ;; end constant is greater than start constant + (> end_constant start_const) + ) + ( + (set (LoopNumItersGuess inputs outputs) (+ (- end_constant start_const) 1)) + ) + :ruleset always-run) + +;; loop peeling rule +;; Only peel loops that we know iterate < 5 times +(rule + ((= lhs (DoWhile inputs outputs)) + (ContextOf lhs ctx) + (HasType inputs inputs-ty) + (= outputs-len (tuple-length outputs)) + (= old_cost (LoopNumItersGuess inputs outputs)) + (< old_cost 5) + ) + ( + (let executed-once + (Subst ctx inputs outputs)) + (let executed-once-body + (SubTuple executed-once 1 (- outputs-len 1))) + (let then-ctx + (InIf true (Get executed-once 0) executed-once-body)) + (let else-ctx + (InIf false (Get executed-once 0) executed-once-body)) + (union lhs + ;; check if we need to continue executing the loop + (If (Get executed-once 0) + executed-once-body ;; inputs are the body executed once + (DoWhile (Arg inputs-ty then-ctx) + outputs) ;; right now, loop unrolling shares the same outputs, but we could add more context here + (Arg inputs-ty else-ctx))) + (set (LoopNumItersGuess (Arg inputs-ty then-ctx) outputs) (- old_cost 1)) + ) + :ruleset loop-peel) + +;; unroll a loop with constant bounds and initial value +(rule + ((= lhs (DoWhile inputs outputs)) + (= num-inputs (tuple-length inputs)) + (= pred (Get outputs 0)) + ;; iteration counter starts at start_const + (= (Const (Int start_const) _ty1 _ctx1) (Get inputs counter_i)) + ;; updated counter at counter_i + (= next_counter (Get outputs (+ counter_i 1))) + ;; increments by one each loop + (= next_counter (Bop (Add) (Get (Arg _ty _ctx) counter_i) + (Const (Int 1) _ty2 _ctx2))) + ;; while less than end_constant + (= pred (Bop (LessThan) next_counter + (Const (Int end_constant) _ty3 _ctx3))) + ;; start and end constant is a multiple of 4 and greater than start_const + (> end_constant start_const) + (= (% start_const 4) 0) + (= (% end_constant 4) 0) + (= old_cost (LoopNumItersGuess inputs outputs)) + ) + ( + (let one-iter (SubTuple outputs 1 num-inputs)) + (let unrolled + (Subst (TmpCtx) one-iter + (Subst (TmpCtx) one-iter + (Subst (TmpCtx) one-iter + outputs)))) + (union lhs + (DoWhile inputs + unrolled)) + (let actual-ctx (InLoop inputs unrolled)) + (union (TmpCtx) actual-ctx) + + (set (LoopNumItersGuess inputs unrolled) (/ old_cost 4)) + (delete (TmpCtx)) + ) + :ruleset loop-unroll) + + + +(ruleset passthrough) + + +;; Pass through thetas +(rule ((= lhs (Get loop i)) + (= loop (DoWhile inputs pred-outputs)) + (= (Get pred-outputs (+ i 1)) (Get (Arg _ty _ctx) i)) + ;; only pass through pure types, since some loops don't terminate + ;; so the state edge must pass through them + (HasType (Get loop i) lhs_ty) + (PureType lhs_ty) + ) + ((union lhs (Get inputs i))) + :ruleset passthrough) + +;; Pass through switch arguments +(rule ((= lhs (Get switch i)) + (= switch (Switch pred inputs branches)) + (= (ListExpr-length branches) 2) + (= branch0 (ListExpr-ith branches 0)) + (= branch1 (ListExpr-ith branches 1)) + (= (Get branch0 i) (Get (Arg _ _ctx0) j)) + (= (Get branch1 i) (Get (Arg _ _ctx1) j)) + (= passed-through (Get inputs j)) + (HasType lhs lhs_ty) + (!= lhs_ty (Base (StateT)))) + ((union lhs passed-through)) + :ruleset passthrough) + +;; Pass through switch predicate +(rule ((= lhs (Get switch i)) + (= switch (Switch pred inputs branches)) + (= (ListExpr-length branches) 2) + (= branch0 (ListExpr-ith branches 0)) + (= branch1 (ListExpr-ith branches 1)) + (= (Get branch0 i) (Const (Bool false) _ _ctx0)) + (= (Get branch1 i) (Const (Bool true) _ _ctx1))) + ((union lhs pred)) + :ruleset passthrough) + +;; Pass through if arguments +(rule ((= if (If pred inputs then_ else_)) + (= (Get then_ i) (Get (Arg arg_ty _then_ctx) j)) + (= (Get else_ i) (Get (Arg arg_ty _else_ctx) j)) + (HasType (Get then_ i) lhs_ty) + (!= lhs_ty (Base (StateT)))) + ((union (Get if i) (Get inputs j))) + :ruleset passthrough) + +; Pass through if state edge arguments +; To maintain the invariant, we have to union the other outputs with a pure if statement +;; TODO This rule causes blowup in the egraph, unclear why +;; disabled for now +(ruleset pass-through-state-edge-if) +(rule ((= outputs (If pred inputs then_ else_)) + + (= (Get then_ i) (Get (Arg arg_ty then_ctx) j)) + (= (Get else_ i) (Get (Arg arg_ty else_ctx) j)) + + (HasType (Get then_ i) (Base (StateT)))) + + ((let lhs (Get outputs i)) + (let new_inputs (TupleRemoveAt inputs j)) + + (let new_then_ctx (InIf true pred new_inputs)) + (let new_else_ctx (InIf false pred new_inputs)) + + (let old_then (TupleRemoveAt then_ i)) + (let old_else (TupleRemoveAt else_ i)) + + (let new_then (DropAt new_then_ctx j old_then)) + (let new_else (DropAt new_else_ctx j old_else)) + + (let old_outputs (TupleRemoveAt outputs i)) + (let new_if (If pred new_inputs new_then new_else)) + (union new_if old_outputs) + + (union lhs (Get inputs j)) + ;; Be careful not to subsume the original if statement immediately, + ;; since TupleRemoveAt still needs to match on it + (ToSubsumeIf pred inputs then_ else_)) + :ruleset pass-through-state-edge-if) + + +;; Pass through if predicate +(rule ((= if (If pred inputs then_ else_)) + (= (Get then_ i) (Const (Bool true) _ _thenctx)) + (= (Get else_ i) (Const (Bool false) _ _elsectx))) + + ((let new_then (TupleRemoveAt then_ i)) + (let new_else (TupleRemoveAt else_ i)) + (let new_if (If pred inputs new_then new_else)) + + (union (Get if i) pred) + (union (TupleRemoveAt if i) new_if) + (ToSubsumeIf pred inputs then_ else_)) + :ruleset passthrough) + +;; ORIGINAL +;; a = 0 +;; c = 3 +;; for i = 0 to n: +;; a = i * c +;; +;; OPTIMIZED +;; a = 0 +;; c = 3 +;; d = 0 +;; for i = 0 to n: +;; a += d +;; d += c +(ruleset loop-strength-reduction) + +; Finds invariants/constants within a body. +; Columns: body; value of invariant in inputs; value of invariant in outputs +;; Get the input and output value of an invariant, or constant int, within the loop +;; loop in out +(relation lsr-inv (Expr Expr Expr)) + +; TODO: there may be a bug with finding the invariant, or it just may not be extracted. +; Can make this work on loop_with_mul_by_inv and a rust test later. +; (rule ( +; (= loop (DoWhile inputs pred-and-body)) +; (= (Get outputs (+ i 1)) (Get (Arg arg-type assm) i))) +; ((inv loop (Get inputs i) (Get (Arg arg-type assm) i))) :ruleset always-run) +(rule ( + (= loop (DoWhile inputs pred-and-body)) + (ContextOf inputs loop-input-ctx) + (ContextOf pred-and-body loop-output-ctx) + (= constant (Const c out-type loop-output-ctx)) + (HasArgType inputs in-type) + ) + ((lsr-inv loop (Const c in-type loop-input-ctx) constant)) :ruleset always-run) + +(rule + ( + ;; Find loop + (= old-loop (DoWhile inputs pred-and-outputs)) + (ContextOf pred-and-outputs loop-ctx) + + ; Find loop variable (argument that gets incremented with an invariant) + (lsr-inv old-loop loop-incr-in loop-incr-out) + ; Since the first el of pred-and-outputs is the pred, we need to offset i + (= (Get pred-and-outputs (+ i 1)) (Bop (Add) (Get (Arg arg-type assm) i) loop-incr-out)) + + ; Find invariant where input is same as output, or constant + (lsr-inv old-loop c-in c-out) + + ; Find multiplication of loop variable and invariant + (= old-mul (Bop (Mul) c-out (Get (Arg arg-type assm) i))) + (ContextOf old-mul loop-ctx) + + (= arg-type (TupleT ty-list)) + ) + ( + ; Each time we need to update d by the product of the multiplied constant and the loop increment + (let addend (Bop (Mul) c-out loop-incr-out)) + + ; n is index of our new, temporary variable d + (let n (tuple-length inputs)) + + ; Initial value of d is i * c + (let d-init (Bop (Mul) c-in (Get inputs i))) + + ; Construct optimized theta + ; new-inputs already has the correct context + (let new-inputs (Concat inputs (Single d-init))) + + ; We need to create a new type, with one more input + (let new-arg-ty (TupleT (TLConcat ty-list (TCons (IntT) (TNil))))) + + ; Value of d in loop. Add context to addend + (let d-out (Bop (Add) (Get (Arg new-arg-ty (TmpCtx)) n) + (Subst (TmpCtx) (Arg new-arg-ty (TmpCtx)) addend))) + + ; build the old body, making sure to set the correct arg type and context + (let new-body + (Concat + (Subst (TmpCtx) (Arg new-arg-ty (TmpCtx)) pred-and-outputs) + (Single d-out))) + + (let new-loop (DoWhile new-inputs new-body)) + + ; Now that we have the new loop, union the temporary context with the actual ctx + (union (TmpCtx) (InLoop new-inputs new-body)) + + ; Substitute d for the *i expression + (let new-mul + (Bop + (Mul) + (Subst (TmpCtx) (Arg new-arg-ty (TmpCtx)) c-out) + (Get (Arg new-arg-ty (TmpCtx)) i))) + (union (Get (Arg new-arg-ty (TmpCtx)) n) new-mul) + + ; Subsume the multiplication in the new loop to prevent + ; from firing loop strength reduction again on the new loop + (subsume + (Bop + (Mul) + (Subst (TmpCtx) (Arg new-arg-ty (TmpCtx)) c-out) + (Get (Arg new-arg-ty (TmpCtx)) i))) + + ; Project all but last + (union old-loop (SubTuple new-loop 0 n)) + (delete (TmpCtx)) + ) + :ruleset loop-strength-reduction +) +(let __tmp0 (StateT )) +(let __tmp1 (TNil )) +(let __tmp2 (TCons __tmp0 __tmp1)) +(let __tmp3 (TupleT __tmp2)) +(let __tmp4 (Print )) +(let __tmp5 (InFunc "main")) +(let __tmp6 (Arg __tmp3 __tmp5)) +(let __tmp7 (Get __tmp6 0)) +(let __tmp8 (Single __tmp7)) +(let __tmp9 (Int 0)) +(let __tmp10 (Const __tmp9 __tmp3 __tmp5)) +(let __tmp11 (Single __tmp10)) +(let __tmp12 (Int 1)) +(let __tmp13 (Const __tmp12 __tmp3 __tmp5)) +(let __tmp14 (Single __tmp13)) +(let __tmp15 (Concat __tmp11 __tmp14)) +(let __tmp16 (Concat __tmp8 __tmp15)) +(let __tmp17 (LessThan )) +(let __tmp18 (IntT )) +(let __tmp19 (TCons __tmp18 __tmp1)) +(let __tmp20 (TCons __tmp18 __tmp19)) +(let __tmp21 (TCons __tmp0 __tmp20)) +(let __tmp22 (TupleT __tmp21)) +(let __tmp23 (InFunc "dummy")) +(let __tmp24 (Arg __tmp22 __tmp23)) +(let __tmp25 (Get __tmp24 1)) +(let __tmp26 (Get __tmp24 2)) +(let __tmp27 (Bop __tmp17 __tmp25 __tmp26)) +(let __tmp28 (Single __tmp27)) +(let __tmp29 (Get __tmp24 0)) +(let __tmp30 (Single __tmp29)) +(let __tmp31 (Add )) +(let __tmp32 (Bop __tmp31 __tmp26 __tmp25)) +(let __tmp33 (Single __tmp32)) +(let __tmp34 (Single __tmp26)) +(let __tmp35 (Concat __tmp33 __tmp34)) +(let __tmp36 (Concat __tmp30 __tmp35)) +(let __tmp37 (Concat __tmp28 __tmp36)) +(let __tmp38 (InLoop __tmp16 __tmp37)) +(let __tmp39 (Arg __tmp22 __tmp38)) +(let __tmp40 (Get __tmp39 1)) +(let __tmp41 (Get __tmp39 2)) +(let __tmp42 (Bop __tmp17 __tmp40 __tmp41)) +(let __tmp43 (Single __tmp42)) +(let __tmp44 (Get __tmp39 0)) +(let __tmp45 (Single __tmp44)) +(let __tmp46 (Bop __tmp31 __tmp41 __tmp40)) +(let __tmp47 (Single __tmp46)) +(let __tmp48 (Single __tmp41)) +(let __tmp49 (Concat __tmp47 __tmp48)) +(let __tmp50 (Concat __tmp45 __tmp49)) +(let __tmp51 (Concat __tmp43 __tmp50)) +(let __tmp52 (DoWhile __tmp16 __tmp51)) +(let __tmp53 (Get __tmp52 1)) +(let __tmp54 (Get __tmp52 0)) +(let __tmp55 (Bop __tmp4 __tmp53 __tmp54)) +(let __tmp56 (Single __tmp55)) +(let __tmp57 (Function "main" __tmp3 __tmp3 __tmp56)) +(let __tmp58 (Nil )) +(let __tmp59 (Program __tmp57 __tmp58)) + +(let PROG __tmp59) +(relation InlinedCall (String Expr)) + +; (let expected (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 2) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))) + +; (let substituted ( Subst (InFunc "main") (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))))) 0)) (Concat (Single (Const (Int 2) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))))))))) +; (let iftrue +; (If (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))))) 0)) (Concat (Single (Const (Int 2) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))))))) (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf false (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))))))) +; (Debug (If (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))))) 0)) (Concat (Single (Const (Int 2) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))))))) (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf false (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))))))) + (unstable-combined-ruleset saturating + always-run + passthrough + canon + type-analysis + context + interval-analysis + memory-helpers + ) + + + (unstable-combined-ruleset optimizations + loop-simplify + memory + loop-unroll + peepholes + loop-peel + ) + + (unstable-combined-ruleset expensive-optimizations + optimizations + switch_rewrite + ;loop-inv-motion + loop-strength-reduction + ) + + (run-schedule + +;; saturate all helpers first +(saturate + (saturate + (saturate type-helpers) ;; resolve type helpers, finding correct types + (saturate error-checking) ;; check for errors, relies on type-helpers saturating + saturating) + + (saturate drop) + apply-drop-unions + cleanup-drop + + subsume-after-helpers + + (saturate subst) ;; do e-substitution + apply-subst-unions ;; apply the unions from substitution + cleanup-subst ;; clean up substitutions that are done + + + (saturate boundary-analysis) ;; find boundaries of invariants +) + + + (repeat 2 + +;; saturate all helpers first +(saturate + (saturate + (saturate type-helpers) ;; resolve type helpers, finding correct types + (saturate error-checking) ;; check for errors, relies on type-helpers saturating + saturating) + + (saturate drop) + apply-drop-unions + cleanup-drop + + subsume-after-helpers + + (saturate subst) ;; do e-substitution + apply-subst-unions ;; apply the unions from substitution + cleanup-subst ;; clean up substitutions that are done + + + (saturate boundary-analysis) ;; find boundaries of invariants +) + + + expensive-optimizations) + (repeat 4 + +;; saturate all helpers first +(saturate + (saturate + (saturate type-helpers) ;; resolve type helpers, finding correct types + (saturate error-checking) ;; check for errors, relies on type-helpers saturating + saturating) + + (saturate drop) + apply-drop-unions + cleanup-drop + + subsume-after-helpers + + (saturate subst) ;; do e-substitution + apply-subst-unions ;; apply the unions from substitution + cleanup-subst ;; clean up substitutions that are done + + + (saturate boundary-analysis) ;; find boundaries of invariants +) + + + optimizations) + +;; saturate all helpers first +(saturate + (saturate + (saturate type-helpers) ;; resolve type helpers, finding correct types + (saturate error-checking) ;; check for errors, relies on type-helpers saturating + saturating) + + (saturate drop) + apply-drop-unions + cleanup-drop + + subsume-after-helpers + + (saturate subst) ;; do e-substitution + apply-subst-unions ;; apply the unions from substitution + cleanup-subst ;; clean up substitutions that are done + + + (saturate boundary-analysis) ;; find boundaries of invariants +) +(saturate + (saturate + (saturate type-helpers) ;; resolve type helpers, finding correct types + (saturate error-checking) ;; check for errors, relies on type-helpers saturating + saturating) + + (saturate drop) + apply-drop-unions + cleanup-drop + + subsume-after-helpers + + (saturate subst) ;; do e-substitution + apply-subst-unions ;; apply the unions from substitution + cleanup-subst ;; clean up substitutions that are done + + + (saturate boundary-analysis) ;; find boundaries of invariants +) + + +) + + +; (print-function Subst 100) +; (let substituted ( Subst (InFunc "main") (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))))) 0)) (Concat (Single (Const (Int 2) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))))))))) +; (let thn (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))))) 0)) (Concat (Single (Const (Int 2) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))))))))) +; (let els (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf false (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))))) +; (query-extract :variants 5 thn) +; (query-extract :variants 5 els) +; (query-extract :variants 5 substituted) +(query-extract :variants 5 __tmp52) +; (check (= __tmp52 expected)) + +; (print-function Debug 10) +; (DoWhile (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))))))) 1) (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))))))))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))))))) 0)) (Concat (Single (Bop (Add) (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))))))) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))))))) 1))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2)))))))))))) +; (DoWhile (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))))))) 1) (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))))))))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))))))) 0)) (Concat (Single (Bop (Add) (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))))))) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))))))) 1))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2)))))))))))) + +; (If ) \ No newline at end of file diff --git a/tests/passing/small/peel_twice.bril b/tests/passing/small/peel_twice.bril new file mode 100644 index 000000000..c471ea218 --- /dev/null +++ b/tests/passing/small/peel_twice.bril @@ -0,0 +1,13 @@ +@main { + i: int = const 0; + one: int = const 1; + two: int = const 2; + +.loop: + i: int = add one i; + cond: bool = lt i two; + br cond .loop .loop_end; + +.loop_end: + print i; +} diff --git a/tests/passing/small/peel_twice_precalc_pred.bril b/tests/passing/small/peel_twice_precalc_pred.bril new file mode 100644 index 000000000..c42ae87bd --- /dev/null +++ b/tests/passing/small/peel_twice_precalc_pred.bril @@ -0,0 +1,12 @@ +@main { + i: int = const 0; + one: int = const 1; + +.loop: + cond: bool = lt i one; + i: int = add one i; + br cond .loop .loop_end; + +.loop_end: + print i; +} \ No newline at end of file From 94a3b4cb6661f42000cec188ad4fb3cc471d2461 Mon Sep 17 00:00:00 2001 From: Kirsten <32720576+kirstenmg@users.noreply.github.com> Date: Wed, 22 May 2024 15:17:48 -0700 Subject: [PATCH 2/7] Setting iters to 1 working; peeling iter 1 not working --- .../src/optimizations/loop_unroll.egg | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/dag_in_context/src/optimizations/loop_unroll.egg b/dag_in_context/src/optimizations/loop_unroll.egg index e04c642b9..1f630f0e9 100644 --- a/dag_in_context/src/optimizations/loop_unroll.egg +++ b/dag_in_context/src/optimizations/loop_unroll.egg @@ -12,6 +12,21 @@ ((set (LoopNumItersGuess inputs outputs) 1000)) :ruleset always-run) +;; For a loop that is false, its num iters is 1 +(rule + ((= loop (DoWhile inputs outputs)) + (= (Const (Bool false) ty ctx) (Get outputs 0))) + ((set (LoopNumItersGuess inputs outputs) 1)) +:ruleset always-run) + +;; For a loop that has only one iteration, union it with its body +(rule + ((= loop (DoWhile inputs outputs)) + (= 1 (LoopNumItersGuess inputs outputs)) + (ContextOf inputs ctx)) + ((union loop (Subst ctx inputs outputs))) +:ruleset always-run) + ;; Figure out number of iterations for a loop with constant bounds and initial value ;; and i is updated before checking pred ;; TODO: can make this work for increment by any constant @@ -70,7 +85,7 @@ (HasType inputs inputs-ty) (= outputs-len (tuple-length outputs)) (= old_cost (LoopNumItersGuess inputs outputs)) - ; (< old_cost 5) + (< old_cost 5) ) ( (let executed-once From f31384c4f85281da7ee094dda48168b67edd2ab1 Mon Sep 17 00:00:00 2001 From: Kirsten <32720576+kirstenmg@users.noreply.github.com> Date: Thu, 23 May 2024 11:56:07 -0700 Subject: [PATCH 3/7] Generalize loop peeling for any constant increment loop --- .../src/optimizations/loop_unroll.egg | 33 ++++----- dag_in_context/src/schedule.rs | 2 +- tests/passing/small/jumping_loop.bril | 12 ++++ .../files__gamma_condition_and-optimize.snap | 2 +- .../files__implicit-return-optimize.snap | 71 ++++++++----------- .../files__jumping_loop-optimize.snap | 7 ++ .../snapshots/files__peel_twice-optimize.snap | 9 +++ ...les__peel_twice_precalc_pred-optimize.snap | 9 +++ .../files__range_check-optimize.snap | 62 +++++++--------- .../files__range_splitting-optimize.snap | 60 +++++++--------- .../files__simplest_loop-optimize.snap | 23 +++--- tests/snapshots/files__sqrt-optimize.snap | 4 +- .../files__unroll_multiple_4-optimize.snap | 10 +-- 13 files changed, 153 insertions(+), 151 deletions(-) create mode 100644 tests/passing/small/jumping_loop.bril create mode 100644 tests/snapshots/files__jumping_loop-optimize.snap create mode 100644 tests/snapshots/files__peel_twice-optimize.snap create mode 100644 tests/snapshots/files__peel_twice_precalc_pred-optimize.snap diff --git a/dag_in_context/src/optimizations/loop_unroll.egg b/dag_in_context/src/optimizations/loop_unroll.egg index 1f630f0e9..e02b53ef5 100644 --- a/dag_in_context/src/optimizations/loop_unroll.egg +++ b/dag_in_context/src/optimizations/loop_unroll.egg @@ -19,17 +19,9 @@ ((set (LoopNumItersGuess inputs outputs) 1)) :ruleset always-run) -;; For a loop that has only one iteration, union it with its body -(rule - ((= loop (DoWhile inputs outputs)) - (= 1 (LoopNumItersGuess inputs outputs)) - (ContextOf inputs ctx)) - ((union loop (Subst ctx inputs outputs))) -:ruleset always-run) - ;; Figure out number of iterations for a loop with constant bounds and initial value ;; and i is updated before checking pred -;; TODO: can make this work for increment by any constant +;; TODO: we could make it work for decrementing loops (rule ((= lhs (DoWhile inputs outputs)) (= num-inputs (tuple-length inputs)) @@ -38,18 +30,18 @@ (= (Const (Int start_const) _ty1 _ctx1) (Get inputs counter_i)) ;; updated counter at counter_i (= next_counter (Get outputs (+ counter_i 1))) - ;; increments by one each loop + ;; increments by some constant each loop (= next_counter (Bop (Add) (Get (Arg _ty _ctx) counter_i) - ;; TODO: put c instead of (Int 1) and mul by c - (Const (Int 1) _ty2 _ctx2))) + (Const (Int increment) _ty2 _ctx2))) + (> increment 0) ;; while next_counter less than end_constant (= pred (Bop (LessThan) next_counter (Const (Int end_constant) _ty3 _ctx3))) - ;; end constant is greater than start constant - (> end_constant start_const) + ;; end constant is at least start constant + (>= end_constant start_const) ) ( - (set (LoopNumItersGuess inputs outputs) (- end_constant start_const)) + (set (LoopNumItersGuess inputs outputs) (/ (- end_constant start_const) increment)) ) :ruleset always-run) @@ -63,17 +55,18 @@ (= (Const (Int start_const) _ty1 _ctx1) (Get inputs counter_i)) ;; updated counter at counter_i (= next_counter (Get outputs (+ counter_i 1))) - ;; increments by one each loop + ;; increments by a constant each loop (= next_counter (Bop (Add) (Get (Arg _ty _ctx) counter_i) - (Const (Int 1) _ty2 _ctx2))) + (Const (Int increment) _ty2 _ctx2))) + (> increment 0) ;; while this counter less than end_constant (= pred (Bop (LessThan) (Get (Arg _ty _ctx) counter_i) (Const (Int end_constant) _ty3 _ctx3))) - ;; end constant is greater than start constant - (> end_constant start_const) + ;; end constant is at least start constant + (>= end_constant start_const) ) ( - (set (LoopNumItersGuess inputs outputs) (+ (- end_constant start_const) 1)) + (set (LoopNumItersGuess inputs outputs) (+ (/ (- end_constant start_const) increment) 1)) ) :ruleset always-run) diff --git a/dag_in_context/src/schedule.rs b/dag_in_context/src/schedule.rs index 07f676d92..40ec492b5 100644 --- a/dag_in_context/src/schedule.rs +++ b/dag_in_context/src/schedule.rs @@ -45,6 +45,7 @@ pub fn mk_schedule() -> String { memory loop-unroll peepholes + loop-peel ) (unstable-combined-ruleset expensive-optimizations @@ -52,7 +53,6 @@ pub fn mk_schedule() -> String { switch_rewrite ;loop-inv-motion loop-strength-reduction - loop-peel ) (run-schedule diff --git a/tests/passing/small/jumping_loop.bril b/tests/passing/small/jumping_loop.bril new file mode 100644 index 000000000..f85253eb4 --- /dev/null +++ b/tests/passing/small/jumping_loop.bril @@ -0,0 +1,12 @@ +@main { + jump: int = const 4; + i: int = const 0; + n: int = const 18; + +.loop: + i: int = add jump i; + pred: bool = lt i n; + br pred .loop .end; + +.end: +} \ No newline at end of file diff --git a/tests/snapshots/files__gamma_condition_and-optimize.snap b/tests/snapshots/files__gamma_condition_and-optimize.snap index d2fb01cff..5b6fe2370 100644 --- a/tests/snapshots/files__gamma_condition_and-optimize.snap +++ b/tests/snapshots/files__gamma_condition_and-optimize.snap @@ -5,7 +5,7 @@ expression: visualization.result @main(v0: int) { .v1_: v2_: int = const 0; - v3_: bool = lt v2_ v0; + v3_: bool = gt v0 v2_; v4_: bool = lt v0 v2_; v5_: int = const 1; v6_: int = const 3; diff --git a/tests/snapshots/files__implicit-return-optimize.snap b/tests/snapshots/files__implicit-return-optimize.snap index 05f54ca89..53ad6fedf 100644 --- a/tests/snapshots/files__implicit-return-optimize.snap +++ b/tests/snapshots/files__implicit-return-optimize.snap @@ -37,48 +37,35 @@ expression: visualization.result } @main { .v0_: - v1_: bool = const true; - v2_: int = const 16; - v3_: int = const 1; - v4_: int = const 4; - v5_: int = const 15; - v6_: int = id v2_; + v1_: int = const 4; + v2_: int = const 0; + v3_: int = const 15; + v4_: int = id v1_; + v5_: int = id v2_; + v6_: int = id v1_; v7_: int = id v3_; - v8_: int = id v4_; - v9_: int = id v5_; - br v1_ .v10_ .v11_; -.v10_: - v12_: int = id v2_; - v13_: int = id v3_; - v14_: int = id v4_; - v15_: int = id v5_; -.v16_: - v17_: int = const 14; - v18_: bool = lt v13_ v17_; - v19_: int = id v12_; - v20_: int = id v13_; - v21_: int = id v14_; - v22_: int = id v15_; - br v18_ .v23_ .v24_; -.v23_: - v25_: int = mul v12_ v14_; - v26_: int = const 1; - v27_: int = add v13_ v26_; - v19_: int = id v25_; - v20_: int = id v27_; - v21_: int = id v14_; - v22_: int = id v15_; -.v24_: +.v8_: + v9_: int = const 14; + v10_: bool = lt v5_ v9_; + v11_: int = id v4_; + v12_: int = id v5_; + v13_: int = id v6_; + v14_: int = id v7_; + br v10_ .v15_ .v16_; +.v15_: + v17_: int = mul v4_ v6_; + v18_: int = const 1; + v19_: int = add v18_ v5_; + v11_: int = id v17_; v12_: int = id v19_; - v13_: int = id v20_; - v14_: int = id v21_; - v15_: int = id v22_; - br v18_ .v16_ .v28_; -.v28_: - v6_: int = id v12_; - v7_: int = id v13_; - v8_: int = id v14_; - v9_: int = id v15_; -.v11_: - print v6_; + v13_: int = id v6_; + v14_: int = id v7_; +.v16_: + v4_: int = id v11_; + v5_: int = id v12_; + v6_: int = id v13_; + v7_: int = id v14_; + br v10_ .v8_ .v20_; +.v20_: + print v4_; } diff --git a/tests/snapshots/files__jumping_loop-optimize.snap b/tests/snapshots/files__jumping_loop-optimize.snap new file mode 100644 index 000000000..a1c1c23ac --- /dev/null +++ b/tests/snapshots/files__jumping_loop-optimize.snap @@ -0,0 +1,7 @@ +--- +source: tests/files.rs +expression: visualization.result +--- +@main { +.v0_: +} diff --git a/tests/snapshots/files__peel_twice-optimize.snap b/tests/snapshots/files__peel_twice-optimize.snap new file mode 100644 index 000000000..f2691ba96 --- /dev/null +++ b/tests/snapshots/files__peel_twice-optimize.snap @@ -0,0 +1,9 @@ +--- +source: tests/files.rs +expression: visualization.result +--- +@main { +.v0_: + v1_: int = const 2; + print v1_; +} diff --git a/tests/snapshots/files__peel_twice_precalc_pred-optimize.snap b/tests/snapshots/files__peel_twice_precalc_pred-optimize.snap new file mode 100644 index 000000000..f2691ba96 --- /dev/null +++ b/tests/snapshots/files__peel_twice_precalc_pred-optimize.snap @@ -0,0 +1,9 @@ +--- +source: tests/files.rs +expression: visualization.result +--- +@main { +.v0_: + v1_: int = const 2; + print v1_; +} diff --git a/tests/snapshots/files__range_check-optimize.snap b/tests/snapshots/files__range_check-optimize.snap index ec7cd1e03..59f868ab0 100644 --- a/tests/snapshots/files__range_check-optimize.snap +++ b/tests/snapshots/files__range_check-optimize.snap @@ -4,41 +4,33 @@ expression: visualization.result --- @main { .v0_: - v1_: bool = const true; - v2_: int = const 1; - print v2_; - v3_: int = id v2_; - br v1_ .v4_ .v5_; -.v4_: - v6_: int = id v2_; -.v7_: - v8_: int = const 6; - v9_: bool = lt v6_ v8_; - v10_: int = const 5; - v11_: bool = lt v6_ v10_; - br v11_ .v12_ .v13_; + v1_: int = const 0; + v2_: int = id v1_; +.v3_: + v4_: int = const 6; + v5_: bool = lt v2_ v4_; + v6_: int = const 5; + v7_: bool = lt v2_ v6_; + br v7_ .v8_ .v9_; +.v8_: + v10_: int = const 1; + print v10_; + v11_: int = id v2_; .v12_: - v14_: int = const 1; - print v14_; - v15_: int = id v6_; + v13_: int = const 1; + v14_: int = add v13_ v2_; + v15_: int = id v14_; + br v5_ .v16_ .v17_; .v16_: - v17_: int = const 1; - v18_: int = add v17_ v6_; - v19_: int = id v18_; - br v9_ .v20_ .v21_; -.v20_: - v19_: int = id v18_; -.v21_: - v6_: int = id v19_; - br v9_ .v7_ .v22_; -.v22_: - v3_: int = id v6_; - jmp .v5_; -.v13_: - v23_: int = const 2; - print v23_; - v15_: int = id v6_; - jmp .v16_; -.v5_: - print v3_; + v15_: int = id v14_; +.v17_: + v2_: int = id v15_; + br v5_ .v3_ .v18_; +.v9_: + v19_: int = const 2; + print v19_; + v11_: int = id v2_; + jmp .v12_; +.v18_: + print v2_; } diff --git a/tests/snapshots/files__range_splitting-optimize.snap b/tests/snapshots/files__range_splitting-optimize.snap index 197c74a10..1e64a449e 100644 --- a/tests/snapshots/files__range_splitting-optimize.snap +++ b/tests/snapshots/files__range_splitting-optimize.snap @@ -4,40 +4,32 @@ expression: visualization.result --- @main { .v0_: - v1_: bool = const true; - v2_: int = const 1; - print v2_; - v3_: int = id v2_; - br v1_ .v4_ .v5_; -.v4_: - v6_: int = id v2_; -.v7_: - v8_: int = const 1; - v9_: int = add v6_ v8_; - v10_: int = const 5; - v11_: bool = lt v9_ v10_; - v12_: bool = lt v6_ v10_; - br v12_ .v13_ .v14_; + v1_: int = const 0; + v2_: int = id v1_; +.v3_: + v4_: int = const 1; + v5_: int = add v2_ v4_; + v6_: int = const 5; + v7_: bool = lt v5_ v6_; + v8_: bool = lt v2_ v6_; + br v8_ .v9_ .v10_; +.v9_: + v11_: int = const 1; + print v11_; + v12_: int = id v2_; .v13_: - v15_: int = const 1; - print v15_; - v16_: int = id v6_; + v14_: int = id v5_; + br v7_ .v15_ .v16_; +.v15_: + v14_: int = id v5_; +.v16_: + v2_: int = id v14_; + br v7_ .v3_ .v17_; +.v10_: + v18_: int = const 2; + print v18_; + v12_: int = id v2_; + jmp .v13_; .v17_: - v18_: int = id v9_; - br v11_ .v19_ .v20_; -.v19_: - v18_: int = id v9_; -.v20_: - v6_: int = id v18_; - br v11_ .v7_ .v21_; -.v21_: - v3_: int = id v6_; - jmp .v5_; -.v14_: - v22_: int = const 2; - print v22_; - v16_: int = id v6_; - jmp .v17_; -.v5_: - print v3_; + print v2_; } diff --git a/tests/snapshots/files__simplest_loop-optimize.snap b/tests/snapshots/files__simplest_loop-optimize.snap index f0b6a9bea..b1a6cd2c5 100644 --- a/tests/snapshots/files__simplest_loop-optimize.snap +++ b/tests/snapshots/files__simplest_loop-optimize.snap @@ -4,17 +4,18 @@ expression: visualization.result --- @main { .v0_: - v1_: int = const 1; + v1_: int = const 0; v2_: int = const 5; - v3_: int = id v1_; - v4_: int = id v2_; - v5_: int = id v1_; -.v6_: - v7_: int = add v3_ v5_; - v8_: bool = lt v7_ v4_; - v3_: int = id v7_; - v4_: int = id v4_; + v3_: int = const 1; + v4_: int = id v1_; + v5_: int = id v2_; + v6_: int = id v3_; +.v7_: + v8_: int = add v4_ v6_; + v9_: bool = lt v8_ v5_; + v4_: int = id v8_; v5_: int = id v5_; - br v8_ .v6_ .v9_; -.v9_: + v6_: int = id v6_; + br v9_ .v7_ .v10_; +.v10_: } diff --git a/tests/snapshots/files__sqrt-optimize.snap b/tests/snapshots/files__sqrt-optimize.snap index fb7981af8..35f236503 100644 --- a/tests/snapshots/files__sqrt-optimize.snap +++ b/tests/snapshots/files__sqrt-optimize.snap @@ -36,8 +36,8 @@ expression: visualization.result v29_: float = fadd v22_ v28_; v30_: float = fdiv v29_ v25_; v31_: float = fdiv v30_ v22_; - v32_: bool = fle v31_ v23_; - v33_: bool = fge v31_ v24_; + v32_: bool = fge v31_ v24_; + v33_: bool = fle v31_ v23_; v34_: bool = and v32_ v33_; v35_: bool = const true; v36_: float = id v21_; diff --git a/tests/snapshots/files__unroll_multiple_4-optimize.snap b/tests/snapshots/files__unroll_multiple_4-optimize.snap index e338c81fa..093bd6745 100644 --- a/tests/snapshots/files__unroll_multiple_4-optimize.snap +++ b/tests/snapshots/files__unroll_multiple_4-optimize.snap @@ -4,11 +4,11 @@ expression: visualization.result --- @main { .v0_: - v1_: int = const 0; - v2_: int = const 16; + v1_: int = const 16; + v2_: int = const 0; v3_: int = const 1; - v4_: int = id v1_; - v5_: int = id v2_; + v4_: int = id v2_; + v5_: int = id v1_; v6_: int = id v3_; .v7_: v8_: int = add v4_ v6_; @@ -21,5 +21,5 @@ expression: visualization.result v6_: int = id v6_; br v12_ .v7_ .v13_; .v13_: - print v4_; + print v1_; } From 8fa6bf17b5edfa593de760461a94502255326c5d Mon Sep 17 00:00:00 2001 From: Kirsten <32720576+kirstenmg@users.noreply.github.com> Date: Thu, 23 May 2024 11:57:50 -0700 Subject: [PATCH 4/7] Remove debugging files' --- dag_in_context/out.egg | 3725 -------------------------------------- out.egg | 3854 ---------------------------------------- 2 files changed, 7579 deletions(-) delete mode 100644 dag_in_context/out.egg delete mode 100644 out.egg diff --git a/dag_in_context/out.egg b/dag_in_context/out.egg deleted file mode 100644 index dcc5f9426..000000000 --- a/dag_in_context/out.egg +++ /dev/null @@ -1,3725 +0,0 @@ - Compiling dag_in_context v0.1.0 (/Users/kirsten/GitHub/eggcc/dag_in_context) -warning: unused import: `crate::egglog_test` - --> src/optimizations/loop_unroll.rs:34:9 - | -34 | use crate::egglog_test; - | ^^^^^^^^^^^^^^^^^^ - | - = note: `#[warn(unused_imports)]` on by default - -warning: unused import: `crate::egglog_test_and_print_program` - --> src/optimizations/loop_unroll.rs:1:5 - | -1 | use crate::egglog_test_and_print_program; - | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - | - = note: `#[warn(unused_imports)]` on by default - -warning: unused variable: `expected` - --> src/optimizations/loop_unroll.rs:61:9 - | -61 | let expected = parallel!(int(2), int(1)).with_arg_types(emptyt(), tuplet!(intt(), intt())); - | ^^^^^^^^ help: if this is intentional, prefix it with an underscore: `_expected` - | - = note: `#[warn(unused_variables)]` on by default - -warning: `dag_in_context` (lib) generated 1 warning (run `cargo fix --lib -p dag_in_context` to apply 1 suggestion) -warning: `dag_in_context` (lib test) generated 2 warnings (run `cargo fix --lib -p dag_in_context --tests` to apply 2 suggestions) - Finished release [optimized] target(s) in 5.98s - Running unittests src/lib.rs (target/release/deps/dag_in_context-90c12cb0a35ca697) -; Every term is an `Expr` or a `ListExpr`. -(datatype Expr) -; Used for constructing a list of branches for `Switch`es -; or a list of functions in a `Program`. -(datatype ListExpr (Cons Expr ListExpr) (Nil)) - -; ================================= -; Types -; ================================= - -(sort TypeList) - -(datatype BaseType - (IntT) - (BoolT) - (FloatT) - ; a pointer to a memory region with a particular type - (PointerT BaseType) - (StateT)) - - -(datatype Type - ; a primitive type - (Base BaseType) - ; a typed tuple. Use an empty tuple as a unit type. - ; state edge also has unit type - (TupleT TypeList) -) - -(function TNil () TypeList) -(function TCons (BaseType TypeList) TypeList) ; Head element should never be a tuple - - -; ================================= -; Assumptions -; ================================= - -(datatype Assumption - ; Assume nothing - (InFunc String) - ; The term is in a loop with `input` and `pred_output`. - ; InLoop is a special context because it describes the argument of the loop. It is a *scope context*. - ; input pred_output - (InLoop Expr Expr) - ; Branch of the switch, and what the predicate is, and what the input is - (InSwitch i64 Expr Expr) - ; If the predicate was true, and what the predicate is, and what the input is - (InIf bool Expr Expr) -) - - - -; ================================= -; Leaf nodes -; Constants, argument, and empty tuple -; ================================= - -; Only a single argument is bound- if multiple values are needed, arg will be a tuple. -; e.g. `(Get (Arg tuple_type) 1)` gets the second value in the argument with some tuple_type. -(function Arg (Type Assumption) Expr) - -; Constants -(datatype Constant - (Int i64) - (Bool bool) - (Float f64)) -; All leaf nodes need the type of the argument -; Type is the type of the bound argument in scope -(function Const (Constant Type Assumption) Expr) - -; An empty tuple. -; Type is the type of the bound argument in scope -(function Empty (Type Assumption) Expr) - - -; ================================= -; Operators -; ================================= - -(datatype TernaryOp - ; given a pointer, value, and a state edge - ; writes the value to the pointer and returns - ; the resulting state edge - (Write) - (Select)) -(datatype BinaryOp - ;; integer operators - (Add) - (Sub) - (Div) - (Mul) - (LessThan) - (GreaterThan) - (LessEq) - (GreaterEq) - (Eq) - ;; float operators - (FAdd) - (FSub) - (FDiv) - (FMul) - (FLessThan) - (FGreaterThan) - (FLessEq) - (FGreaterEq) - (FEq) - ;; logical operators - (And) - (Or) - ; given a pointer and a state edge - ; loads the value at the pointer and returns (value, state edge) - (Load) - ; Takes a pointer and an integer, and offsets - ; the pointer by the integer - (PtrAdd) - ; given and value and a state edge, prints the value as a side-effect - ; the value must be a base value, not a tuple - ; returns an empty tuple - (Print) - ; given a pointer and state edge, frees the whole memory region at the pointer - (Free)) -(datatype UnaryOp - (Not)) - -; Operators -(function Top (TernaryOp Expr Expr Expr) Expr) -(function Bop (BinaryOp Expr Expr) Expr) -(function Uop (UnaryOp Expr) Expr) -; gets from a tuple. static index -(function Get (Expr i64) Expr) -; (Alloc id amount state_edge pointer_type) -; allocate an integer amount of memory for a particular type -; returns (pointer to the allocated memory, state edge) -(function Alloc (i64 Expr Expr BaseType) Expr) -; name of func arg -(function Call (String Expr) Expr) - - - -; ================================= -; Tuple operations -; ================================= - -; `Empty`, `Single` and `Concat` create tuples. -; 1. Use `Empty` for an empty tuple. -; 2. Use `Single` for a tuple with one element. -; 3. Use `Concat` to append the elements from two tuples together. -; Nested tuples are not allowed. - - -; A tuple with a single element. -; Necessary because we only use `Concat` to add to tuples. -(function Single (Expr) Expr) -; Concat appends the elemnts from two tuples together -; e.g. (Concat (Concat (Single a) (Single b)) -; (Concat (Single c) (Single d))) = (a, b, c, d) -; expr1 expr2 -(function Concat (Expr Expr) Expr) - - - -; ================================= -; Control flow -; ================================= - -; Switch on a list of lazily-evaluated branches. -; pred must be an integer -; pred inputs branches chosen -(function Switch (Expr Expr ListExpr) Expr) -; If is like switch, but with a boolean predicate -; pred inputs then else -(function If (Expr Expr Expr Expr) Expr) - - -; A do-while loop. -; Evaluates the input, then evaluates the body. -; Keeps looping while the predicate is true. -; input must have the same type as (output1, output2, ..., outputi) -; input must be a tuple -; pred must be a boolean -; pred-and-body must be a flat tuple (pred, out1, out2, ..., outi) -; input must be the same type as (out1, out2, ..., outi) -; input pred-and-body -(function DoWhile (Expr Expr) Expr) - - -; ================================= -; Top-level expressions -; ================================= -(sort ProgramType) -; An entry function and a list of additional functions. -; entry function other functions -(function Program (Expr ListExpr) ProgramType) -; name input ty output ty output -(function Function (String Type Type Expr) Expr) - - - -; Rulesets -(ruleset always-run) -(ruleset error-checking) -(ruleset memory) -(ruleset memory-helpers) -(ruleset smem) - -;; Initliazation -(relation bop->string (BinaryOp String)) -(relation uop->string (UnaryOp String)) -(relation top->string (TernaryOp String)) -(bop->string (Add) "Add") -(bop->string (Sub) "Sub") -(bop->string (Div) "Div") -(bop->string (Mul) "Mul") -(bop->string (LessThan) "LessThan") -(bop->string (GreaterThan) "GreaterThan") -(bop->string (LessEq) "LessEq") -(bop->string (GreaterEq) "GreaterEq") -(bop->string (Eq) "Eq") -(bop->string (FAdd) "FAdd") -(bop->string (FSub) "FSub") -(bop->string (FDiv) "FDiv") -(bop->string (FMul) "FMul") -(bop->string (FLessThan) "FLessThan") -(bop->string (FGreaterThan) "FGreaterThan") -(bop->string (FLessEq) "FLessEq") -(bop->string (FGreaterEq) "FGreaterEq") -(bop->string (FEq) "FEq") -(bop->string (And) "And") -(bop->string (Or) "Or") -(bop->string (Load) "Load") -(bop->string (PtrAdd) "PtrAdd") -(bop->string (Print) "Print") -(bop->string (Free) "Free") -(ruleset type-analysis) -(ruleset type-helpers) ;; these rules need to saturate between every iter of type-analysis rules - -(function TLConcat (TypeList TypeList) TypeList :unextractable) -(rewrite (TLConcat (TNil) r) r :ruleset type-helpers) -(rewrite (TLConcat (TCons hd tl) r) - (TCons hd (TLConcat tl r)) - :ruleset type-helpers) - -(function TypeList-length (TypeList) i64 :unextractable) -(function TypeList-ith (TypeList i64) BaseType :unextractable) -(function TypeList-suffix (TypeList i64) TypeList :unextractable) - -(rule ((TupleT tylist)) ((union (TypeList-suffix tylist 0) tylist)) :ruleset type-helpers) - -(rule ((= (TypeList-suffix top n) (TCons hd tl))) - ((union (TypeList-ith top n) hd) - (union (TypeList-suffix top (+ n 1)) tl)) :ruleset type-helpers) - -(rule ((= (TypeList-suffix list n) (TNil))) - ((set (TypeList-length list) n)) :ruleset type-helpers) - -(rule ((TypeList-ith list i) - (= (TypeList-length list) n) - (>= i n)) - ((panic "TypeList-ith out of bounds")) :ruleset type-helpers) - -(relation HasType (Expr Type)) - - -;; Keep track of type expectations for error messages -(relation ExpectType (Expr Type String)) -(rule ( - (ExpectType e expected msg) - (HasType e actual) - (!= expected actual) ;; OKAY to compare types for equality because we never union types. - ) - ((extract "Expecting expression") - (extract e) - (extract "to have type") - (extract expected) - (extract "but got type") - (extract actual) - (extract "with message") - (extract msg) - (panic "type mismatch")) - :ruleset error-checking) - -(relation HasArgType (Expr Type)) - -(rule ((HasArgType (Arg t1 ctx) t2) - (!= t1 t2)) - ((panic "arg type mismatch")) - :ruleset error-checking) - -(rule ((= lhs (Function name in out body)) - (HasArgType body ty) - (HasArgType body ty2) - (!= ty ty2)) - ((panic "arg type mismatch in function")) - :ruleset error-checking) - -; Propagate arg types up -(rule ((= lhs (Uop _ e)) - (HasArgType e ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Bop _ a b)) - (HasArgType a ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Bop _ a b)) - (HasArgType b ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Get e _)) - (HasArgType e ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Alloc _id e state _)) - (HasArgType e ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Call _ e)) - (HasArgType e ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Single e)) - (HasArgType e ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Concat e1 e2)) - (HasArgType e1 ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Concat e1 e2)) - (HasArgType e2 ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Switch pred inputs (Cons branch rest))) - (HasArgType pred ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Switch pred inputs (Cons branch rest))) - (HasArgType branch ty) - (HasType inputs ty2) - (!= ty ty2)) - ((panic "switch branches then branch has incorrect input type")) - :ruleset error-checking) -;; demand with one fewer branches -(rule ((= lhs (Switch pred inputs (Cons branch rest)))) - ((Switch pred inputs rest)) - :ruleset type-analysis) -(rule ((= lhs (If c i t e)) - (HasArgType c ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (If c i t e)) - (HasType i ty) - (HasArgType t ty2) - (!= ty ty2)) - ((panic "if branches then branch has incorrect input type")) - :ruleset error-checking) -(rule ((= lhs (If c i t e)) - (HasType i ty) - (HasArgType e ty2) - (!= ty ty2)) - ((panic "if branches else branch has incorrect input type")) - :ruleset error-checking) - - -(rule ((= lhs (DoWhile ins body)) - (HasArgType ins ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -; Don't push arg types through Program, Function, DoWhile, Let exprs because -; these create new arg contexts. - -; Primitives -(rule ((= lhs (Const (Int i) ty ctx))) - ((HasType lhs (Base (IntT))) - (HasArgType lhs ty)) - :ruleset type-analysis) - -(rule ((= lhs (Const (Bool b) ty ctx))) - ((HasType lhs (Base (BoolT))) - (HasArgType lhs ty)) - :ruleset type-analysis) - -(rule ((= lhs (Const (Float b) ty ctx))) - ((HasType lhs (Base (FloatT))) - (HasArgType lhs ty)) - :ruleset type-analysis) - -(rule ((= lhs (Empty ty ctx))) - ((HasType lhs (TupleT (TNil))) - (HasArgType lhs ty)) - :ruleset type-analysis) - -; Unary Ops -(rule ( - (= lhs (Uop (Not) e)) - (HasType e (Base (BoolT))) - ) - ((HasType lhs (Base (BoolT)))) - :ruleset type-analysis) -(rule ((= lhs (Uop (Not) e))) - ((ExpectType e (Base (BoolT)) "(Not)")) - :ruleset type-analysis) - - -(rule ( - (= lhs (Bop (Print) e state)) - (HasType e _ty) ; just make sure it has some type. - ) - ((HasType lhs (Base (StateT)))) - :ruleset type-analysis) - -(rule ( - (= lhs (Bop (Print) e state)) - (HasType e (TupleT ty)) - ) - ((panic "Don't print a tuple")) - :ruleset error-checking) - -(rule ((= lhs (Bop (Free) e s)) - (HasType e (Base (PointerT _ty)))) - ((HasType lhs (Base (StateT)))) - :ruleset type-analysis) -(rule ((= lhs (Bop (Free) e s)) - (HasType e (Base (IntT)))) - ((panic "Free expected pointer, received integer")) - :ruleset error-checking) -(rule ((= lhs (Bop (Free) e s)) - (HasType e (TupleT _ty))) - ((panic "Free expected pointer, received tuple")) - :ruleset error-checking) - -(rule ( - (= lhs (Bop (Load) e state)) - (HasType e (Base (PointerT ty))) - ) - ((HasType lhs (TupleT (TCons ty (TCons (StateT) (TNil)))))) - :ruleset type-analysis) -(rule ( - (= lhs (Bop (Load) e state)) - (HasType e ty) - (= ty (Base (IntT))) - ) - ((panic "(Load) expected pointer, received int")) - :ruleset error-checking) -(rule ( - (= lhs (Bop (Load) e state)) - (HasType e ty) - (= ty (TupleT x)) - ) - ((panic "(Load) expected pointer, received tuple")) - :ruleset error-checking) - -; Binary ops - -;; Operators that have type Type -> Type -> Type -;; Note we only do this generic matching for binary -;; operator since there's a lot of them. -;; In the future we can also extend to other constructs. -(relation bop-of-type (BinaryOp Type)) -(bop-of-type (Add) (Base (IntT))) -(bop-of-type (Sub) (Base (IntT))) -(bop-of-type (Div) (Base (IntT))) -(bop-of-type (Mul) (Base (IntT))) -(bop-of-type (FAdd) (Base (FloatT))) -(bop-of-type (FSub) (Base (FloatT))) -(bop-of-type (FDiv) (Base (FloatT))) -(bop-of-type (FMul) (Base (FloatT))) - -(rule ( - (= lhs (Bop op e1 e2)) - (bop-of-type op ty) - (HasType e1 ty) - (HasType e2 ty) - ) - ((HasType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Bop op e1 e2)) - (bop-of-type op ty) - (bop->string op op-str)) - ( - (ExpectType e1 ty op-str) - (ExpectType e2 ty op-str) - ) - :ruleset type-analysis) - -;; Operators that have type Float -> Float -> Bool -(relation bpred-of-type (BinaryOp Type)) -(bpred-of-type (FLessThan) (Base (FloatT))) -(bpred-of-type (FLessEq) (Base (FloatT))) -(bpred-of-type (FGreaterThan) (Base (FloatT))) -(bpred-of-type (FGreaterEq) (Base (FloatT))) -(bpred-of-type (FEq) (Base (FloatT))) -(bpred-of-type (LessThan) (Base (IntT))) -(bpred-of-type (LessEq) (Base (IntT))) -(bpred-of-type (GreaterThan) (Base (IntT))) -(bpred-of-type (GreaterEq) (Base (IntT))) -(bpred-of-type (Eq) (Base (IntT))) -(bpred-of-type (And) (Base (BoolT))) -(bpred-of-type (Or) (Base (BoolT))) - -(rule ( - (= lhs (Bop pred e1 e2)) - (bpred-of-type pred ty) - (HasType e1 ty) - (HasType e2 ty) - ) - ((HasType lhs (Base (BoolT)))) - :ruleset type-analysis) -(rule ((= lhs (Bop pred e1 e2)) - (bpred-of-type pred ty) - (bop->string pred pred-str)) - ( - (ExpectType e1 ty pred-str) - (ExpectType e2 ty pred-str) - ) - :ruleset type-analysis) - -(rule ( - (= lhs (Top (Write) ptr val state)) - (HasType ptr (Base (PointerT ty))) - (HasType val (Base t)) ; TODO need to support pointers to pointers - ) - ((HasType lhs (Base (StateT)))) ; Write returns () - :ruleset type-analysis) - -(rule ( - (= lhs (Top (Write) ptr val state)) - (HasType ptr (Base (PointerT ty)))) - ((ExpectType val (Base ty) "(Write)")) - :ruleset type-analysis) - - - -(rule ( - (= lhs (Bop (PtrAdd) ptr n)) - (HasType ptr (Base (PointerT ty))) - (HasType n (Base (IntT))) - ) - ((HasType lhs (Base (PointerT ty)))) - :ruleset type-analysis) - -; Other ops -(rule ((= lhs (Alloc _id amt state ty))) - ((ExpectType amt (Base (IntT)) "(Alloc)")) - :ruleset type-analysis) - -(rule ( - (= lhs (Alloc _id amt state ty)) - (HasType amt (Base (IntT))) - ) - ((HasType lhs (TupleT (TCons ty (TCons (StateT) (TNil)))))) - :ruleset type-analysis) - -(rule ( - (= lhs (Get e i)) - (HasType e (TupleT tylist)) - ) - ; TypeList-ith needs to compute immediately, so we need to saturate type-helpers - ; rules between every iter of type-analysis rules. - ((HasType lhs (Base (TypeList-ith tylist i)))) - :ruleset type-analysis) - -(rule ( - (HasType (Get expr i) (TupleT tl)) - (= (TypeList-length tl) len) - (>= i len)) - ((panic "index out of bounds")) - :ruleset error-checking) -(rule ( - (HasType (Get expr i) (TupleT tl)) - (= (TypeList-length tl) len) - (< i 0) - ) - ((panic "negative index")) - :ruleset error-checking) - -; ================================= -; Tuple operations -; ================================= - -(rule ( - (= lhs (Single e)) - (HasType e (TupleT tylist)) - ) - ((panic "don't nest tuples")) - :ruleset error-checking) - -(rule ( - (= lhs (Single e)) - (HasType e (Base basety)) - ) - ((HasType lhs (TupleT (TCons basety (TNil))))) - :ruleset type-analysis) - -(rule ( - (= lhs (Concat e1 e2)) - (HasType e1 (TupleT tylist1)) - (HasType e2 (TupleT tylist2)) - ) - ; TLConcat needs to compute immediately, so we need to saturate type-helpers - ; rules between every iter of type-analysis rules. - ((HasType lhs (TupleT (TLConcat tylist1 tylist2)))) - :ruleset type-analysis) - -; ================================= -; Control flow -; ================================= -(rule ((= lhs (If pred inputs then else))) - ((ExpectType pred (Base (BoolT)) "If predicate must be boolean")) - :ruleset type-analysis) -(rule ( - (= lhs (If pred inputs then else)) - (HasType pred (Base (BoolT))) - (HasType then ty) - (HasType else ty) - ) - ((HasType lhs ty)) - :ruleset type-analysis) - -(rule ( - (= lhs (If pred inputs then else)) - (HasType pred (Base (BoolT))) - (HasType then tya) - (HasType else tyb) - (!= tya tyb) - ) - ((panic "if branches had different types")) - :ruleset error-checking) - - - -(rule ((= lhs (Switch pred inputs branches))) - ((ExpectType pred (Base (IntT)) "Switch predicate must be integer")) - :ruleset type-analysis) - -; base case: single branch switch has type of branch -(rule ( - (= lhs (Switch pred inputs (Cons branch (Nil)))) - (HasType pred (Base (IntT))) - (HasType branch ty) - ) - ((HasType lhs ty)) - :ruleset type-analysis) - -; recursive case: peel off a layer -(rule ((Switch pred inputs (Cons branch rest))) - ((Switch pred inputs rest)) - :ruleset type-analysis) - -(rule ( - (= lhs (Switch pred inputs (Cons branch rest))) - (HasType pred (Base (IntT))) - (HasType branch ty) - (HasType (Switch pred inputs rest) ty) ; rest of the branches also have type ty - ) - ((HasType lhs ty)) - :ruleset type-analysis) - -(rule ( - (= lhs (Switch pred inputs (Cons branch rest))) - (HasType pred (Base (IntT))) - (HasType branch tya) - (HasType (Switch pred inputs rest) tyb) - (!= tya tyb) - ) - ((panic "switch branches had different types")) - :ruleset error-checking) - -(rule ((Arg ty ctx)) - ( - (HasType (Arg ty ctx) ty) - (HasArgType (Arg ty ctx) ty) - ) - :ruleset type-analysis) - - -(rule ( - (= lhs (DoWhile inp pred-body)) - (HasType inp (Base ty)) - ) - ((panic "loop input must be tuple")) - :ruleset error-checking) -(rule ( - (= lhs (DoWhile inp pred-body)) - (HasType inp (Base (PointerT ty))) - ) - ((panic "loop input must be tuple")) - :ruleset error-checking) -(rule ( - (= lhs (DoWhile inp pred-body)) - (HasType pred-body (Base ty)) - ) - ((panic "loop pred-body must be tuple")) - :ruleset error-checking) -(rule ( - (= lhs (DoWhile inp pred-body)) - (HasType pred-body (Base (PointerT ty))) - ) - ((panic "loop pred-body must be tuple")) - :ruleset error-checking) - -(rule ( - (= lhs (DoWhile inp pred-body)) - (HasType inp (TupleT tylist)) - ) - ((HasArgType pred-body (TupleT tylist))) - :ruleset type-analysis) - -(rule ((= lhs (DoWhile inp pred-body))) - ((ExpectType (Get pred-body 0) (Base (BoolT)) "loop pred must be bool")) - :ruleset type-analysis) - -(rule ( - (= lhs (DoWhile inp pred-body)) - (HasType inp (TupleT tylist)) ; input is a tuple - ; pred-body is a tuple where the first elt is a bool - ; and the rest of the list matches the input type - (HasType pred-body (TupleT (TCons (BoolT) tylist))) - ) - ((HasType lhs (TupleT tylist))) ; whole thing has type of inputs/outputs - :ruleset type-analysis) - -(rule ( - (= lhs (DoWhile inp pred-body)) - (HasType inp (TupleT in-tys)) - (HasType pred-body (TupleT (TCons (BoolT) out-tys))) - (!= in-tys out-tys) - ) - ((panic "input types and output types don't match")) - :ruleset error-checking) - -; ================================= -; Functions -; ================================= - -(rule ((= lhs (Function name in-ty out-ty body))) - ( - ; Arg should have the specified type in the body - (HasArgType body in-ty) - ; Expect the body to have the specified output type - (ExpectType body out-ty "Function body had wrong type") - ) - :ruleset type-analysis) - -(rule ( - (= lhs (Call name arg)) - (Function name in-ty out-ty body) - ) - ; Expect the arg to have the right type for the function - ((ExpectType arg in-ty "function called with wrong arg type")) - :ruleset type-analysis) - -(rule ( - (= lhs (Call name arg)) - (Function name in-ty out-ty body) - (HasType arg in-ty) - ; We don't need to check the type of the function body, it will - ; be checked elsewhere. If we did require (HasType body out-ty), - ; recursive functions would not get assigned a type. - ) - ((HasType lhs out-ty)) - :ruleset type-analysis) - -; find which types are pure -(relation PureBaseType (BaseType)) -(relation PureType (Type)) -(relation PureTypeList (TypeList)) - -(PureBaseType (IntT)) -(PureBaseType (BoolT)) -(rule ((Base ty) - (PureBaseType ty)) - ((PureType (Base ty))) - :ruleset type-analysis) -(rule ((TupleT tylist) - (PureTypeList tylist)) - ((PureType (TupleT tylist))) - :ruleset type-analysis) -(rule ((TNil)) - ((PureTypeList (TNil))) - :ruleset type-analysis) -(rule ((TCons hd tl) - (PureBaseType hd) - (PureTypeList tl)) - ((PureTypeList (TCons hd tl))) - :ruleset type-analysis) - -(function ListExpr-length (ListExpr) i64) -(function ListExpr-ith (ListExpr i64) Expr :unextractable) -(function ListExpr-suffix (ListExpr i64) ListExpr :unextractable) -(function Append (ListExpr Expr) ListExpr :unextractable) - -(rule ((Switch pred inputs branch)) ((union (ListExpr-suffix branch 0) branch)) :ruleset always-run) - -(rule ((= (ListExpr-suffix top n) (Cons hd tl))) - ((union (ListExpr-ith top n) hd) - (union (ListExpr-suffix top (+ n 1)) tl)) :ruleset always-run) - -(rule ((= (ListExpr-suffix list n) (Nil))) - ((set (ListExpr-length list) n)) :ruleset always-run) - -(rewrite (Append (Cons a b) e) - (Cons a (Append b e)) - :ruleset always-run) -(rewrite (Append (Nil) e) - (Cons e (Nil)) - :ruleset always-run) - -(function tuple-length (Expr) i64 :unextractable) - -(rule ((HasType expr (TupleT tl)) - (= len (TypeList-length tl))) - ((set (tuple-length expr) len)) :ruleset always-run) - -;; Create a Get for every index, and rewrite it to see through Concat -(rule ((Single expr)) ((union (Get (Single expr) 0) expr)) :ruleset always-run) -;; initial get -(rule ((> (tuple-length tuple) 0)) - ((Get tuple 0)) - :ruleset always-run) -;; next get -(rule ((= len (tuple-length tuple)) - (= ith (Get tuple i)) - (< (+ i 1) len) - ) - ((Get tuple (+ 1 i))) - :ruleset always-run) - -;; descend left -(rule ((Get (Concat expr1 expr2) i) - (= (tuple-length expr1) len1) - (< i len1)) - ((union (Get (Concat expr1 expr2) i) - (Get expr1 i))) - :ruleset always-run) -;; descend right -(rule ((Get (Concat expr1 expr2) i) - (= (tuple-length expr1) len1) - (>= i len1)) - ((union (Get (Concat expr1 expr2) i) - (Get expr2 (- i len1)))) - :ruleset always-run) - - -;; A temporary context. -;; Be sure to delete at the end of all actions or else!!! -;; This is safer than using a persistant context, since we may miss an important part of the query. -(function TmpCtx () Assumption) - -(rule ((TmpCtx)) - ((panic "TmpCtx should not exist outside rule body")) - :ruleset always-run) - -(relation ExprIsValid (Expr)) -(relation ListExprIsValid (ListExpr)) -(rule ((ExprIsValid (Function _name _tyin _tyout _out))) ((ExprIsValid _out)) :ruleset always-run) -(rule ((ExprIsValid (Top _op _x _y _z))) ((ExprIsValid _x) -(ExprIsValid _y) -(ExprIsValid _z)) :ruleset always-run) -(rule ((ExprIsValid (Bop _op _x _y))) ((ExprIsValid _x) -(ExprIsValid _y)) :ruleset always-run) -(rule ((ExprIsValid (Uop _op _x))) ((ExprIsValid _x)) :ruleset always-run) -(rule ((ExprIsValid (Get _tup _i))) ((ExprIsValid _tup)) :ruleset always-run) -(rule ((ExprIsValid (Concat _x _y))) ((ExprIsValid _x) -(ExprIsValid _y)) :ruleset always-run) -(rule ((ExprIsValid (Single _x))) ((ExprIsValid _x)) :ruleset always-run) -(rule ((ExprIsValid (Switch _pred _inputs _branches))) ((ExprIsValid _pred) -(ExprIsValid _inputs) -(ListExprIsValid _branches)) :ruleset always-run) -(rule ((ExprIsValid (If _pred _input _then _else))) ((ExprIsValid _pred) -(ExprIsValid _input) -(ExprIsValid _then) -(ExprIsValid _else)) :ruleset always-run) -(rule ((ExprIsValid (DoWhile _in _pred-and-output))) ((ExprIsValid _in) -(ExprIsValid _pred-and-output)) :ruleset always-run) -(rule ((ExprIsValid (Call _func _arg))) ((ExprIsValid _arg)) :ruleset always-run) -(rule ((ListExprIsValid (Cons _hd _tl))) ((ExprIsValid _hd) -(ListExprIsValid _tl)) :ruleset always-run) -(rule ((ExprIsValid (Alloc _id _e _state _ty))) ((ExprIsValid _e) -(ExprIsValid _state)) :ruleset always-run) -(relation ExprIsResolved (Expr)) -(relation ListExprIsResolved (ListExpr)) -(rule ((= lhs (Function _name _tyin _tyout _out)) (ExprIsResolved _out)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Const _n _ty _ctx)) ) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Top _op _x _y _z)) (ExprIsResolved _x) -(ExprIsResolved _y) -(ExprIsResolved _z)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Bop _op _x _y)) (ExprIsResolved _x) -(ExprIsResolved _y)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Uop _op _x)) (ExprIsResolved _x)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Get _tup _i)) (ExprIsResolved _tup)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Concat _x _y)) (ExprIsResolved _x) -(ExprIsResolved _y)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Single _x)) (ExprIsResolved _x)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Switch _pred _inputs _branches)) (ExprIsResolved _pred) -(ExprIsResolved _inputs) -(ListExprIsResolved _branches)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (If _pred _input _then _else)) (ExprIsResolved _pred) -(ExprIsResolved _input) -(ExprIsResolved _then) -(ExprIsResolved _else)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (DoWhile _in _pred-and-output)) (ExprIsResolved _in) -(ExprIsResolved _pred-and-output)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Arg _ty _ctx)) ) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Call _func _arg)) (ExprIsResolved _arg)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Empty _ty _ctx)) ) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Cons _hd _tl)) (ExprIsResolved _hd) -(ListExprIsResolved _tl)) ((ListExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Nil)) ) ((ListExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Alloc _id _e _state _ty)) (ExprIsResolved _e) -(ExprIsResolved _state)) ((ExprIsResolved lhs)) :ruleset always-run) -(relation BodyContainsExpr (Expr Expr)) -(relation BodyContainsListExpr (Expr ListExpr)) -(rule ((Function _name _tyin _tyout _out)) ((BodyContainsExpr (Function _name _tyin _tyout _out) _out)) :ruleset always-run) -(rule ((If _pred _input _then _else)) ((BodyContainsExpr (If _pred _input _then _else) _then) (BodyContainsExpr (If _pred _input _then _else) _else)) :ruleset always-run) -(rule ((DoWhile _in _pred-and-output)) ((BodyContainsExpr (DoWhile _in _pred-and-output) _pred-and-output)) :ruleset always-run) -(rule ((BodyContainsExpr body (Top _op _x _y _z))) ((BodyContainsExpr body _x) (BodyContainsExpr body _y) (BodyContainsExpr body _z)) :ruleset always-run) -(rule ((BodyContainsExpr body (Bop _op _x _y))) ((BodyContainsExpr body _x) (BodyContainsExpr body _y)) :ruleset always-run) -(rule ((BodyContainsExpr body (Uop _op _x))) ((BodyContainsExpr body _x)) :ruleset always-run) -(rule ((BodyContainsExpr body (Get _tup _i))) ((BodyContainsExpr body _tup)) :ruleset always-run) -(rule ((BodyContainsExpr body (Concat _x _y))) ((BodyContainsExpr body _x) (BodyContainsExpr body _y)) :ruleset always-run) -(rule ((BodyContainsExpr body (Single _x))) ((BodyContainsExpr body _x)) :ruleset always-run) -(rule ((BodyContainsExpr body (Switch _pred _inputs _branches))) ((BodyContainsExpr body _pred) (BodyContainsExpr body _inputs)) :ruleset always-run) -(rule ((BodyContainsExpr body (If _pred _input _then _else))) ((BodyContainsExpr body _pred) (BodyContainsExpr body _input)) :ruleset always-run) -(rule ((BodyContainsExpr body (DoWhile _in _pred-and-output))) ((BodyContainsExpr body _in)) :ruleset always-run) -(rule ((BodyContainsExpr body (Call _func _arg))) ((BodyContainsExpr body _arg)) :ruleset always-run) -(rule ((BodyContainsListExpr body (Cons _hd _tl))) ((BodyContainsExpr body _hd)) :ruleset always-run) -(rule ((BodyContainsExpr body (Alloc _id _e _state _ty))) ((BodyContainsExpr body _e) (BodyContainsExpr body _state)) :ruleset always-run) - - (relation ExprIsPure (Expr)) - (relation ListExprIsPure (ListExpr)) - (relation BinaryOpIsPure (BinaryOp)) - (relation UnaryOpIsPure (UnaryOp)) - (relation TopIsPure (TernaryOp)) -(TopIsPure (Select)) -(BinaryOpIsPure (Add)) -(BinaryOpIsPure (Sub)) -(BinaryOpIsPure (Mul)) -(BinaryOpIsPure (Div)) -(BinaryOpIsPure (Eq)) -(BinaryOpIsPure (LessThan)) -(BinaryOpIsPure (GreaterThan)) -(BinaryOpIsPure (LessEq)) -(BinaryOpIsPure (GreaterEq)) -(BinaryOpIsPure (FAdd)) -(BinaryOpIsPure (FSub)) -(BinaryOpIsPure (FMul)) -(BinaryOpIsPure (FDiv)) -(BinaryOpIsPure (FEq)) -(BinaryOpIsPure (FLessThan)) -(BinaryOpIsPure (FGreaterThan)) -(BinaryOpIsPure (FLessEq)) -(BinaryOpIsPure (FGreaterEq)) -(BinaryOpIsPure (And)) -(BinaryOpIsPure (Or)) -(BinaryOpIsPure (PtrAdd)) -(UnaryOpIsPure (Not)) - - (rule ((Function _name _tyin _tyout _out) (ExprIsPure _out)) - ((ExprIsPure (Function _name _tyin _tyout _out))) - :ruleset always-run) - - (rule ((Const _n _ty _ctx)) - ((ExprIsPure (Const _n _ty _ctx))) - :ruleset always-run) - - (rule ((Top _op _x _y _z) (ExprIsPure _x) (ExprIsPure _y) (ExprIsPure _z)) - ((ExprIsPure (Top _op _x _y _z))) - :ruleset always-run) - - (rule ((Bop _op _x _y) (BinaryOpIsPure _op) (ExprIsPure _x) (ExprIsPure _y)) - ((ExprIsPure (Bop _op _x _y))) - :ruleset always-run) - - (rule ((Uop _op _x) (UnaryOpIsPure _op) (ExprIsPure _x)) - ((ExprIsPure (Uop _op _x))) - :ruleset always-run) - - (rule ((Get _tup _i) (ExprIsPure _tup)) - ((ExprIsPure (Get _tup _i))) - :ruleset always-run) - - (rule ((Concat _x _y) (ExprIsPure _x) (ExprIsPure _y)) - ((ExprIsPure (Concat _x _y))) - :ruleset always-run) - - (rule ((Single _x) (ExprIsPure _x)) - ((ExprIsPure (Single _x))) - :ruleset always-run) - - (rule ((Switch _pred _inputs _branches) (ExprIsPure _pred) (ExprIsPure _inputs) (ListExprIsPure _branches)) - ((ExprIsPure (Switch _pred _inputs _branches))) - :ruleset always-run) - - (rule ((If _pred _input _then _else) (ExprIsPure _pred) (ExprIsPure _input) (ExprIsPure _then) (ExprIsPure _else)) - ((ExprIsPure (If _pred _input _then _else))) - :ruleset always-run) - - (rule ((DoWhile _in _pred-and-output) (ExprIsPure _in) (ExprIsPure _pred-and-output)) - ((ExprIsPure (DoWhile _in _pred-and-output))) - :ruleset always-run) - - (rule ((Arg _ty _ctx)) - ((ExprIsPure (Arg _ty _ctx))) - :ruleset always-run) - - (rule ((Call _f _arg) (ExprIsPure _arg) (ExprIsPure (Function _f inty outty out))) - ((ExprIsPure (Call _f _arg))) - :ruleset always-run) - - (rule ((Empty _ty _ctx)) - ((ExprIsPure (Empty _ty _ctx))) - :ruleset always-run) - - (rule ((Cons _hd _tl) (ExprIsPure _hd) (ListExprIsPure _tl)) - ((ListExprIsPure (Cons _hd _tl))) - :ruleset always-run) - - (rule ((Nil)) - ((ListExprIsPure (Nil))) - :ruleset always-run) - -; This file provides AddContext, a helpers that copies a sub-egraph into -; a new one with a new context. -; Users of AddContext can specify how deeply to do this copy. - - -(ruleset context) - -(function AddContext (Assumption Expr) Expr :unextractable) -(function AddContextList (Assumption ListExpr) ListExpr :unextractable) - -;; ################################ saturation - -;; Adding context a second time does nothing, so union -(rule - ((= lhs (AddContext ctx inner)) - (= inner (AddContext ctx expr))) - ((union lhs inner)) - :ruleset context) - - -;; ############################## Base cases- leaf nodes - -;; replace existing contexts that are around leaf nodes -;; AddContext assumes the new context is more specific than the old one -(rule ((= lhs (AddContext ctx (Arg ty oldctx)))) - ((union lhs (Arg ty ctx))) - :ruleset context) -(rule ((= lhs (AddContext ctx (Const c ty oldctx)))) - ((union lhs (Const c ty ctx))) - :ruleset context) -(rule ((= lhs (AddContext ctx (Empty ty oldctx)))) - ((union lhs (Empty ty ctx))) - :ruleset context) - - - - -;; ######################################### Operators -(rewrite (AddContext ctx (Bop op c1 c2)) - (Bop op - (AddContext ctx c1) - (AddContext ctx c2)) - :ruleset context) -(rewrite (AddContext ctx (Uop op c1)) - (Uop op (AddContext ctx c1)) - :ruleset context) -(rewrite (AddContext ctx (Get c1 index)) - (Get (AddContext ctx c1) index) - :ruleset context) -(rewrite (AddContext ctx (Alloc id c1 state ty)) - (Alloc id (AddContext ctx c1) (AddContext ctx state) ty) - :ruleset context) -(rewrite (AddContext ctx (Call name c1)) - (Call name (AddContext ctx c1)) - :ruleset context) - -(rewrite (AddContext ctx (Single c1)) - (Single (AddContext ctx c1)) - :ruleset context) -(rewrite (AddContext ctx (Concat c1 c2)) - (Concat - (AddContext ctx c1) - (AddContext ctx c2)) - :ruleset context) - -;; ################################### List operators - -(rewrite (AddContextList ctx (Nil)) - (Nil) - :ruleset context) - -(rewrite (AddContextList ctx (Cons c1 rest)) - (Cons (AddContext ctx c1) - (AddContextList ctx rest)) - :ruleset context) - - -;; ########################################## Control flow -(rewrite (AddContext ctx (Switch pred inputs branches)) - (Switch (AddContext ctx pred) - (AddContext ctx inputs) - branches) - :ruleset context) - -;; For stop at region, still add context to inputs -(rule ((= lhs (AddContext ctx (If pred inputs c1 c2)))) - ((union lhs - (If (AddContext ctx pred) - (AddContext ctx inputs) - c1 - c2))) - :ruleset context) - - -;; For stop at loop, still add context to inputs -(rule ((= lhs (AddContext ctx (DoWhile inputs outputs)))) - ((union lhs - (DoWhile - (AddContext ctx inputs) - outputs))) - :ruleset context) - - -;; Substitution rules allow for substituting some new expression for the argument -;; in some new context. -;; It performs the substitution, copying over the equalities from the original eclass. -;; It only places context on the leaf nodes. - -(ruleset subst) -(ruleset apply-subst-unions) -(ruleset cleanup-subst) - -;; (Subst assumption to in) substitutes `to` for `(Arg ty)` in `in`. -;; It also replaces the leaf context in `to` with `assumption` using `AddContext`. -;; `assumption` *justifies* this substitution, as the context that the result is used in. -;; In other words, it must refine the equivalence relation of `in` with `to` as the argument. -(function Subst (Assumption Expr Expr) Expr :unextractable) - -;; Used to delay unions for the subst ruleset. -;; This is necessary because substitution may not terminate if it can -;; observe its own results- it may create infinitly large terms. -;; Instead, we phase substitution by delaying resulting unions in this table. -;; After applying this table, substitutions and this table are cleared. -(function DelayedSubstUnion (Expr Expr) Expr :unextractable) - -;; add a type rule to get the arg type of a substitution -;; this enables nested substitutions -(rule ((= lhs (Subst assum to in)) - (HasArgType to ty)) - ((HasArgType lhs ty)) - :ruleset subst) - -;; leaf node with context -;; replace this context- subst assumes the context is more specific -(rule ((= lhs (Subst assum to (Arg ty oldctx))) - ) - ;; add the assumption `to` - ((DelayedSubstUnion lhs (AddContext assum to))) - :ruleset subst) -(rule ((= lhs (Subst assum to (Const c ty oldctx))) - (HasArgType to newty)) - ((DelayedSubstUnion lhs (Const c newty assum))) - :ruleset subst) -(rule ((= lhs (Subst assum to (Empty ty oldctx))) - (HasArgType to newty)) - ((DelayedSubstUnion lhs (Empty newty assum))) - :ruleset subst) - -;; Operators -(rule ((= lhs (Subst assum to (Bop op c1 c2))) - (ExprIsResolved (Bop op c1 c2))) - ((DelayedSubstUnion lhs - (Bop op (Subst assum to c1) - (Subst assum to c2)))) - :ruleset subst) -(rule ((= lhs (Subst assum to (Uop op c1))) - (ExprIsResolved (Uop op c1))) - ((DelayedSubstUnion lhs - (Uop op (Subst assum to c1)))) - :ruleset subst) - -(rule ((= lhs (Subst assum to (Get c1 index))) - (ExprIsResolved (Get c1 index))) - ((DelayedSubstUnion lhs - (Get (Subst assum to c1) index))) - :ruleset subst) -(rule ((= lhs (Subst assum to (Alloc id c1 c2 ty))) - (ExprIsResolved (Alloc id c1 c2 ty))) - ((DelayedSubstUnion lhs - (Alloc id (Subst assum to c1) - (Subst assum to c2) - ty))) - :ruleset subst) -(rule ((= lhs (Subst assum to (Call name c1))) - (ExprIsResolved (Call name c1))) - ((DelayedSubstUnion lhs - (Call name (Subst assum to c1)))) - :ruleset subst) - - -;; Tuple operators -(rule ((= lhs (Subst assum to (Single c1))) - (ExprIsResolved (Single c1))) - ((DelayedSubstUnion lhs - (Single (Subst assum to c1)))) - :ruleset subst) -(rule ((= lhs (Subst assum to (Concat c1 c2))) - (ExprIsResolved (Concat c1 c2))) - ((DelayedSubstUnion lhs - (Concat (Subst assum to c1) - (Subst assum to c2)))) - :ruleset subst) - -;; Control flow -(rule ((= lhs (Subst assum to inner)) - (= inner (Switch pred inputs c1)) - (ExprIsResolved inner)) - ((DelayedSubstUnion lhs - (Switch (Subst assum to pred) - (Subst assum to inputs) - c1))) - :ruleset subst) -(rule ((= lhs (Subst assum to inner)) - (= inner (If pred inputs c1 c2)) - (ExprIsResolved inner)) - ((DelayedSubstUnion lhs - (If (Subst assum to pred) - (Subst assum to inputs) - c1 - c2))) - :ruleset subst) -(rule ((= lhs (Subst assum to (DoWhile in out))) - (ExprIsResolved (DoWhile in out))) - ((DelayedSubstUnion lhs - (DoWhile (Subst assum to in) - out))) - :ruleset subst) - -;; substitute into function (convenience for testing) -(rewrite (Subst assum to (Function name inty outty body)) - (Function name inty outty (Subst assum to body)) - :when ((ExprIsResolved body)) - :ruleset subst) - - - -;; ########################### Apply subst unions - -(rule ((DelayedSubstUnion lhs rhs)) - ((union lhs rhs)) - :ruleset apply-subst-unions) - - -;; ########################### Cleanup subst and DelayedSubstUnion - -(rule ((DelayedSubstUnion lhs rhs)) - ((subsume (DelayedSubstUnion lhs rhs))) - :ruleset cleanup-subst) - -; this cleanup is important- if we don't subsume these substitutions, they -; may oberve their own results and create infinitely sized terms. -; ex: get(parallel!(arg(), int(2)), 0) ignores the first element of the tuple -; so it's equivalent to infinite other times with any other value as the first element of the tuple. -; Check ExprIsResolved to confirm that the substitution finished (all sub-substitutions are done). -(rule ((ExprIsResolved (Subst assum to in))) - ((subsume (Subst assum to in))) - :ruleset cleanup-subst) - -; We only have context for Exprs, not ListExprs. -(relation ContextOf (Expr Assumption)) - -(rule ((Arg ty ctx)) - ((ContextOf (Arg ty ctx) ctx)) - :ruleset always-run) -(rule ((Const c ty ctx)) - ((ContextOf (Const c ty ctx) ctx)) - :ruleset always-run) -(rule ((Empty ty ctx)) - ((ContextOf (Empty ty ctx) ctx)) - :ruleset always-run) - -; Error checking - each expr should only have a single context -(rule ((ContextOf x ctx1) - (ContextOf x ctx2) - (!= ctx1 ctx2)) - ( - (panic "Equivalent expressions have nonequivalent context, breaking the single context invariant.") - ) - :ruleset error-checking) - - -(rule ((Top op x y z) (ContextOf x ctx)) - ((ContextOf (Top op x y z) ctx)) :ruleset always-run) - -(rule ((Top op x y z) (ContextOf y ctx)) - ((ContextOf (Top op x y z) ctx)) :ruleset always-run) - -(rule ((Top op x y z) (ContextOf z ctx)) - ((ContextOf (Top op x y z) ctx)) :ruleset always-run) - -(rule ((Bop op x y) (ContextOf x ctx)) - ((ContextOf (Bop op x y) ctx)) :ruleset always-run) - -(rule ((Bop op x y) (ContextOf y ctx)) - ((ContextOf (Bop op x y) ctx)) :ruleset always-run) - -(rule ((Uop op x) (ContextOf x ctx)) - ((ContextOf (Uop op x) ctx)) :ruleset always-run) - -(rule ((Get tup i) (ContextOf tup ctx)) - ((ContextOf (Get tup i) ctx)) :ruleset always-run) - -(rule ((Concat x y) (ContextOf x ctx)) - ((ContextOf (Concat x y) ctx)) :ruleset always-run) - -(rule ((Concat x y) (ContextOf y ctx)) - ((ContextOf (Concat x y) ctx)) :ruleset always-run) - -(rule ((Single x) (ContextOf x ctx)) - ((ContextOf (Single x) ctx)) :ruleset always-run) - -(rule ((Switch pred inputs branches) (ContextOf pred ctx)) - ((ContextOf (Switch pred inputs branches) ctx)) :ruleset always-run) - -(rule ((If pred inputs then else) (ContextOf pred ctx)) - ((ContextOf (If pred inputs then else) ctx)) :ruleset always-run) - -(rule ((If pred inputs then else) (ContextOf inputs ctx)) - ((ContextOf (If pred inputs then else) ctx)) :ruleset always-run) - -(rule ((DoWhile in pred-and-output) (ContextOf in ctx)) - ((ContextOf (DoWhile in pred-and-output) ctx)) :ruleset always-run) - -(rule ((Call func arg) (ContextOf arg ctx)) - ((ContextOf (Call func arg) ctx)) :ruleset always-run) - -(rule ((Alloc amt e state ty) (ContextOf e ctx)) - ((ContextOf (Alloc amt e state ty) ctx)) :ruleset always-run) - -(rule ((Alloc amt e state ty) (ContextOf state ctx)) - ((ContextOf (Alloc amt e state ty) ctx)) :ruleset always-run) - -(ruleset canon) - -; Commutativity -(rewrite (Bop (Add) x y) (Bop (Add) y x) :ruleset canon) -(rewrite (Bop (Mul) x y) (Bop (Mul) y x) :ruleset canon) -(rewrite (Bop (Eq) x y) (Bop (Eq) y x) :ruleset canon) -(rewrite (Bop (And) x y) (Bop (And) y x) :ruleset canon) -(rewrite (Bop (Or) x y) (Bop (Or) y x) :ruleset canon) - -; Canonicalize to < -; x > y ==> y < x -(rewrite (Bop (GreaterThan) x y) (Bop (LessThan) y x) :ruleset canon) - -; x >= y ==> y < x + 1 -; x >= y ==> y - 1 < x -(rule ( - (= lhs (Bop (GreaterEq) x y)) - (HasArgType x ty) - (ContextOf lhs ctx) - ) - ( - (union lhs (Bop (LessThan) y (Bop (Add) x (Const (Int 1) ty ctx)))) - (union lhs (Bop (LessThan) (Bop (Sub) y (Const (Int 1) ty ctx)) x)) - ) - :ruleset canon) - -; x <= y ==> x < y + 1 -; x <= y ==> x - 1 < y -(rule ( - (= lhs (Bop (LessEq) x y)) - (HasArgType y ty) - (ContextOf lhs ctx) - ) - ( - (union lhs (Bop (LessThan) x (Bop (Add) y (Const (Int 1) ty ctx)))) - (union lhs (Bop (LessThan) (Bop (Sub) x (Const (Int 1) ty ctx)) y)) - ) - :ruleset canon) - - -; Make Concats right-deep -(rewrite (Concat (Concat a b) c) - (Concat a (Concat b c)) - :ruleset always-run) -; Simplify Concat's with empty -(rewrite (Concat (Empty ty ctx) x) - x - :ruleset always-run) -(rewrite (Concat x (Empty ty ctx)) - x - :ruleset always-run) - -; Make a tuple that is a sub-range of another tuple -; tuple start len -(function SubTuple (Expr i64 i64) Expr :unextractable) - -(rewrite (SubTuple expr x 0) - (Empty ty ctx) - :when ((HasArgType expr ty) (ContextOf expr ctx)) - :ruleset always-run) - -(rewrite (SubTuple expr x 1) - (Single (Get expr x)) - :ruleset always-run) - -(rewrite (SubTuple expr a b) - (Concat (Single (Get expr a)) (SubTuple expr (+ a 1) (- b 1))) - :when ((> b 1)) - :ruleset always-run) - -; Helper functions to remove one element from a tuple or type list -; tuple idx -(function TupleRemoveAt (Expr i64) Expr :unextractable) -(function TypeListRemoveAt (TypeList i64) TypeList :unextractable) - -(rewrite (TupleRemoveAt tuple idx) - (Concat (SubTuple tuple 0 idx) - (SubTuple tuple (+ idx 1) (- len (+ idx 1)))) - :when ((= len (tuple-length tuple))) - :ruleset always-run) - -(rewrite (TypeListRemoveAt (TNil) _idx) (TNil) :ruleset always-run) -(rewrite (TypeListRemoveAt (TCons x xs) 0 ) xs :ruleset always-run) -(rewrite (TypeListRemoveAt (TCons x xs) idx) - (TCons x (TypeListRemoveAt xs (- idx 1))) - :when ((> idx 0)) - :ruleset always-run) - -;; Compute the tree size of program, not dag size -(function Expr-size (Expr) i64 :unextractable :merge (min old new) ) -(function ListExpr-size (ListExpr) i64 :unextractable :merge (min old new)) - -(rule ((= expr (Function name tyin tyout out)) - (= sum (Expr-size out))) - ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) - -(rule ((= expr (Const n ty assum))) - ((set (Expr-size expr) 1)) :ruleset always-run) - -(rule ((= expr (Bop op x y)) - (= sum (+ (Expr-size y) (Expr-size x)))) - ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) - -(rule ((= expr (Uop op x)) - (= sum (Expr-size x))) - ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) - -(rule ((= expr (Get tup i)) - (= sum (Expr-size tup))) - ((set (Expr-size expr) sum)) :ruleset always-run) - -(rule ((= expr (Concat x y)) - (= sum (+ (Expr-size y) (Expr-size x)))) - ((set (Expr-size expr) sum)) :ruleset always-run) - -(rule ((= expr (Single x)) - (= sum (Expr-size x))) - ((set (Expr-size expr) sum)) :ruleset always-run) - -(rule ((= expr (Switch pred inputs branches)) - (= sum (+ (Expr-size inputs) (+ (ListExpr-size branches) (Expr-size pred))))) - ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) - -(rule ((= expr (If pred inputs then else)) - (= sum (+ (Expr-size inputs) (+ (Expr-size else) (+ (Expr-size then) (Expr-size pred)))))) - ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) - -(rule ((= expr (DoWhile in pred-and-output)) - (= sum (+ (Expr-size pred-and-output) (Expr-size in)))) - ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) - -(rule ((= expr (Arg ty assum))) - ((set (Expr-size expr) 1)) :ruleset always-run) - -(rule ((= expr (Call func arg)) - (= sum (Expr-size arg))) - ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) - -(rule ((Empty ty assum)) ((set (Expr-size (Empty ty assum)) 0)) :ruleset always-run) - -(rule ((= expr (Cons hd tl)) - (= sum (+ (ListExpr-size tl) (Expr-size hd)))) - ((set (ListExpr-size expr) sum)) :ruleset always-run) - -(rule ((Nil)) - ((set (ListExpr-size (Nil)) 0)) :ruleset always-run) - -(rule ((= expr (Alloc id e state ty)) ;; do state edge's expr should be counted? - (= sum (Expr-size e))) - ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) -;; Like Subst but for dropping inputs to a region -;; See subst.egg for more implementation documentation - -(ruleset drop) -(ruleset apply-drop-unions) -(ruleset cleanup-drop) - -;; (DropAt ctx idx in) removes all references to `(Get (Arg ...) idx)` in `in`. -;; It also replaces the leaf contexts with `ctx` and fixes up argument types, -;; as well as updating `(Get (Arg ...) j)` to `(Get (Arg ...) (- j 1))` for j > idx. -(function DropAt (Assumption i64 Expr) Expr :unextractable) -(function DelayedDropUnion (Expr Expr) Expr :unextractable) - -;; Helper that precomputes the arg type that we need -(function DropAtInternal (Type Assumption i64 Expr) Expr :unextractable) -(rule ((= lhs (DropAt ctx idx in)) - (HasArgType in (TupleT oldty))) - - ((let newty (TupleT (TypeListRemoveAt oldty idx))) - (union lhs (DropAtInternal newty ctx idx in))) - :ruleset drop) - -;; Leaves -(rule ((= lhs (DropAtInternal newty newctx idx (Const c oldty oldctx)))) - ((DelayedDropUnion lhs (Const c newty newctx))) - :ruleset drop) -(rule ((= lhs (DropAtInternal newty newctx idx (Empty oldty oldctx)))) - ((DelayedDropUnion lhs (Empty newty newctx))) - :ruleset drop) -; get stuck on purpose if `i = idx` or if we find a bare `Arg` -(rule ((= lhs (DropAtInternal newty newctx idx (Get (Arg oldty oldctx) i))) - (< i idx)) - ((DelayedDropUnion lhs (Get (Arg newty newctx) i))) - :ruleset drop) -(rule ((= lhs (DropAtInternal newty newctx idx (Get (Arg oldty oldctx) i))) - (> i idx)) - ((DelayedDropUnion lhs (Get (Arg newty newctx) (- i 1)))) - :ruleset drop) - -;; Operators -(rule ((= lhs (DropAtInternal newty newctx idx (Bop op c1 c2))) - (ExprIsResolved (Bop op c1 c2))) - ((DelayedDropUnion lhs (Bop op - (DropAtInternal newty newctx idx c1) - (DropAtInternal newty newctx idx c2)))) - :ruleset drop) - -(rule ((= lhs (DropAtInternal newty newctx idx (Uop op c1))) - (ExprIsResolved (Uop op c1))) - ((DelayedDropUnion lhs (Uop op - (DropAtInternal newty newctx idx c1)))) - :ruleset drop) - -;; this is okay because we get stuck at `Arg`s -(rule ((= lhs (DropAtInternal newty newctx idx (Get c1 index))) - (ExprIsResolved (Get c1 index))) - ((DelayedDropUnion lhs (Get - (DropAtInternal newty newctx idx c1) - index))) - :ruleset drop) - -(rule ((= lhs (DropAtInternal newty newctx idx (Alloc id c1 c2 ty))) - (ExprIsResolved (Alloc id c1 c2 ty))) - ((DelayedDropUnion lhs (Alloc id - (DropAtInternal newty newctx idx c1) - (DropAtInternal newty newctx idx c2) - ty))) - :ruleset drop) - -(rule ((= lhs (DropAtInternal newty newctx idx (Call name c1))) - (ExprIsResolved (Call name c1))) - ((DelayedDropUnion lhs (Call name - (DropAtInternal newty newctx idx c1)))) - :ruleset drop) - -;; Tuple operators -(rule ((= lhs (DropAtInternal newty newctx idx (Single c1))) - (ExprIsResolved (Single c1))) - ((DelayedDropUnion lhs (Single - (DropAtInternal newty newctx idx c1)))) - :ruleset drop) - -(rule ((= lhs (DropAtInternal newty newctx idx (Concat c1 c2))) - (ExprIsResolved (Concat c1 c2))) - ((DelayedDropUnion lhs (Concat - (DropAtInternal newty newctx idx c1) - (DropAtInternal newty newctx idx c2)))) - :ruleset drop) - -;; Control flow -(rule ((= lhs (DropAtInternal newty newctx idx (Switch pred inputs c1))) - (ExprIsResolved (Switch pred inputs c1))) - ((DelayedDropUnion lhs (Switch - (DropAtInternal newty newctx idx pred) - (DropAtInternal newty newctx idx inputs) - c1))) - :ruleset drop) - -(rule ((= lhs (DropAtInternal newty newctx idx (If pred inputs c1 c2))) - (ExprIsResolved (If pred inputs c1 c2))) - ((DelayedDropUnion lhs (If - (DropAtInternal newty newctx idx pred) - (DropAtInternal newty newctx idx inputs) - c1 - c2))) - :ruleset drop) - -(rule ((= lhs (DropAtInternal newty newctx idx (DoWhile in out))) - (ExprIsResolved (DoWhile in out))) - ((DelayedDropUnion lhs (DoWhile - (DropAtInternal newty newctx idx in) - out))) - :ruleset drop) - -(rewrite (DropAtInternal newty newctx idx (Function name inty outty body)) - (Function name inty outty (DropAtInternal newty newctx idx body)) - :when ((ExprIsResolved body)) - :ruleset drop) - - - -;; ########################### Apply drop unions - -(rule ((DelayedDropUnion lhs rhs)) - ((union lhs rhs)) - :ruleset apply-drop-unions) - -;; ########################### Cleanup Dropat, DropAtInternal and DelayedDropUnion - -(rule ((ExprIsResolved (DropAt newctx idx in))) - ((subsume (DropAt newctx idx in))) - :ruleset cleanup-drop) - -(rule ((ExprIsResolved (DropAtInternal newty newctx idx in))) - ((subsume (DropAtInternal newty newctx idx in))) - :ruleset cleanup-drop) - -(rule ((DelayedDropUnion lhs rhs)) - ((subsume (DelayedDropUnion lhs rhs))) - :ruleset cleanup-drop) - -(ruleset interval-analysis) - -(datatype Bound - (IntB i64) - (BoolB bool) - (bound-max Bound Bound) - (bound-min Bound Bound)) - -; bound tables -(function lo-bound (Expr) Bound :unextractable :merge (bound-max old new)) -(function hi-bound (Expr) Bound :unextractable :merge (bound-min old new)) - -; if lo > hi, panic -; We can't run these rules because unreachable branches may have impossible intervals -; Consider re-enabling these rules if we implement an is-reachable analysis -; (rule ( -; (= (IntB lo) (lo-bound expr)) -; (= (IntB hi) (hi-bound expr)) -; (> lo hi) -; ) -; ((panic "lo bound greater than hi bound")) -; :ruleset interval-analysis) -; (rule ( -; (= (BoolB true) (lo-bound expr)) -; (= (BoolB false) (hi-bound expr)) -; ) -; ((panic "lo bound greater than hi bound")) -; :ruleset interval-analysis) - -; combinators -(rewrite (bound-max (IntB x) (IntB y)) - (IntB (max x y)) - :ruleset interval-analysis) -(rewrite (bound-min (IntB x) (IntB y)) - (IntB (min x y)) - :ruleset interval-analysis) -(rewrite (bound-max (BoolB x) (BoolB y)) - (BoolB (or x y)) - :ruleset interval-analysis) -(rewrite (bound-min (BoolB x) (BoolB y)) - (BoolB (and x y)) - :ruleset interval-analysis) - -; ================================= -; Constants -; ================================= -(rule ((= lhs (Const (Int x) ty ctx))) - ( - (set (lo-bound lhs) (IntB x)) - (set (hi-bound lhs) (IntB x)) - ) - :ruleset interval-analysis) - -(rule ((= lhs (Const (Bool x) ty ctx))) - ( - (set (lo-bound lhs) (BoolB x)) - (set (hi-bound lhs) (BoolB x)) - ) - :ruleset interval-analysis) - -; ================================= -; Constant Folding -; ================================= -(rule ( - (= (IntB x) (lo-bound expr)) - (= (IntB x) (hi-bound expr)) - (HasArgType expr ty) - (ContextOf expr ctx) - ) - ((union expr (Const (Int x) ty ctx))) - :ruleset interval-analysis) - -(rule ( - (= (BoolB x) (lo-bound expr)) - (= (BoolB x) (hi-bound expr)) - (HasArgType expr ty) - (ContextOf expr ctx) - ) - ((union expr (Const (Bool x) ty ctx))) - :ruleset interval-analysis) - -; lower bound being true means the bool must be true -(rule ( - (= (BoolB true) (lo-bound expr)) - (HasArgType expr ty) - (ContextOf expr ctx) - ) - ((union expr (Const (Bool true) ty ctx))) - :ruleset interval-analysis) - -; upper bound being false means the bool must be false -(rule ( - (= (BoolB false) (hi-bound expr)) - (HasArgType expr ty) - (ContextOf expr ctx) - ) - ((union expr (Const (Bool false) ty ctx))) - :ruleset interval-analysis) - -; ================================= -; Arithmetic -; ================================= -; + a b interval is (+ la lb) (+ ha hb) -(rule ( - (= lhs (Bop (Add) a b)) - (= (IntB la) (lo-bound a)) - (= (IntB lb) (lo-bound b)) - ) - ((set (lo-bound lhs) (IntB (+ la lb)))) - :ruleset interval-analysis) -(rule ( - (= lhs (Bop (Add) a b)) - (= (IntB ha) (hi-bound a)) - (= (IntB hb) (hi-bound b)) - ) - ((set (hi-bound lhs) (IntB (+ ha hb)))) - :ruleset interval-analysis) - -; - a b interval is (- la hb) (- ha lb) -(rule ( - (= lhs (Bop (Sub) a b)) - (= (IntB la) (lo-bound a)) - (= (IntB hb) (hi-bound b)) - ) - ((set (lo-bound lhs) (IntB (- la hb)))) - :ruleset interval-analysis) -(rule ( - (= lhs (Bop (Sub) a b)) - (= (IntB ha) (hi-bound a)) - (= (IntB lb) (lo-bound b)) - ) - ((set (hi-bound lhs) (IntB (- ha lb)))) - :ruleset interval-analysis) - -; Multiplication for two constants -; TODO: Make fancier interval analysis -(rule ( - (= lhs (Bop (Mul) a b)) - (= (IntB x) (lo-bound a)) - (= (IntB x) (hi-bound a)) - (= (IntB y) (lo-bound b)) - (= (IntB y) (hi-bound b)) - ) - ( - (set (lo-bound lhs) (IntB (* x y))) - (set (hi-bound lhs) (IntB (* x y))) - ) - :ruleset interval-analysis) - -; negative * negative is positive -(rule ( - (= lhs (Bop (Mul) x y)) - (= (IntB hi-x) (hi-bound x)) - (= (IntB hi-y) (hi-bound y)) - (<= hi-x 0) - (<= hi-y 0) - ) - ((set (lo-bound lhs) (IntB 0))) - :ruleset interval-analysis) - -; negative * positive is negative -(rule ( - (= lhs (Bop (Mul) x y)) - (= (IntB hi-x) (hi-bound x)) - (= (IntB lo-y) (lo-bound y)) - (<= hi-x 0) ; x <= 0 (x is negative) - (>= lo-y 0) ; y >= 0 (y is positive) - ) - ((set (hi-bound lhs) (IntB 0))) - :ruleset interval-analysis) - -; positive * positive is positive -(rule ( - (= lhs (Bop (Mul) x y)) - (= (IntB lo-x) (lo-bound x)) - (= (IntB lo-y) (lo-bound y)) - (>= lo-x 0) - (>= lo-y 0) - ) - ((set (lo-bound lhs) (IntB 0))) - :ruleset interval-analysis) - -; < a b interval is (< ha lb) (< la hb) -(rule ( - (= lhs (Bop (LessThan) a b)) - (= (IntB ha) (hi-bound a)) - (= (IntB lb) (lo-bound b)) - ) - ( - (set (lo-bound lhs) (BoolB (bool-< ha lb))) - ) - :ruleset interval-analysis) -(rule ( - (= lhs (Bop (LessThan) a b)) - (= (IntB la) (lo-bound a)) - (= (IntB hb) (hi-bound b)) - ) - ((set (hi-bound lhs) (BoolB (bool-< la hb)))) - :ruleset interval-analysis) - -; ================================= -; Conditionals -; ================================= -; if the predicate is true, merge with then branch -(rule ( - (= lhs (If cond inputs thn els)) - (ContextOf lhs if_ctx) - (= (BoolB true) (lo-bound cond)) - ) - ((union lhs (Subst if_ctx inputs thn))) - :ruleset interval-analysis) - -; if the predicate is false, merge with else branch -(rule ( - (= lhs (If cond inputs thn els)) - (ContextOf lhs if_ctx) - (= (BoolB false) (hi-bound cond)) - ) - ((union lhs (Subst if_ctx inputs els))) - :ruleset interval-analysis) - -; lo-bound of If is the min of the lower bounds -; hi-bound of If is the max of the upper bounds -(rule ( - (= lhs (If cond inputs thn els)) - (= lo-thn (lo-bound thn)) - (= lo-els (lo-bound els)) - ) - ((set (lo-bound lhs) (bound-min lo-thn lo-els))) - :ruleset interval-analysis) -(rule ( - (= lhs (If cond inputs thn els)) - (= hi-thn (hi-bound thn)) - (= hi-els (hi-bound els)) - ) - ((set (hi-bound lhs) (bound-max hi-thn hi-els))) - :ruleset interval-analysis) - -; Same rules, but for Ifs that have multiple outputs -(rule ( - (= lhs (Get (If pred inputs thn els) i)) - (= lo-thn (lo-bound (Get thn i))) - (= lo-els (lo-bound (Get els i))) - ) - ((set (lo-bound lhs) (bound-min lo-thn lo-els))) - :ruleset interval-analysis) -(rule ( - (= lhs (Get (If cond inputs thn els) i)) - (= hi-thn (hi-bound (Get thn i))) - (= hi-els (hi-bound (Get els i))) - ) - ((set (hi-bound lhs) (bound-max hi-thn hi-els))) - :ruleset interval-analysis) - -; If the If takes a tuple -(rule ( - ; expr < value - (= pred (Bop (LessThan) expr value)) - (= if_e (If pred inputs then else)) - ; the left operand of the < is an input to the if region - (= expr (Get inputs i)) - ; the right operand of the < has an upper bound - (= (IntB v) (hi-bound value)) - ; context node inside the if region - (= ctx (Arg ty (InIf true pred inputs))) - (HasType inputs ty) - ) - ; expr < value was true, so we know expr is at most (hi-bound value) - 1 - ((set (hi-bound (Get ctx i)) (IntB (- v 1)))) - :ruleset interval-analysis) -(rule ( - ; expr < value - (= pred (Bop (LessThan) expr value)) - (= if_e (If pred inputs then else)) - ; the left operand of the < is an input to the if region - (= expr (Get inputs i)) - ; the right operand of the < has a lower bound - (= (IntB v) (lo-bound value)) - ; context node inside the if region - (= ctx (Arg ty (InIf false pred inputs))) - (HasType inputs ty) - ) - ; expr < value was false, so we know expr is at least (lo-bound value) - ((set (lo-bound (Get ctx i)) (IntB v))) - :ruleset interval-analysis) - -(rule ( - ; value < expr - (= pred (Bop (LessThan) value expr)) - (= if_e (If pred inputs then else)) - ; the right operand of the < is an input to the if region - (= expr (Get inputs i)) - ; the left operand of the < has a lower bound - (= (IntB v) (lo-bound value)) - ; context node inside the if region - (= ctx (Arg ty (InIf true pred inputs))) - (HasType inputs ty) - ) - ; value < expr was true, so we know expr is at least (lo-bound value) + 1 - ((set (lo-bound (Get ctx i)) (IntB (+ v 1)))) - :ruleset interval-analysis) -(rule ( - ; value < expr - (= pred (Bop (LessThan) value expr)) - (= if_e (If pred inputs then else)) - ; the right operand of the < is an input to the if region - (= expr (Get inputs i)) - ; the left operand of the < has an upper bound - (= (IntB v) (hi-bound value)) - ; context node inside the if region - (= ctx (Arg ty (InIf false pred inputs))) - (HasType inputs ty) - ) - ; value < expr was false, so we know expr is at most (hi-bound value) - ((set (hi-bound (Get ctx i)) (IntB v))) - :ruleset interval-analysis) - -;; Push intervals for inputs into if region -(rule ( - (= if (If pred inputs then_ else_)) - (= ctx (Arg ty (InIf b pred inputs))) - (HasType inputs ty) - (= lo (lo-bound (Get inputs i))) - - ) - ((set (lo-bound (Get ctx i)) lo)) - :ruleset interval-analysis) -(rule ( - (= if (If pred inputs then_ else_)) - (= ctx (Arg ty (InIf b pred inputs))) - (HasType inputs ty) - (= hi (hi-bound (Get inputs i))) - - ) - ((set (hi-bound (Get ctx i)) hi)) - :ruleset interval-analysis) - -; (if (a == b) thn els) -; in the thn branch, we know that a has the same bounds as b -(rule ( - (= pred (Bop (Eq) expr val)) - (= if_e (If pred inputs thn els)) - ; the left operand of the == is an input to the if region - (= expr (Get inputs i)) - (= ctx (Arg ty (InIf true pred inputs))) - (HasType inputs ty) - (= (IntB lo) (lo-bound val)) - ) - ((set (lo-bound (Get ctx i)) (IntB lo))) - :ruleset interval-analysis) -(rule ( - (= pred (Bop (Eq) expr val)) - (= if_e (If pred inputs thn els)) - ; the left operand of the == is an input to the if region - (= expr (Get inputs i)) - (= ctx (Arg ty (InIf true pred inputs))) - (HasType inputs ty) - (= (IntB hi) (hi-bound val)) - ) - ((set (hi-bound (Get ctx i)) (IntB hi))) - :ruleset interval-analysis) - - -(rule ( - ;; argument has loop context - (Arg ty (InLoop inputs outputs)) - ;; in the loop, the argument is passed through - ;; note that some_ctx is not the same as (InLoop inputs outputs) - (= (Get (Arg ty some_ctx) ith) (Get outputs (+ 1 ith))) - ;; input has some bound - (= bound (lo-bound (Get inputs ith))) - ) - ( - (set (lo-bound (Get (Arg ty (InLoop inputs outputs)) ith)) bound) - ) - :ruleset interval-analysis) -(rule ( - ;; argument has loop context - (Arg ty (InLoop inputs outputs)) - ;; in the loop, the argument is passed through - (= (Get (Arg ty some_ctx) ith) (Get outputs (+ 1 ith))) - ;; input has some bound - (= bound (hi-bound (Get inputs ith))) - ) - ( - (set (hi-bound (Get (Arg ty (InLoop inputs outputs)) ith)) bound) - ) - :ruleset interval-analysis) - - -(ruleset switch_rewrite) - -; if (a and b) X Y ~~> if a (if b X Y) Y -(rule ((= lhs (If (Bop (And) a b) ins X Y)) - (HasType ins (TupleT ins_ty)) - (= len (tuple-length ins))) - - ((let outer_ins (Concat (Single b) ins)) - (let outer_ins_ty (TupleT (TCons (BoolT) ins_ty))) - - (let inner_pred (Get (Arg outer_ins_ty (InIf true a outer_ins)) 0)) - (let sub_arg_true (SubTuple (Arg outer_ins_ty (InIf true a outer_ins)) 1 len)) - (let sub_arg_false (SubTuple (Arg outer_ins_ty (InIf false a outer_ins)) 1 len)) - - (let inner_X (AddContext (InIf true inner_pred sub_arg_true) X)) - (let inner_Y (AddContext (InIf false inner_pred sub_arg_true) Y)) - (let outer_Y (Subst (InIf false a outer_ins) sub_arg_false Y)) - - (let inner (If inner_pred sub_arg_true inner_X inner_Y)) - (union lhs (If a outer_ins inner outer_Y))) - - :ruleset switch_rewrite) - -; if (a or b) X Y ~~> if a X (if b X Y) -(rule ((= lhs (If (Bop (Or) a b) ins X Y)) - (HasType ins (TupleT ins_ty)) - (= len (tuple-length ins))) - - ((let outer_ins (Concat (Single b) ins)) - (let outer_ins_ty (TupleT (TCons (BoolT) ins_ty))) - - (let inner_pred (Get (Arg outer_ins_ty (InIf false a outer_ins)) 0)) - (let sub_arg_true (SubTuple (Arg outer_ins_ty (InIf true a outer_ins)) 1 len)) - (let sub_arg_false (SubTuple (Arg outer_ins_ty (InIf false a outer_ins)) 1 len)) - - (let outer_X (Subst (InIf true a outer_ins) sub_arg_true X)) - (let inner_X (AddContext (InIf true inner_pred sub_arg_false) X)) - (let inner_Y (AddContext (InIf false inner_pred sub_arg_false) Y)) - - (let inner (If inner_pred sub_arg_false inner_X inner_Y)) - (union lhs (If a outer_ins outer_X inner ))) - - :ruleset switch_rewrite) - -(rewrite (If (Const (Bool true) ty ctx) ins thn els) - (Subst ctx ins thn) - :ruleset always-run) - -(rewrite (If (Const (Bool false) ty ctx) ins thn els) - (Subst ctx ins els) - :ruleset switch_rewrite) - -(rule ((= lhs (If pred ins thn els)) - (= (Get thn i) (Const (Bool true) ty ctx1)) - (= (Get els i) (Const (Bool false) ty ctx2))) - ((union (Get lhs i) pred)) :ruleset switch_rewrite) - -(rule ((= lhs (If pred ins thn els)) - (= (Get thn i) (Const (Bool false) ty ctx1)) - (= (Get els i) (Const (Bool true) ty ctx2))) - ((union (Get lhs i) (Uop (Not) pred))) :ruleset switch_rewrite) - -; Simple rewrites that don't do a ton with control flow. - -(ruleset peepholes) - -(rewrite (Bop (Mul) (Const (Int 0) ty ctx) e) (Const (Int 0) ty ctx) :ruleset peepholes) -(rewrite (Bop (Mul) e (Const (Int 0) ty ctx)) (Const (Int 0) ty ctx) :ruleset peepholes) -(rewrite (Bop (Mul) (Const (Int 1) ty ctx) e) e :ruleset peepholes) -(rewrite (Bop (Mul) e (Const (Int 1) ty ctx)) e :ruleset peepholes) -(rewrite (Bop (Add) (Const (Int 0) ty ctx) e) e :ruleset peepholes) -(rewrite (Bop (Add) e (Const (Int 0) ty ctx) ) e :ruleset peepholes) - -(rewrite (Bop (Mul) (Const (Int j) ty ctx) (Const (Int i) ty ctx)) (Const (Int (* i j)) ty ctx) :ruleset peepholes) -(rewrite (Bop (Add) (Const (Int j) ty ctx) (Const (Int i) ty ctx)) (Const (Int (+ i j)) ty ctx) :ruleset peepholes) - -(rewrite (Bop (And) (Const (Bool true) ty ctx) e) e :ruleset peepholes) -(rewrite (Bop (And) e (Const (Bool true) ty ctx)) e :ruleset peepholes) -(rewrite (Bop (And) (Const (Bool false) ty ctx) e) (Const (Bool false) ty ctx) :ruleset peepholes) -(rewrite (Bop (And) e (Const (Bool false) ty ctx)) (Const (Bool false) ty ctx) :ruleset peepholes) -(rewrite (Bop (Or) (Const (Bool false) ty ctx) e) e :ruleset peepholes) -(rewrite (Bop (Or) e (Const (Bool false) ty ctx)) e :ruleset peepholes) -(rewrite (Bop (Or) (Const (Bool true) ty ctx) e) (Const (Bool true) ty ctx) :ruleset peepholes) -(rewrite (Bop (Or) e (Const (Bool true) ty ctx)) (Const (Bool true) ty ctx) :ruleset peepholes) - - -(datatype IntOrInfinity - (Infinity) - (NegInfinity) - (I i64)) - -(function MaxIntOrInfinity (IntOrInfinity IntOrInfinity) IntOrInfinity) -(rewrite (MaxIntOrInfinity (Infinity) _) (Infinity) :ruleset always-run) -(rewrite (MaxIntOrInfinity _ (Infinity)) (Infinity) :ruleset always-run) -(rewrite (MaxIntOrInfinity (NegInfinity) x) x :ruleset always-run) -(rewrite (MaxIntOrInfinity x (NegInfinity)) x :ruleset always-run) -(rewrite (MaxIntOrInfinity (I x) (I y)) (I (max x y)) :ruleset always-run) - -(function MinIntOrInfinity (IntOrInfinity IntOrInfinity) IntOrInfinity) -(rewrite (MinIntOrInfinity (NegInfinity) _) (NegInfinity) :ruleset always-run) -(rewrite (MinIntOrInfinity _ (NegInfinity)) (NegInfinity) :ruleset always-run) -(rewrite (MinIntOrInfinity (Infinity) x) x :ruleset always-run) -(rewrite (MinIntOrInfinity x (Infinity)) x :ruleset always-run) -(rewrite (MinIntOrInfinity (I x) (I y)) (I (min x y)) :ruleset always-run) - -(function AddIntOrInfinity (IntOrInfinity IntOrInfinity) IntOrInfinity) -(rewrite (AddIntOrInfinity (Infinity) (Infinity)) (Infinity) :ruleset always-run) -(rewrite (AddIntOrInfinity (Infinity) (I _)) (Infinity) :ruleset always-run) -(rewrite (AddIntOrInfinity (I _) (Infinity)) (Infinity) :ruleset always-run) -(rewrite (AddIntOrInfinity (NegInfinity) (NegInfinity)) (NegInfinity) :ruleset always-run) -(rewrite (AddIntOrInfinity (NegInfinity) (I _)) (NegInfinity) :ruleset always-run) -(rewrite (AddIntOrInfinity (I _) (NegInfinity)) (NegInfinity) :ruleset always-run) -(rewrite (AddIntOrInfinity (I x) (I y)) (I (+ x y)) :ruleset always-run) - -(datatype IntInterval (MkIntInterval IntOrInfinity IntOrInfinity)) - -(function UnionIntInterval (IntInterval IntInterval) IntInterval) -(rewrite (UnionIntInterval (MkIntInterval lo1 hi1) (MkIntInterval lo2 hi2)) - (MkIntInterval (MinIntOrInfinity lo1 lo2) (MaxIntOrInfinity hi1 hi2)) - :ruleset always-run) - -(function IntersectIntInterval (IntInterval IntInterval) IntInterval) -(rewrite (IntersectIntInterval (MkIntInterval lo1 hi1) (MkIntInterval lo2 hi2)) - (MkIntInterval (MaxIntOrInfinity lo1 lo2) (MinIntOrInfinity hi1 hi2)) - :ruleset always-run) - -(function AddIntInterval (IntInterval IntInterval) IntInterval) -(rewrite (AddIntInterval (MkIntInterval lo1 hi1) (MkIntInterval lo2 hi2)) - (MkIntInterval (AddIntOrInfinity lo1 lo2) - (AddIntOrInfinity hi1 hi2)) - :ruleset always-run) - - -(datatype List - (Nil-List) - (Cons-List i64 IntInterval List)) - -(function Length-List (List) i64) -(rule ((= x (Nil-List))) - ((set (Length-List x) 0)) - :ruleset always-run) -(rule ((= x (Cons-List hd0 hd1 tl)) - (= l (Length-List tl))) - ((set (Length-List x) (+ l 1))) - :ruleset always-run) -(rule ((= x (Nil-List))) - ((set (Length-List x) 0)) - :ruleset memory-helpers) -(rule ((= x (Cons-List hd0 hd1 tl)) - (= l (Length-List tl))) - ((set (Length-List x) (+ l 1))) - :ruleset memory-helpers) - -(relation IsEmpty-List (List)) -(rule ((= x (Nil-List))) - ((IsEmpty-List x)) - :ruleset always-run) - -(relation IsNonEmpty-List (List)) -(rule ((= x (Cons-List hd0 hd1 tl))) - ((IsNonEmpty-List x)) - :ruleset always-run) - -(function RevConcat-List (List List) List :cost 1000) -(rewrite (RevConcat-List (Nil-List) l) - l - :ruleset always-run) -(rewrite (RevConcat-List (Cons-List hd0 hd1 tl) l) - (RevConcat-List tl (Cons-List hd0 hd1 l)) - :ruleset always-run) - -(function Rev-List (List) List :cost 1000) -(rewrite (Rev-List m) - (RevConcat-List m (Nil-List)) - :ruleset always-run) - -(function Concat-List (List List) List :cost 1000) -(rewrite (Concat-List x y) - (RevConcat-List (Rev-List x) y) - :ruleset always-run) - -; SuffixAt and At must be demanded, otherwise these are O(N^2) -(relation DemandAt-List (List)) -(relation SuffixAt-List (List i64 List)) -(relation At-List (List i64 i64 IntInterval)) -(rule ((DemandAt-List x)) - ((SuffixAt-List x 0 x)) - :ruleset always-run) -(rule ((SuffixAt-List x i (Cons-List hd0 hd1 tl))) - ((SuffixAt-List x (+ i 1) tl) - (At-List x i hd0 hd1)) - :ruleset always-run) - -(function Union-List (List List) List) - ; The third argument of the helper is a WIP result map. - ; Invariant: keys of the result map are not present in the first two and are in descending order - (function UnionHelper-List (List List List) List) - (rewrite (Union-List m1 m2) - (Rev-List (UnionHelper-List m1 m2 (Nil-List))) - :ruleset always-run) - - ; both m1 and m2 empty - (rewrite (UnionHelper-List (Nil-List) (Nil-List) res) - res - :ruleset always-run) - ; take from m1 when m2 empty and vice versa - (rewrite - (UnionHelper-List - (Nil-List) - (Cons-List hd0 hd1 tl) - res) - (UnionHelper-List - (Nil-List) - tl - (Cons-List hd0 hd1 res)) - :ruleset always-run) - (rewrite - (UnionHelper-List - (Cons-List hd0 hd1 tl) - (Nil-List) - res) - (UnionHelper-List - tl - (Nil-List) - (Cons-List hd0 hd1 res)) - :ruleset always-run) - - ; when both nonempty and smallest key different, take smaller key - (rule ((= f (UnionHelper-List l1 l2 res)) - (= l1 (Cons-List k1 a1 tl1)) - (= l2 (Cons-List k2 b1 tl2)) - (< k1 k2)) - ((union f - (UnionHelper-List tl1 l2 (Cons-List k1 a1 res)))) - :ruleset always-run) - (rule ((= f (UnionHelper-List l1 l2 res)) - (= l1 (Cons-List k1 a1 tl1)) - (= l2 (Cons-List k2 b1 tl2)) - (< k2 k1)) - ((union f - (UnionHelper-List l1 tl2 (Cons-List k2 b1 res)))) - :ruleset always-run) - - ; when shared smallest key, union interval - (rule ((= f (UnionHelper-List l1 l2 res)) - (= l1 (Cons-List k a1 tl1)) - (= l2 (Cons-List k b1 tl2))) - ((union f - (UnionHelper-List tl1 tl2 - (Cons-List k (UnionIntInterval a1 b1) res)))) - :ruleset always-run) - -(function Intersect-List (List List) List) - ; The third argument of the helper is a WIP result map. - ; Invariant: keys of the result map are not present in the first two and are in descending order - (function IntersectHelper-List (List List List) List) - (rewrite (Intersect-List m1 m2) - (Rev-List (IntersectHelper-List m1 m2 (Nil-List))) - :ruleset always-run) - - ; m1 or m2 empty - (rewrite (IntersectHelper-List (Nil-List) m2 res) - res - :ruleset always-run) - (rewrite (IntersectHelper-List m1 (Nil-List) res) - res - :ruleset always-run) - - ; when both nonempty and smallest key different, drop smaller key - (rule ((= f (IntersectHelper-List l1 l2 res)) - (= l1 (Cons-List k1 a1 tl1)) - (= l2 (Cons-List k2 b1 tl2)) - (< k1 k2)) - ((union f (IntersectHelper-List tl1 l2 res))) - :ruleset always-run) - (rule ((= f (IntersectHelper-List l1 l2 res)) - (= l1 (Cons-List k1 a1 tl1)) - (= l2 (Cons-List k2 b1 tl2)) - (< k2 k1)) - ((union f (IntersectHelper-List tl1 l2 res))) - :ruleset always-run) - -(datatype MyBool (MyTrue) (MyFalse)) - -(function IntIntervalValid (IntInterval) MyBool) -(rewrite (IntIntervalValid (MkIntInterval (I lo) (I hi))) - (MyTrue) - :when ((<= lo hi)) - :ruleset always-run) -(rewrite (IntIntervalValid (MkIntInterval (I lo) (I hi))) - (MyFalse) - :when ((> lo hi)) - :ruleset always-run) -(rewrite (IntIntervalValid (MkIntInterval (NegInfinity) _)) - (MyTrue) - :ruleset always-run) -(rewrite (IntIntervalValid (MkIntInterval _ (Infinity))) - (MyTrue) - :ruleset always-run) - -(function ConsIfNonEmpty (i64 IntInterval List) - List - :cost 100) -(rule ((ConsIfNonEmpty k v tl)) - ((IntIntervalValid v)) - :ruleset always-run) -(rule ((= f (ConsIfNonEmpty k v tl)) - (= (MyTrue) (IntIntervalValid v))) - ((union f (Cons-List k v tl))) - :ruleset always-run) -(rule ((= f (ConsIfNonEmpty k v tl)) - (= (MyFalse) (IntIntervalValid v))) - ((union f tl)) - :ruleset always-run) - - ; when shared smallest key, intersect interval - (rule ((= f (IntersectHelper-List l1 l2 res)) - (= l1 (Cons-List k a1 tl1)) - (= l2 (Cons-List k b1 tl2))) - ((union f - (IntersectHelper-List tl1 tl2 - (ConsIfNonEmpty k (IntersectIntInterval a1 b1) res)))) - :ruleset always-run) - -(function AddIntIntervalToAll (IntInterval List) - List) -(rewrite (AddIntIntervalToAll _ (Nil-List)) - (Nil-List) - :ruleset always-run) -(rewrite (AddIntIntervalToAll x (Cons-List allocid offset tl)) - (Cons-List allocid (AddIntInterval x offset) - (AddIntIntervalToAll x tl)) - :ruleset always-run) - -(datatype PtrPointees - (PointsTo List) - (PointsAnywhere)) - -(function AddIntIntervalToPtrPointees (IntInterval PtrPointees) PtrPointees) -(rewrite (AddIntIntervalToPtrPointees interval (PointsAnywhere)) - (PointsAnywhere) - :ruleset always-run) -(rewrite (AddIntIntervalToPtrPointees interval (PointsTo l)) - (PointsTo (AddIntIntervalToAll interval l)) - :ruleset always-run) - -(function Union-PtrPointees (PtrPointees PtrPointees) PtrPointees) -(rewrite (Union-PtrPointees (PointsAnywhere) _) - (PointsAnywhere) - :ruleset always-run) -(rewrite (Union-PtrPointees _ (PointsAnywhere)) - (PointsAnywhere) - :ruleset always-run) -(rewrite (Union-PtrPointees (PointsTo x) (PointsTo y)) - (PointsTo (Union-List x y)) - :ruleset always-run) -(function Intersect-PtrPointees (PtrPointees PtrPointees) PtrPointees) -(rewrite (Intersect-PtrPointees (PointsAnywhere) x) - x - :ruleset always-run) -(rewrite (Intersect-PtrPointees x (PointsAnywhere)) - x - :ruleset always-run) -(rewrite (Intersect-PtrPointees (PointsTo x) (PointsTo y)) - (PointsTo (Intersect-List x y)) - :ruleset always-run) - -(relation PointsNowhere-PtrPointees (PtrPointees)) -(rule ((= f (PointsTo x)) - (IsEmpty-List x)) - ((PointsNowhere-PtrPointees f)) - :ruleset always-run) - - -(datatype List - (Nil-List) - (Cons-List PtrPointees List)) - -(function Length-List (List) i64) -(rule ((= x (Nil-List))) - ((set (Length-List x) 0)) - :ruleset always-run) -(rule ((= x (Cons-List hd0 tl)) - (= l (Length-List tl))) - ((set (Length-List x) (+ l 1))) - :ruleset always-run) -(rule ((= x (Nil-List))) - ((set (Length-List x) 0)) - :ruleset memory-helpers) -(rule ((= x (Cons-List hd0 tl)) - (= l (Length-List tl))) - ((set (Length-List x) (+ l 1))) - :ruleset memory-helpers) - -(relation IsEmpty-List (List)) -(rule ((= x (Nil-List))) - ((IsEmpty-List x)) - :ruleset always-run) - -(relation IsNonEmpty-List (List)) -(rule ((= x (Cons-List hd0 tl))) - ((IsNonEmpty-List x)) - :ruleset always-run) - -(function RevConcat-List (List List) List :cost 1000) -(rewrite (RevConcat-List (Nil-List) l) - l - :ruleset always-run) -(rewrite (RevConcat-List (Cons-List hd0 tl) l) - (RevConcat-List tl (Cons-List hd0 l)) - :ruleset always-run) - -(function Rev-List (List) List :cost 1000) -(rewrite (Rev-List m) - (RevConcat-List m (Nil-List)) - :ruleset always-run) - -(function Concat-List (List List) List :cost 1000) -(rewrite (Concat-List x y) - (RevConcat-List (Rev-List x) y) - :ruleset always-run) - -; SuffixAt and At must be demanded, otherwise these are O(N^2) -(relation DemandAt-List (List)) -(relation SuffixAt-List (List i64 List)) -(relation At-List (List i64 PtrPointees)) -(rule ((DemandAt-List x)) - ((SuffixAt-List x 0 x)) - :ruleset always-run) -(rule ((SuffixAt-List x i (Cons-List hd0 tl))) - ((SuffixAt-List x (+ i 1) tl) - (At-List x i hd0)) - :ruleset always-run) - -(relation All (List)) -(rule ((= x (Nil-List))) - ((All x)) - :ruleset always-run) -(rule ((= x (Cons-List hd0 tl)) - (PointsNowhere-PtrPointees hd0) - (All tl)) - ((All x)) - :ruleset always-run) - - - -(function Zip (List List) List :cost 1000) -(rewrite (Zip (Nil-List) (Nil-List)) - (Nil-List) - :ruleset always-run) -(rewrite (Zip - (Cons-List x0 tl1) - (Cons-List y0 tl2)) - (Cons-List - (Union-PtrPointees x0 y0) - (Zip tl1 tl2)) - :when ((= (Length-List tl1) (Length-List tl2))) - :ruleset always-run) - -(function Zip (List List) List :cost 1000) -(rewrite (Zip (Nil-List) (Nil-List)) - (Nil-List) - :ruleset always-run) -(rewrite (Zip - (Cons-List x0 tl1) - (Cons-List y0 tl2)) - (Cons-List - (Intersect-PtrPointees x0 y0) - (Zip tl1 tl2)) - :ruleset always-run) - - -(sort ExprSetPrim (Set Expr)) - -(datatype ExprSet (ES ExprSetPrim)) - -(function ExprSet-intersect (ExprSet ExprSet) ExprSet) -(rewrite (ExprSet-intersect (ES set1) (ES set2)) (ES (set-intersect set1 set2)) - :ruleset memory-helpers) -(function ExprSet-union (ExprSet ExprSet) ExprSet) -(rewrite (ExprSet-union (ES set1) (ES set2)) (ES (set-union set1 set2)) - :ruleset memory-helpers) -(relation ExprSet-contains (ExprSet Expr)) -(rule ((ES set1) (set-contains set1 x)) - ((ExprSet-contains (ES set1) x)) - :ruleset memory-helpers) -(function ExprSet-insert (ExprSet Expr) ExprSet) -(rewrite (ExprSet-insert (ES set1) x) - (ES (set-insert set1 x)) - :ruleset memory-helpers) -(function ExprSet-length (ExprSet) i64) -(rewrite (ExprSet-length (ES set1)) (set-length set1) :ruleset memory-helpers) - -; ============================ -; Pointees -; ============================ - - -; List is used as an association list; the i64 keys -; (corresponding to alloc ids) are always unique and sorted, the IntInterval -; values correspond to offset ranges. -; -; (TuplePointsTo [{0->[4,5], 1->[0,0]}, {0->[0,0]}]) -; indicates a tuple with two components. -; - The first component might point to Alloc 0 at offsets 4 or 5, -; or Alloc 1 at offset 0 -; - The second component points to Alloc 0 at offset 0 -(datatype Pointees - (TuplePointsTo List) - (PtrPointsTo PtrPointees)) - -(function UnwrapPtrPointsTo (Pointees) PtrPointees) -(rewrite (UnwrapPtrPointsTo (PtrPointsTo x)) - x - :ruleset memory-helpers) -(function UnwrapTuplePointsTo (Pointees) List) -(rewrite (UnwrapTuplePointsTo (TuplePointsTo x)) - x - :ruleset memory-helpers) - -(relation PointsNowhere (Pointees)) -(rule ((= f (PtrPointsTo x)) - (PointsNowhere-PtrPointees x)) - ((PointsNowhere f)) - :ruleset memory-helpers) -(rule ((= f (TuplePointsTo l)) - (All l)) - ((PointsNowhere f)) - :ruleset memory-helpers) - -(function UnionPointees (Pointees Pointees) Pointees) -(rewrite (UnionPointees (PtrPointsTo x) (PtrPointsTo y)) - (PtrPointsTo (Union-PtrPointees x y)) - :ruleset memory-helpers) -(rewrite (UnionPointees (TuplePointsTo x) (TuplePointsTo y)) - (TuplePointsTo (Zip x y)) - :when ((= (Length-List x) (Length-List y))) - :ruleset memory-helpers) -(function IntersectPointees (Pointees Pointees) Pointees) -(rewrite (IntersectPointees (PtrPointsTo x) (PtrPointsTo y)) - (PtrPointsTo (Intersect-PtrPointees x y)) - :ruleset memory-helpers) -(rewrite (IntersectPointees (TuplePointsTo x) (TuplePointsTo y)) - (TuplePointsTo (Zip x y)) - :ruleset memory-helpers) - -(function GetPointees (Pointees i64) Pointees) -(rule ((= f (GetPointees (TuplePointsTo l) i)) - (At-List l i x)) - ((union f (PtrPointsTo x))) - :ruleset memory-helpers) - -(function PointeesDropFirst (Pointees) Pointees) -(rewrite (PointeesDropFirst (TuplePointsTo (Cons-List hd tl))) - (TuplePointsTo tl) - :ruleset memory-helpers) - -; ============================ -; Resolved -; ============================ - -; Resolved checks if an e-class contains a term containing only constructors and -; primitives; i.e. whether equality is decideable -(relation Resolved-IntOrInfinity (IntOrInfinity)) -(rule ((= f (I _))) - ((Resolved-IntOrInfinity f)) - :ruleset memory-helpers) -(rule ((= f (Infinity))) - ((Resolved-IntOrInfinity f)) - :ruleset memory-helpers) -(rule ((= f (NegInfinity))) - ((Resolved-IntOrInfinity f)) - :ruleset memory-helpers) - -(relation Resolved-IntInterval (IntInterval)) -(rule ((= f (MkIntInterval lo hi)) - (Resolved-IntOrInfinity lo) - (Resolved-IntOrInfinity hi)) - ((Resolved-IntInterval f)) - :ruleset memory-helpers) - -(relation Resolved-List (List)) -(rule ((= f (Nil-List))) - ((Resolved-List f)) - :ruleset memory-helpers) -(rule ((= f (Cons-List allocid offsets tl)) - (Resolved-List tl) - (Resolved-IntInterval offsets)) - ((Resolved-List f)) - :ruleset memory-helpers) - -(relation Resolved-PtrPointees (PtrPointees)) -(rule ((= f (PointsAnywhere))) - ((Resolved-PtrPointees f)) - :ruleset memory-helpers) -(rule ((= f (PointsTo x)) - (Resolved-List x)) - ((Resolved-PtrPointees f)) - :ruleset memory-helpers) - -(relation Resolved-List (List)) -(rule ((= f (Nil-List))) - ((Resolved-List f)) - :ruleset memory-helpers) -(rule ((= f (Cons-List hd tl)) - (Resolved-List tl) - (Resolved-PtrPointees hd)) - ((Resolved-List f)) - :ruleset memory-helpers) - -(relation Resolved-Pointees (Pointees)) -(rule ((= f (TuplePointsTo x)) - (Resolved-List x)) - ((Resolved-Pointees f)) - :ruleset memory-helpers) -(rule ((= f (PtrPointsTo x)) - (Resolved-PtrPointees x)) - ((Resolved-Pointees f)) - :ruleset memory-helpers) - - -;;;;; - -(function BaseTypeToPtrPointees (BaseType) PtrPointees :cost 100) -(rewrite (BaseTypeToPtrPointees (PointerT _)) - (PointsAnywhere) - :ruleset memory-helpers) -(rewrite (BaseTypeToPtrPointees (IntT)) - (PointsTo (Nil-List)) - :ruleset memory-helpers) -(rewrite (BaseTypeToPtrPointees (StateT)) - (PointsTo (Nil-List)) - :ruleset memory-helpers) -(rewrite (BaseTypeToPtrPointees (BoolT)) - (PointsTo (Nil-List)) - :ruleset memory-helpers) - -(function TypeListToList (TypeList) List :cost 1000) -(rewrite (TypeListToList (TNil)) - (Nil-List) - :ruleset memory-helpers) -(rewrite (TypeListToList (TCons hd tl)) - (Cons-List - (BaseTypeToPtrPointees hd) - (TypeListToList tl)) - :ruleset memory-helpers) - -(function TypeToPointees (Type) Pointees :cost 1000) -(rewrite (TypeToPointees (TupleT tylist)) - (TuplePointsTo (TypeListToList tylist)) - :ruleset memory-helpers) -(rewrite (TypeToPointees (Base basety)) - (PtrPointsTo (BaseTypeToPtrPointees basety)) - :ruleset memory-helpers) - -; ============================ -; Update PointerishType -; ============================ - -(relation PointerishType (Type)) -(relation PointerishTypeList (TypeList)) - -(rule ((= f (Base (PointerT ty)))) - ((PointerishType f)) - :ruleset always-run) - -(rule ((= f (TCons (PointerT ty) tl))) - ((PointerishTypeList f)) - :ruleset always-run) - -(rule ((= f (TCons hd tl)) - (PointerishTypeList tl)) - ((PointerishTypeList f)) - :ruleset always-run) - -(rule ((= f (TupleT l)) - (PointerishTypeList l)) - ((PointerishType f)) - :ruleset always-run) - -; ============================ -; Update PointsToCells -; ============================ - -; arg pointees result pointees -(function PointsToCells (Expr Pointees) Pointees :unextractable) - -; Top-level demand -(rule ((Function name in-ty out-ty body)) - ((PointsToCells body (TypeToPointees in-ty))) - :ruleset memory-helpers) - -; Demand PointsToCells along state edge and pointer-typed values -(rule ((PointsToCells (Bop (Print) e state) ap)) - ((PointsToCells state ap)) - :ruleset memory-helpers) -(rule ((PointsToCells (Bop (Load) e state) ap)) - ((PointsToCells e ap) - (PointsToCells state ap)) - :ruleset memory-helpers) -(rule ((PointsToCells (Top (Write) ptr val state) ap)) - ((PointsToCells ptr ap) - (PointsToCells state ap)) - :ruleset memory-helpers) -(rule ((PointsToCells (Alloc id sz state ty) ap)) - ((PointsToCells state ap)) - :ruleset memory-helpers) -(rule ((PointsToCells (Bop (Free) ptr state) ap)) - ((PointsToCells ptr ap) - (PointsToCells state ap)) - :ruleset memory-helpers) -(rule ((PointsToCells (Get x i) ap)) - ((PointsToCells x ap)) - :ruleset memory-helpers) -(rule ((PointsToCells (Concat x y) ap)) - ((PointsToCells x ap) - (PointsToCells y ap)) - :ruleset memory-helpers) -(rule ((PointsToCells (Single x) ap)) - ((PointsToCells x ap)) - :ruleset memory-helpers) - -; Compute and propagate PointsToCells -(rewrite (PointsToCells (Concat x y) aps) - (TuplePointsTo (Concat-List - (UnwrapTuplePointsTo (PointsToCells x aps)) - (UnwrapTuplePointsTo (PointsToCells y aps)))) - :when ((HasType (Concat x y) ty) (PointerishType ty)) - :ruleset memory-helpers) - -(rewrite (PointsToCells (Get x i) aps) - (GetPointees (PointsToCells x aps) i) - :when ((HasType (Get x i) ty) (PointerishType ty)) - :ruleset memory-helpers) - -(rewrite (PointsToCells (Single x) aps) - (TuplePointsTo - (Cons-List - (UnwrapPtrPointsTo (PointsToCells x aps)) - (Nil-List))) - :when ((HasType (Single x) ty) (PointerishType ty)) - :ruleset memory-helpers) - -(rewrite (PointsToCells (Arg ty_ ctx) aps) - aps - :when ((HasType (Arg ty_ ctx) ty) (PointerishType ty)) - :ruleset memory-helpers) - -; Allow non-pointer types to resolve -(rule ((PointsToCells x aps) - (HasType x ty)) - ((TypeToPointees ty)) - :ruleset memory-helpers) -(rule ((= f (PointsToCells x aps)) - (HasType x ty) - (= pointees (TypeToPointees ty)) - (PointsNowhere pointees)) - ((union f pointees)) - :ruleset memory-helpers) - -(rewrite (PointsToCells (Bop (PtrAdd) x e) aps) - (PtrPointsTo - (AddIntIntervalToPtrPointees - (MkIntInterval (I lo) (I hi)) - (UnwrapPtrPointsTo (PointsToCells x aps)))) - :when ((= (IntB lo) (lo-bound e)) - (= (IntB hi) (hi-bound e))) - :ruleset memory-helpers) - -(rewrite (PointsToCells (If c inputs t e) aps) - (UnionPointees - (PointsToCells t (PointsToCells inputs aps)) - (PointsToCells e (PointsToCells inputs aps))) - :when ((HasType (If c inputs t e) ty) (PointerishType ty)) - :ruleset memory) - -(rewrite (PointsToCells (Alloc id sz state ty) aps) - (TuplePointsTo - (Cons-List - (PointsTo - (Cons-List - id - (MkIntInterval (I 0) (I 0)) - (Nil-List))) - (Cons-List - (PointsTo (Nil-List)) ; state output points to nothing - (Nil-List)))) - :ruleset memory-helpers) - -; arg pointees * loop in * loop out * i64 -> result pointees -(function PointsToCellsAtIter (Pointees Expr Expr i64) Pointees) - -; compute first two -(rule ((= e (DoWhile inputs pred-body)) - (PointsToCells e aps)) - ((set (PointsToCellsAtIter aps inputs pred-body 0) - (PointsToCells inputs aps)) - (set (PointsToCellsAtIter aps inputs pred-body 1) - (UnionPointees - (PointsToCellsAtIter aps inputs pred-body 0) - (PointeesDropFirst - (PointsToCells pred-body (PointsToCellsAtIter aps inputs pred-body 0)))))) - :ruleset memory-helpers) - -; avoid quadratic query -(function succ (i64) i64 :unextractable) -(rule ((PointsToCellsAtIter aps inputs pred-body i)) - ((set (succ i) (+ i 1))) - :ruleset memory-helpers) - -; Note that this rule is bounded by ruleset memory -(rule ((= pointees0 (PointsToCellsAtIter aps inputs pred-body i)) - (= pointees1 (PointsToCellsAtIter aps inputs pred-body (succ i))) - (Resolved-Pointees pointees0) - (Resolved-Pointees pointees1) - (!= pointees0 pointees1)) - ((set (PointsToCellsAtIter aps inputs pred-body (+ i 2)) - (UnionPointees - pointees1 - (PointeesDropFirst - (PointsToCells pred-body pointees1))))) - :ruleset memory) - -(rule ((= pointees (PointsToCellsAtIter aps inputs pred-body i)) - (= pointees (PointsToCellsAtIter aps inputs pred-body (succ i)))) - ((set (PointsToCells (DoWhile inputs pred-body) aps) - pointees)) - :ruleset memory) - -(rule ((PtrPointsTo (PointsTo l))) - ((DemandAt-List l)) - :ruleset memory-helpers) -(rule ((TuplePointsTo l)) - ((DemandAt-List l)) - :ruleset memory-helpers) - -; ============================ -; Update DontAlias -; ============================ - -(relation DemandDontAlias (Expr Expr Pointees)) -; pointer, pointer, arg pointees -(relation DontAlias (Expr Expr Pointees)) - - -(rule ((DemandDontAlias ptr1 ptr2 arg-pointees) - (BodyContainsExpr body ptr1) - (BodyContainsExpr body ptr2) - (HasType ptr1 (Base (PointerT ty))) - (HasType ptr2 (Base (PointerT ty))) - (= pointees1 (PointsToCells ptr1 arg-pointees)) - (= pointees2 (PointsToCells ptr2 arg-pointees))) - ((IntersectPointees pointees1 pointees2)) - :ruleset memory-helpers) - -(rule ((PointsNowhere - (IntersectPointees - (PointsToCells ptr1 arg-pointees) - (PointsToCells ptr2 arg-pointees)))) - ((DontAlias ptr1 ptr2 arg-pointees)) - :ruleset memory-helpers) - -; ============================ -; Update PointsToExpr -; ============================ - -; program point, pointer -(function PointsToExpr (Expr Expr) Expr :unextractable) - -; After a load, the ptr points to the loaded value -(rule ((= f (Bop (Load) ptr state))) - ((set (PointsToExpr (Get f 1) ptr) (Get f 0))) - :ruleset memory-helpers) - -; If we load and we already know what the pointer points to -; TODO this rule breaks the weakly linear invariant -; when a previous load may not be on the path -;(rule ((= e (Bop (Load) addr state)) -; (= v (PointsToExpr state addr))) -; ((union (Get e 0) v) -; (union (Get e 1) state)) -; :ruleset memory-helpers) - -; Loads and prints don't affect what what pointers already point to -(rule ((= f (PointsToExpr state addr)) - (= e (Bop (Load) any-addr state))) - ((let new-state (Get e 1)) - (union (PointsToExpr new-state addr) f)) - :ruleset memory-helpers) -(rule ((= f (PointsToExpr state addr)) - (= e (Bop (Print) any-val state))) - ((let new-state e) - (union (PointsToExpr new-state addr) f)) - :ruleset memory-helpers) - -; Writes don't affect what a pointer points to if it writes to another pointer -; guaranteed to not alias. -(rule ((= e (Top (Write) addr data state)) - (HasArgType addr argty) - (= otherdata (PointsToExpr state otheraddr))) - ((DemandDontAlias addr otheraddr (TypeToPointees argty))) - :ruleset memory-helpers) -(rule ((= e (Top (Write) addr data state)) - (HasArgType addr argty) - (= otherdata (PointsToExpr state otheraddr)) - (DontAlias addr otheraddr (TypeToPointees argty))) - ((set (PointsToExpr e otheraddr) otherdata)) - :ruleset memory-helpers) - -; For a write, mark the given expression as containing `data`. -(rule ((= e (Top (Write) addr data state))) - ((union (PointsToExpr e addr) data)) - :ruleset memory-helpers) - -; ============================ -; Update CellHasValues (currently unused) -; ============================ - -; ; program point, cell -; (function CellHasValues (Expr i64) ExprSet :merge (ExprSet-intersect old new)) - -; ; At the time of an alloc, a cell doesn't contain any values -; (rule ((= f (Alloc id amt state ty))) - ; ((set (CellHasValues (Get f 1) id) (ES (set-empty)))) - ; :ruleset memory-helpers) - -; ; These two rules find (Write ptr val state) where -; ; ptr points to cells given no assumptions about where (Arg) points. -; ; TODO: make sensitive to offsets -; (rule ((= e (Top (Write) ptr val state)) - ; (HasArgType ptr argty)) - ; ((TypeToPointees argty)) - ; :ruleset memory-helpers) -; (rule ((= e (Top (Write) ptr val state)) - ; (HasArgType ptr argty) - ; (= (PtrPointsTo (PointsTo cells)) (PointsToCells ptr (TypeToPointees argty))) - ; (At-List cells any-idx alloc-id offsets) - ; (= vals (CellHasValues state cell))) - ; ((set (CellHasValues e cell) (ExprSet-insert vals val))) - ; :ruleset memory-helpers) - -;; Loop Invariant - -;; bool: whether the term in the Expr is an invariant. -(function is-inv-Expr (Expr Expr) bool :unextractable :merge (or old new)) -(function is-inv-ListExpr (Expr ListExpr) bool :unextractable :merge (or old new)) - -;; in default, when there is a find, set is-inv to false -(rule ((BodyContainsExpr loop term) - (= loop (DoWhile inputs pred_out))) - ((set (is-inv-Expr loop term) false)) :ruleset always-run) -(rule ((BodyContainsListExpr loop term) - (= loop (DoWhile inputs pred_out))) - ((set (is-inv-ListExpr loop term) false)) :ruleset always-run) - -(relation is-inv-ListExpr-helper (Expr ListExpr i64)) -(rule ((BodyContainsListExpr loop list) - (= loop (DoWhile inputs pred_out))) - ((is-inv-ListExpr-helper loop list 0)) :ruleset always-run) - -(rule ((is-inv-ListExpr-helper loop list i) - (= true (is-inv-Expr loop expr)) - (= expr (ListExpr-ith list i))) - ((is-inv-ListExpr-helper loop list (+ i 1))) :ruleset always-run) - -(rule ((is-inv-ListExpr-helper loop list i) - (= i (ListExpr-length list))) - ((set (is-inv-ListExpr loop list) true)) :ruleset always-run) - - -(ruleset boundary-analysis) -;; An Expr is on boundary when it is invariant and its parent is not -; loop invariant-expr -(relation boundary-Expr (Expr Expr)) - -;; boundary for ListExpr's children -(rule ((= true (is-inv-Expr loop expr)) - (= false (is-inv-ListExpr loop list)) - (= expr (ListExpr-ith list i))) - ((boundary-Expr loop expr)) :ruleset boundary-analysis) - -;; if a output branch/pred is invariant, it's also boundary-Expr -(rule ((= true (is-inv-Expr loop expr)) - (= loop (DoWhile in pred_out)) - (= expr (Get pred_out i))) - ((boundary-Expr loop expr)) :ruleset boundary-analysis) - - -(function hoisted-loop (Expr Expr) bool :unextractable :merge (or old new) ) -(rule ((= loop (DoWhile in pred_out))) - ((set (hoisted-loop in pred_out) false)) :ruleset always-run) - -(function InExtendedLoop (Expr Expr Expr) Assumption) - -;; mock function -(ruleset loop-inv-motion) - -(rule ((boundary-Expr loop inv) - (> (Expr-size inv) 1) - ;; TODO: replace Expr-size when cost model is ready - (= loop (DoWhile in pred_out)) - ;; the outter assumption of the loop - (ContextOf loop loop_ctx) - (HasType in in_type) - (HasType inv inv_type) - (= inv_type (Base base_inv_ty)) - (= in_type (TupleT tylist)) - (= false (hoisted-loop in pred_out)) - (= len (tuple-length in))) - ((let new_input (Concat in (Single (Subst loop_ctx in inv)))) - (let new_input_type (TupleT (TLConcat tylist (TCons base_inv_ty (TNil))))) - ;; create an virtual assume node, union it with actuall InLoop later - (let assum (InExtendedLoop in pred_out new_input)) - (let new_out_branch (Get (Arg new_input_type assum) len)) - ;; this two subst only change arg to arg with new type - (let substed_pred_out (Subst assum (Arg new_input_type assum) pred_out)) - (let inv_in_new_loop (Subst assum (Arg new_input_type assum) inv)) - (let new_pred_out (Concat substed_pred_out (Single new_out_branch))) - - (let new_loop (DoWhile new_input new_pred_out)) - (union assum (InLoop new_input new_pred_out)) - (union inv_in_new_loop new_out_branch) - (let wrapper (SubTuple new_loop 0 len)) - (union loop wrapper) - (subsume (DoWhile in pred_out)) - ;; don't hoist same loop again - (set (hoisted-loop in pred_out) true) - ) - :ruleset loop-inv-motion) - - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Const _n _ty _ctx))) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Get (Arg ty ctx) i)) - (= loop (DoWhile in pred_out)) - (= expr (Get pred_out (+ i 1)))) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Function _name _tyin _tyout _out)) - - ) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Top _op _x _y _z)) - (= true (is-inv-Expr loop _x)) (= true (is-inv-Expr loop _y)) (= true (is-inv-Expr loop _z)) - ) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Bop _op _x _y)) (BinaryOpIsPure _op) - (= true (is-inv-Expr loop _x)) (= true (is-inv-Expr loop _y)) - ) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Uop _op _x)) (UnaryOpIsPure _op) - (= true (is-inv-Expr loop _x)) - ) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Get _tup _i)) - (= true (is-inv-Expr loop _tup)) - ) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Concat _x _y)) - (= true (is-inv-Expr loop _x)) (= true (is-inv-Expr loop _y)) - ) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Single _x)) - (= true (is-inv-Expr loop _x)) - ) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Switch _pred _inputs _branches)) - (= true (is-inv-Expr loop _pred)) (= true (is-inv-Expr loop _inputs)) (= true (is-inv-ListExpr loop _branches)) - ) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (If _pred _input _then _else)) - (= true (is-inv-Expr loop _pred)) (= true (is-inv-Expr loop _input)) - ) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (DoWhile _in _pred-and-output)) - (= true (is-inv-Expr loop _in)) - (ExprIsPure expr)) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Call _func _arg)) - (= true (is-inv-Expr loop _arg)) - (ExprIsPure expr)) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Empty _ty _ctx)) - - ) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Top _op _x _y _z)) - (= expr1 _x)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Top _op _x _y _z)) - (= expr1 _y)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Top _op _x _y _z)) - (= expr1 _z)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Bop _op _x _y)) - (= expr1 _x)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Bop _op _x _y)) - (= expr1 _y)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Uop _op _x)) - (= expr1 _x)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Concat _x _y)) - (= expr1 _x)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Concat _x _y)) - (= expr1 _y)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Single _x)) - (= expr1 _x)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Switch _pred _inputs _branches)) - (= expr1 _pred)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Switch _pred _inputs _branches)) - (= expr1 _inputs)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (If _pred _input _then _else)) - (= expr1 _pred)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (If _pred _input _then _else)) - (= expr1 _input)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (DoWhile _in _pred-and-output)) - (= expr1 _in)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Call _func _arg)) - (= expr1 _arg)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Alloc _id _e _state _ty)) - (= expr1 _e)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Alloc _id _e _state _ty)) - (= expr1 _state)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) -;; Some simple simplifications of loops -(ruleset loop-simplify) - -(rewrite - (DoWhile (Arg ty ctx) - (Concat (Single (Const (Bool false) ty ctx2)) - (Single (Const constant ty ctx2)))) - (Single (Const constant ty ctx)) - :ruleset loop-simplify) -;; Some simple simplifications of loops -(ruleset loop-unroll) -(ruleset loop-peel) - -;; inputs, outputs -> number of iterations -(function LoopNumItersGuess (Expr Expr) i64 :merge (max 1 (min old new))) - -;; by default, guess that all loops run 1000 times -(rule ((DoWhile inputs outputs)) - ((set (LoopNumItersGuess inputs outputs) 1000)) - :ruleset always-run) - - -;; loop peeling rule -(rule - ((= lhs (DoWhile inputs outputs)) - (ContextOf lhs ctx) - (HasType inputs inputs-ty) - (= outputs-len (tuple-length outputs)) - (= old_cost (LoopNumItersGuess inputs outputs))) - ((let executed-once - (Subst ctx inputs outputs)) - (let executed-once-body - (SubTuple executed-once 1 (- outputs-len 1))) - (let then-ctx - (InIf true (Get executed-once 0) executed-once-body)) - (let else-ctx - (InIf false (Get executed-once 0) executed-once-body)) - (union lhs - ;; check if we need to continue executing the loop - (If (Get executed-once 0) - executed-once-body ;; inputs are the body executed once - (DoWhile (Arg inputs-ty then-ctx) - outputs) ;; right now, loop unrolling shares the same outputs, but we could add more context here - (Arg inputs-ty else-ctx))) - (set (LoopNumItersGuess (Arg inputs-ty then-ctx) outputs) (- old_cost 1)) - ) - :ruleset loop-peel) - -;; unroll a loop with constant bounds and initial value -(rule - ((= lhs (DoWhile inputs outputs)) - (= num-inputs (tuple-length inputs)) - (= pred (Get outputs 0)) - ;; iteration counter starts at start_const - (= (Const (Int start_const) _ty1 _ctx1) (Get inputs counter_i)) - ;; updated counter at counter_i - (= next_counter (Get outputs (+ counter_i 1))) - ;; increments by one each loop - (= next_counter (Bop (Add) (Get (Arg _ty _ctx) counter_i) - (Const (Int 1) _ty2 _ctx2))) - ;; while less than end_constant - (= pred (Bop (LessThan) next_counter - (Const (Int end_constant) _ty3 _ctx3))) - ;; start and end constant is a multiple of 4 and greater than start_const - (> end_constant start_const) - (= (% start_const 4) 0) - (= (% end_constant 4) 0) - (= old_cost (LoopNumItersGuess inputs outputs)) - ) - ( - (let one-iter (SubTuple outputs 1 num-inputs)) - (let unrolled - (Subst (TmpCtx) one-iter - (Subst (TmpCtx) one-iter - (Subst (TmpCtx) one-iter - outputs)))) - (union lhs - (DoWhile inputs - unrolled)) - (let actual-ctx (InLoop inputs unrolled)) - (union (TmpCtx) actual-ctx) - - (set (LoopNumItersGuess inputs unrolled) (/ old_cost 4)) - (delete (TmpCtx)) - ) - :ruleset loop-unroll) - - - -;; Pass through thetas -(rule ((= lhs (Get loop i)) - (= loop (DoWhile inputs pred-outputs)) - (= (Get pred-outputs (+ i 1)) (Get (Arg _ty _ctx) i)) - ;; only pass through pure types, since some loops don't terminate - ;; so the state edge must pass through them - (HasType (Get loop i) lhs_ty) - (PureType lhs_ty) - ) - ((union lhs (Get inputs i))) - :ruleset always-run) - -;; Pass through switch arguments -(rule ((= lhs (Get switch i)) - (= switch (Switch pred inputs branches)) - (= (ListExpr-length branches) 2) - (= branch0 (ListExpr-ith branches 0)) - (= branch1 (ListExpr-ith branches 1)) - (= (Get branch0 i) (Get (Arg _ _ctx0) j)) - (= (Get branch1 i) (Get (Arg _ _ctx1) j)) - (= passed-through (Get inputs j)) - (HasType lhs lhs_ty) - (!= lhs_ty (Base (StateT)))) - ((union lhs passed-through)) - :ruleset always-run) - -;; Pass through switch predicate -(rule ((= lhs (Get switch i)) - (= switch (Switch pred inputs branches)) - (= (ListExpr-length branches) 2) - (= branch0 (ListExpr-ith branches 0)) - (= branch1 (ListExpr-ith branches 1)) - (= (Get branch0 i) (Const (Bool false) _ _ctx0)) - (= (Get branch1 i) (Const (Bool true) _ _ctx1))) - ((union lhs pred)) - :ruleset always-run) - -;; Pass through if arguments -(rule ((= if (If pred inputs then_ else_)) - (= jth-inside (Get (Arg _ _then_ctx) j)) - (= (Get then_ i) jth-inside) - (= (Get else_ i) (Get (Arg _ _else_ctx) j)) - (HasType jth-inside lhs_ty) - (!= lhs_ty (Base (StateT)))) - ((union (Get if i) (Get inputs j))) - :ruleset always-run) - -; Pass through if state edge arguments -; To maintain the invariant, we have to union the other outputs with a pure if statement -(rule ((= lhs (Get outputs i)) - (= outputs (If pred inputs then_ else_)) - - (= (Get then_ i) (Get (Arg (TupleT arg_ty) then_ctx) j)) - (= (Get else_ i) (Get (Arg (TupleT arg_ty) else_ctx) j)) - (= passed-through (Get inputs j)) - - (HasType lhs lhs_ty) - (= lhs_ty (Base (StateT))) - - (= inputs_len (tuple-length inputs)) - (= outputs_len (tuple-length outputs))) - - ((let new_inputs (TupleRemoveAt inputs j)) - - (let new_then_ctx (InIf true pred new_inputs)) - (let new_else_ctx (InIf false pred new_inputs)) - - (let old_then (TupleRemoveAt then_ i)) - (let old_else (TupleRemoveAt else_ i)) - - (let new_then (DropAt new_then_ctx j old_then)) - (let new_else (DropAt new_else_ctx j old_else)) - - (let old_outputs (TupleRemoveAt outputs i)) - (let new_if (If pred new_inputs new_then new_else)) - (union new_if old_outputs) - - (union lhs passed-through) - (subsume (If pred inputs then_ else_))) - :ruleset always-run) - -;; Pass through if predicate -(rule ((= if (If pred inputs then_ else_)) - (= (Get then_ i) (Const (Bool true) _ _thenctx)) - (= (Get else_ i) (Const (Bool false) _ _elsectx))) - - ((let new_then (TupleRemoveAt then_ i)) - (let new_else (TupleRemoveAt else_ i)) - (let new_if (If pred inputs new_then new_else)) - - (union (Get if i) pred) - (union (TupleRemoveAt if i) new_if) - (subsume (If pred inputs then_ else_))) - :ruleset always-run) - -;; ORIGINAL -;; a = 0 -;; c = 3 -;; for i = 0 to n: -;; a = i * c -;; -;; OPTIMIZED -;; a = 0 -;; c = 3 -;; d = 0 -;; for i = 0 to n: -;; a += d -;; d += c -(ruleset loop-strength-reduction) - -; Finds invariants/constants within a body. -; Columns: body; value of invariant in inputs; value of invariant in outputs -;; Get the input and output value of an invariant, or constant int, within the loop -;; loop in out -(relation lsr-inv (Expr Expr Expr)) - -; TODO: there may be a bug with finding the invariant, or it just may not be extracted. -; Can make this work on loop_with_mul_by_inv and a rust test later. -; (rule ( -; (= loop (DoWhile inputs pred-and-body)) -; (= (Get outputs (+ i 1)) (Get (Arg arg-type assm) i))) -; ((inv loop (Get inputs i) (Get (Arg arg-type assm) i))) :ruleset always-run) -(rule ( - (= loop (DoWhile inputs pred-and-body)) - (ContextOf inputs loop-input-ctx) - (ContextOf pred-and-body loop-output-ctx) - (= constant (Const c out-type loop-output-ctx)) - (HasArgType inputs in-type) - ) - ((lsr-inv loop (Const c in-type loop-input-ctx) constant)) :ruleset always-run) - -(rule - ( - ;; Find loop - (= old-loop (DoWhile inputs pred-and-outputs)) - (ContextOf pred-and-outputs loop-ctx) - - ; Find loop variable (argument that gets incremented with an invariant) - (lsr-inv old-loop loop-incr-in loop-incr-out) - ; Since the first el of pred-and-outputs is the pred, we need to offset i - (= (Get pred-and-outputs (+ i 1)) (Bop (Add) (Get (Arg arg-type assm) i) loop-incr-out)) - - ; Find invariant where input is same as output, or constant - (lsr-inv old-loop c-in c-out) - - ; Find multiplication of loop variable and invariant - (= old-mul (Bop (Mul) c-out (Get (Arg arg-type assm) i))) - (ContextOf old-mul loop-ctx) - - (= arg-type (TupleT ty-list)) - ) - ( - ; Each time we need to update d by the product of the multiplied constant and the loop increment - (let addend (Bop (Mul) c-out loop-incr-out)) - - ; n is index of our new, temporary variable d - (let n (tuple-length inputs)) - - ; Initial value of d is i * c - (let d-init (Bop (Mul) c-in (Get inputs i))) - - ; Construct optimized theta - ; new-inputs already has the correct context - (let new-inputs (Concat inputs (Single d-init))) - - ; We need to create a new type, with one more input - (let new-arg-ty (TupleT (TLConcat ty-list (TCons (IntT) (TNil))))) - - ; Value of d in loop. Add context to addend - (let d-out (Bop (Add) (Get (Arg new-arg-ty (TmpCtx)) n) - (Subst (TmpCtx) (Arg new-arg-ty (TmpCtx)) addend))) - - ; build the old body, making sure to set the correct arg type and context - (let new-body - (Concat - (Subst (TmpCtx) (Arg new-arg-ty (TmpCtx)) pred-and-outputs) - (Single d-out))) - - (let new-loop (DoWhile new-inputs new-body)) - - ; Now that we have the new loop, union the temporary context with the actual ctx - (union (TmpCtx) (InLoop new-inputs new-body)) - - ; Substitute d for the *i expression - (let new-mul - (Bop - (Mul) - (Subst (TmpCtx) (Arg new-arg-ty (TmpCtx)) c-out) - (Get (Arg new-arg-ty (TmpCtx)) i))) - (union (Get (Arg new-arg-ty (TmpCtx)) n) new-mul) - - ; Subsume the multiplication in the new loop to prevent - ; from firing loop strength reduction again on the new loop - (subsume - (Bop - (Mul) - (Subst (TmpCtx) (Arg new-arg-ty (TmpCtx)) c-out) - (Get (Arg new-arg-ty (TmpCtx)) i))) - - ; Project all but last - (union old-loop (SubTuple new-loop 0 n)) - (delete (TmpCtx)) - ) - :ruleset loop-strength-reduction -) -(DoWhile (Concat (Single (Const (Int 0) (TupleT (TNil)) (InFunc "dummy"))) (Single (Const (Int 1) (TupleT (TNil)) (InFunc "dummy")))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 0) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 0) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))))) - -(If (Bop (LessThan) (Const (Int 0) (TupleT (TNil)) (InFunc "dummy")) (Const (Int 1) (TupleT (TNil)) (InFunc "dummy"))) (Concat (Single (Const (Int 1) (TupleT (TNil)) (InFunc "dummy"))) (Single (Const (Int 1) (TupleT (TNil)) (InFunc "dummy")))) (DoWhile (Concat (Single (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 0)) (Single (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 0) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 0) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))))) (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy"))) - - (unstable-combined-ruleset saturating - always-run - canon - type-analysis - context - interval-analysis - memory-helpers - ) - - - (unstable-combined-ruleset optimizations - loop-simplify - memory - loop-unroll - peepholes - ) - - (unstable-combined-ruleset expensive-optimizations - optimizations - ;; TODO why is this expensive? On `adler32.bril` it blows up with 3 iterations - switch_rewrite - ;loop-inv-motion - loop-strength-reduction - ) - - (run-schedule - -;; saturate all helpers first -(saturate - (saturate - (saturate type-helpers) ;; resolve type helpers, finding correct types - (saturate error-checking) ;; check for errors, relies on type-helpers saturating - saturating) - - (saturate drop) - apply-drop-unions - cleanup-drop - - (saturate subst) ;; do e-substitution - apply-subst-unions ;; apply the unions from substitution - cleanup-subst ;; clean up substitutions that are done - - (saturate boundary-analysis) ;; find boundaries of invariants -) - - - loop-peel - (repeat 2 - -;; saturate all helpers first -(saturate - (saturate - (saturate type-helpers) ;; resolve type helpers, finding correct types - (saturate error-checking) ;; check for errors, relies on type-helpers saturating - saturating) - - (saturate drop) - apply-drop-unions - cleanup-drop - - (saturate subst) ;; do e-substitution - apply-subst-unions ;; apply the unions from substitution - cleanup-subst ;; clean up substitutions that are done - - (saturate boundary-analysis) ;; find boundaries of invariants -) - - - expensive-optimizations) - (repeat 4 - -;; saturate all helpers first -(saturate - (saturate - (saturate type-helpers) ;; resolve type helpers, finding correct types - (saturate error-checking) ;; check for errors, relies on type-helpers saturating - saturating) - - (saturate drop) - apply-drop-unions - cleanup-drop - - (saturate subst) ;; do e-substitution - apply-subst-unions ;; apply the unions from substitution - cleanup-subst ;; clean up substitutions that are done - - (saturate boundary-analysis) ;; find boundaries of invariants -) - - - optimizations) - -;; saturate all helpers first -(saturate - (saturate - (saturate type-helpers) ;; resolve type helpers, finding correct types - (saturate error-checking) ;; check for errors, relies on type-helpers saturating - saturating) - - (saturate drop) - apply-drop-unions - cleanup-drop - - (saturate subst) ;; do e-substitution - apply-subst-unions ;; apply the unions from substitution - cleanup-subst ;; clean up substitutions that are done - - (saturate boundary-analysis) ;; find boundaries of invariants -) - -) - - - (query-extract :variants 5 (DoWhile (Concat (Single (Const (Int 0) (TupleT (TNil)) (InFunc "dummy"))) (Single (Const (Int 1) (TupleT (TNil)) (InFunc "dummy")))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 0) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 0) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1)))))) - ;(query-extract :variants 5 (If (Bop (LessThan) (Const (Int 0) (TupleT (TNil)) (InFunc "dummy")) (Const (Int 1) (TupleT (TNil)) (InFunc "dummy"))) (Concat (Single (Const (Int 1) (TupleT (TNil)) (InFunc "dummy"))) (Single (Const (Int 1) (TupleT (TNil)) (InFunc "dummy")))) (DoWhile (Concat (Single (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 0)) (Single (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 0) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 0) (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")) 1))))) (Arg (TupleT (TCons (IntT) (TCons (IntT) (TNil)))) (InFunc "dummy")))) - -;; use these rules to clean up the database, removing helpers -;; this makes the visualization easier to read - - -(rule ((HasType a b)) - ((delete (HasType a b)))) -(rule ((BodyContainsExpr a b)) - ((delete (BodyContainsExpr a b)))) -(rule ((ExprIsPure e)) - ((delete (ExprIsPure e)))) -(rule ((HasArgType e ty)) - ((delete (HasArgType e ty)))) -(rule ((is-inv-Expr e ty)) - ((delete (is-inv-Expr e ty)))) -(rule ((tuple-length e)) - ((delete (tuple-length e)))) -(rule ((BinaryOpIsPure e)) - ((delete (BinaryOpIsPure e)))) -(rule ((TypeList-suffix e a)) - ((delete (TypeList-suffix e a)))) -(rule ((ContextOf e a)) - ((delete (ContextOf e a)))) -(rule ((ExprIsResolved e)) - ((delete (ExprIsResolved e)))) -(run-schedule (saturate (run))) - - Running unittests src/main.rs (target/release/deps/dag_in_context-13fe7a7639e66d94) diff --git a/out.egg b/out.egg deleted file mode 100644 index f8819658a..000000000 --- a/out.egg +++ /dev/null @@ -1,3854 +0,0 @@ -; Every term is an `Expr` or a `ListExpr`. -(datatype Expr) -; Used for constructing a list of branches for `Switch`es -; or a list of functions in a `Program`. -(datatype ListExpr (Cons Expr ListExpr) (Nil)) - -; ================================= -; Types -; ================================= - -(sort TypeList) - -(datatype BaseType - (IntT) - (BoolT) - (FloatT) - ; a pointer to a memory region with a particular type - (PointerT BaseType) - (StateT)) - - -(datatype Type - ; a primitive type - (Base BaseType) - ; a typed tuple. Use an empty tuple as a unit type. - ; state edge also has unit type - (TupleT TypeList) -) - -(function TNil () TypeList) -(function TCons (BaseType TypeList) TypeList) ; Head element should never be a tuple - - -; ================================= -; Assumptions -; ================================= - -(datatype Assumption - ; Assume nothing - (InFunc String) - ; The term is in a loop with `input` and `pred_output`. - ; InLoop is a special context because it describes the argument of the loop. It is a *scope context*. - ; input pred_output - (InLoop Expr Expr) - ; Branch of the switch, and what the predicate is, and what the input is - (InSwitch i64 Expr Expr) - ; If the predicate was true, and what the predicate is, and what the input is - (InIf bool Expr Expr) -) - - - -; ================================= -; Leaf nodes -; Constants, argument, and empty tuple -; ================================= - -; Only a single argument is bound- if multiple values are needed, arg will be a tuple. -; e.g. `(Get (Arg tuple_type) 1)` gets the second value in the argument with some tuple_type. -(function Arg (Type Assumption) Expr) - -; Constants -(datatype Constant - (Int i64) - (Bool bool) - (Float f64)) -; All leaf nodes need the type of the argument -; Type is the type of the bound argument in scope -(function Const (Constant Type Assumption) Expr) - -; An empty tuple. -; Type is the type of the bound argument in scope -(function Empty (Type Assumption) Expr) - - -; ================================= -; Operators -; ================================= - -(datatype TernaryOp - ; given a pointer, value, and a state edge - ; writes the value to the pointer and returns - ; the resulting state edge - (Write) - (Select)) -(datatype BinaryOp - ;; integer operators - (Add) - (Sub) - (Div) - (Mul) - (LessThan) - (GreaterThan) - (LessEq) - (GreaterEq) - (Eq) - ;; float operators - (FAdd) - (FSub) - (FDiv) - (FMul) - (FLessThan) - (FGreaterThan) - (FLessEq) - (FGreaterEq) - (FEq) - ;; logical operators - (And) - (Or) - ; given a pointer and a state edge - ; loads the value at the pointer and returns (value, state edge) - (Load) - ; Takes a pointer and an integer, and offsets - ; the pointer by the integer - (PtrAdd) - ; given and value and a state edge, prints the value as a side-effect - ; the value must be a base value, not a tuple - ; returns an empty tuple - (Print) - ; given a pointer and state edge, frees the whole memory region at the pointer - (Free)) -(datatype UnaryOp - (Not)) - -; Operators -(function Top (TernaryOp Expr Expr Expr) Expr) -(function Bop (BinaryOp Expr Expr) Expr) -(function Uop (UnaryOp Expr) Expr) -; gets from a tuple. static index -(function Get (Expr i64) Expr) -; (Alloc id amount state_edge pointer_type) -; allocate an integer amount of memory for a particular type -; returns (pointer to the allocated memory, state edge) -(function Alloc (i64 Expr Expr BaseType) Expr) -; name of func arg -(function Call (String Expr) Expr) - - - -; ================================= -; Tuple operations -; ================================= - -; `Empty`, `Single` and `Concat` create tuples. -; 1. Use `Empty` for an empty tuple. -; 2. Use `Single` for a tuple with one element. -; 3. Use `Concat` to append the elements from two tuples together. -; Nested tuples are not allowed. - - -; A tuple with a single element. -; Necessary because we only use `Concat` to add to tuples. -(function Single (Expr) Expr) -; Concat appends the elemnts from two tuples together -; e.g. (Concat (Concat (Single a) (Single b)) -; (Concat (Single c) (Single d))) = (a, b, c, d) -; expr1 expr2 -(function Concat (Expr Expr) Expr) - - - -; ================================= -; Control flow -; ================================= - -; Switch on a list of lazily-evaluated branches. -; pred must be an integer -; pred inputs branches chosen -(function Switch (Expr Expr ListExpr) Expr) -; If is like switch, but with a boolean predicate -; pred inputs then else -(function If (Expr Expr Expr Expr) Expr) - - -; A do-while loop. -; Evaluates the input, then evaluates the body. -; Keeps looping while the predicate is true. -; input must have the same type as (output1, output2, ..., outputi) -; input must be a tuple -; pred must be a boolean -; pred-and-body must be a flat tuple (pred, out1, out2, ..., outi) -; input must be the same type as (out1, out2, ..., outi) -; input pred-and-body -(function DoWhile (Expr Expr) Expr) - - -; ================================= -; Top-level expressions -; ================================= -(sort ProgramType) -; An entry function and a list of additional functions. -; entry function other functions -(function Program (Expr ListExpr) ProgramType) -; name input ty output ty output -(function Function (String Type Type Expr) Expr) - - - -; Rulesets -(ruleset always-run) -(ruleset error-checking) -(ruleset memory) -(ruleset memory-helpers) -(ruleset smem) - -;; Initliazation -(relation bop->string (BinaryOp String)) -(relation uop->string (UnaryOp String)) -(relation top->string (TernaryOp String)) -(bop->string (Add) "Add") -(bop->string (Sub) "Sub") -(bop->string (Div) "Div") -(bop->string (Mul) "Mul") -(bop->string (LessThan) "LessThan") -(bop->string (GreaterThan) "GreaterThan") -(bop->string (LessEq) "LessEq") -(bop->string (GreaterEq) "GreaterEq") -(bop->string (Eq) "Eq") -(bop->string (FAdd) "FAdd") -(bop->string (FSub) "FSub") -(bop->string (FDiv) "FDiv") -(bop->string (FMul) "FMul") -(bop->string (FLessThan) "FLessThan") -(bop->string (FGreaterThan) "FGreaterThan") -(bop->string (FLessEq) "FLessEq") -(bop->string (FGreaterEq) "FGreaterEq") -(bop->string (FEq) "FEq") -(bop->string (And) "And") -(bop->string (Or) "Or") -(bop->string (Load) "Load") -(bop->string (PtrAdd) "PtrAdd") -(bop->string (Print) "Print") -(bop->string (Free) "Free") -(ruleset type-analysis) -(ruleset type-helpers) ;; these rules need to saturate between every iter of type-analysis rules - -(function TLConcat (TypeList TypeList) TypeList :unextractable) -(rewrite (TLConcat (TNil) r) r :ruleset type-helpers) -(rewrite (TLConcat (TCons hd tl) r) - (TCons hd (TLConcat tl r)) - :ruleset type-helpers) - -(function TypeList-length (TypeList) i64 :unextractable) -(function TypeList-ith (TypeList i64) BaseType :unextractable) -(function TypeList-suffix (TypeList i64) TypeList :unextractable) - -(rule ((TupleT tylist)) ((union (TypeList-suffix tylist 0) tylist)) :ruleset type-helpers) - -(rule ((= (TypeList-suffix top n) (TCons hd tl))) - ((union (TypeList-ith top n) hd) - (union (TypeList-suffix top (+ n 1)) tl)) :ruleset type-helpers) - -(rule ((= (TypeList-suffix list n) (TNil))) - ((set (TypeList-length list) n)) :ruleset type-helpers) - -(rule ((TypeList-ith list i) - (= (TypeList-length list) n) - (>= i n)) - ((panic "TypeList-ith out of bounds")) :ruleset type-helpers) - -(relation HasType (Expr Type)) - - -;; Keep track of type expectations for error messages -(relation ExpectType (Expr Type String)) -(rule ( - (ExpectType e expected msg) - (HasType e actual) - (!= expected actual) ;; OKAY to compare types for equality because we never union types. - ) - ((extract "Expecting expression") - (extract e) - (extract "to have type") - (extract expected) - (extract "but got type") - (extract actual) - (extract "with message") - (extract msg) - (panic "type mismatch")) - :ruleset error-checking) - -(relation HasArgType (Expr Type)) - -(rule ((HasArgType (Arg t1 ctx) t2) - (!= t1 t2)) - ((panic "arg type mismatch")) - :ruleset error-checking) - -(rule ((= lhs (Function name in out body)) - (HasArgType body ty) - (HasArgType body ty2) - (!= ty ty2)) - ((panic "arg type mismatch in function")) - :ruleset error-checking) - -; Propagate arg types up -(rule ((= lhs (Uop _ e)) - (HasArgType e ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Bop _ a b)) - (HasArgType a ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Bop _ a b)) - (HasArgType b ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Get e _)) - (HasArgType e ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Alloc _id e state _)) - (HasArgType e ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Call _ e)) - (HasArgType e ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Single e)) - (HasArgType e ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Concat e1 e2)) - (HasArgType e1 ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Concat e1 e2)) - (HasArgType e2 ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Switch pred inputs (Cons branch rest))) - (HasArgType pred ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Switch pred inputs (Cons branch rest))) - (HasArgType branch ty) - (HasType inputs ty2) - (!= ty ty2)) - ((panic "switch branches then branch has incorrect input type")) - :ruleset error-checking) -;; demand with one fewer branches -(rule ((= lhs (Switch pred inputs (Cons branch rest)))) - ((Switch pred inputs rest)) - :ruleset type-analysis) -(rule ((= lhs (If c i t e)) - (HasArgType c ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (If c i t e)) - (HasType i ty) - (HasArgType t ty2) - (!= ty ty2)) - ((panic "if branches then branch has incorrect input type")) - :ruleset error-checking) -(rule ((= lhs (If c i t e)) - (HasType i ty) - (HasArgType e ty2) - (!= ty ty2)) - ((panic "if branches else branch has incorrect input type")) - :ruleset error-checking) - - -(rule ((= lhs (DoWhile ins body)) - (HasArgType ins ty)) - ((HasArgType lhs ty)) - :ruleset type-analysis) -; Don't push arg types through Program, Function, DoWhile, Let exprs because -; these create new arg contexts. - -; Primitives -(rule ((= lhs (Const (Int i) ty ctx))) - ((HasType lhs (Base (IntT))) - (HasArgType lhs ty)) - :ruleset type-analysis) - -(rule ((= lhs (Const (Bool b) ty ctx))) - ((HasType lhs (Base (BoolT))) - (HasArgType lhs ty)) - :ruleset type-analysis) - -(rule ((= lhs (Const (Float b) ty ctx))) - ((HasType lhs (Base (FloatT))) - (HasArgType lhs ty)) - :ruleset type-analysis) - -(rule ((= lhs (Empty ty ctx))) - ((HasType lhs (TupleT (TNil))) - (HasArgType lhs ty)) - :ruleset type-analysis) - -; Unary Ops -(rule ( - (= lhs (Uop (Not) e)) - (HasType e (Base (BoolT))) - ) - ((HasType lhs (Base (BoolT)))) - :ruleset type-analysis) -(rule ((= lhs (Uop (Not) e))) - ((ExpectType e (Base (BoolT)) "(Not)")) - :ruleset type-analysis) - - -(rule ( - (= lhs (Bop (Print) e state)) - (HasType e _ty) ; just make sure it has some type. - ) - ((HasType lhs (Base (StateT)))) - :ruleset type-analysis) - -(rule ( - (= lhs (Bop (Print) e state)) - (HasType e (TupleT ty)) - ) - ((panic "Don't print a tuple")) - :ruleset error-checking) - -(rule ((= lhs (Bop (Free) e s)) - (HasType e (Base (PointerT _ty)))) - ((HasType lhs (Base (StateT)))) - :ruleset type-analysis) -(rule ((= lhs (Bop (Free) e s)) - (HasType e (Base (IntT)))) - ((panic "Free expected pointer, received integer")) - :ruleset error-checking) -(rule ((= lhs (Bop (Free) e s)) - (HasType e (TupleT _ty))) - ((panic "Free expected pointer, received tuple")) - :ruleset error-checking) - -(rule ( - (= lhs (Bop (Load) e state)) - (HasType e (Base (PointerT ty))) - ) - ((HasType lhs (TupleT (TCons ty (TCons (StateT) (TNil)))))) - :ruleset type-analysis) -(rule ( - (= lhs (Bop (Load) e state)) - (HasType e ty) - (= ty (Base (IntT))) - ) - ((panic "(Load) expected pointer, received int")) - :ruleset error-checking) -(rule ( - (= lhs (Bop (Load) e state)) - (HasType e ty) - (= ty (TupleT x)) - ) - ((panic "(Load) expected pointer, received tuple")) - :ruleset error-checking) - -; Binary ops - -;; Operators that have type Type -> Type -> Type -;; Note we only do this generic matching for binary -;; operator since there's a lot of them. -;; In the future we can also extend to other constructs. -(relation bop-of-type (BinaryOp Type)) -(bop-of-type (Add) (Base (IntT))) -(bop-of-type (Sub) (Base (IntT))) -(bop-of-type (Div) (Base (IntT))) -(bop-of-type (Mul) (Base (IntT))) -(bop-of-type (FAdd) (Base (FloatT))) -(bop-of-type (FSub) (Base (FloatT))) -(bop-of-type (FDiv) (Base (FloatT))) -(bop-of-type (FMul) (Base (FloatT))) - -(rule ( - (= lhs (Bop op e1 e2)) - (bop-of-type op ty) - (HasType e1 ty) - (HasType e2 ty) - ) - ((HasType lhs ty)) - :ruleset type-analysis) -(rule ((= lhs (Bop op e1 e2)) - (bop-of-type op ty) - (bop->string op op-str)) - ( - (ExpectType e1 ty op-str) - (ExpectType e2 ty op-str) - ) - :ruleset type-analysis) - -;; Operators that have type Float -> Float -> Bool -(relation bpred-of-type (BinaryOp Type)) -(bpred-of-type (FLessThan) (Base (FloatT))) -(bpred-of-type (FLessEq) (Base (FloatT))) -(bpred-of-type (FGreaterThan) (Base (FloatT))) -(bpred-of-type (FGreaterEq) (Base (FloatT))) -(bpred-of-type (FEq) (Base (FloatT))) -(bpred-of-type (LessThan) (Base (IntT))) -(bpred-of-type (LessEq) (Base (IntT))) -(bpred-of-type (GreaterThan) (Base (IntT))) -(bpred-of-type (GreaterEq) (Base (IntT))) -(bpred-of-type (Eq) (Base (IntT))) -(bpred-of-type (And) (Base (BoolT))) -(bpred-of-type (Or) (Base (BoolT))) - -(rule ( - (= lhs (Bop pred e1 e2)) - (bpred-of-type pred ty) - (HasType e1 ty) - (HasType e2 ty) - ) - ((HasType lhs (Base (BoolT)))) - :ruleset type-analysis) -(rule ((= lhs (Bop pred e1 e2)) - (bpred-of-type pred ty) - (bop->string pred pred-str)) - ( - (ExpectType e1 ty pred-str) - (ExpectType e2 ty pred-str) - ) - :ruleset type-analysis) - -(rule ( - (= lhs (Top (Write) ptr val state)) - (HasType ptr (Base (PointerT ty))) - (HasType val (Base t)) ; TODO need to support pointers to pointers - ) - ((HasType lhs (Base (StateT)))) ; Write returns () - :ruleset type-analysis) - -(rule ( - (= lhs (Top (Write) ptr val state)) - (HasType ptr (Base (PointerT ty)))) - ((ExpectType val (Base ty) "(Write)")) - :ruleset type-analysis) - - - -(rule ( - (= lhs (Bop (PtrAdd) ptr n)) - (HasType ptr (Base (PointerT ty))) - (HasType n (Base (IntT))) - ) - ((HasType lhs (Base (PointerT ty)))) - :ruleset type-analysis) - -; Other ops -(rule ((= lhs (Alloc _id amt state ty))) - ((ExpectType amt (Base (IntT)) "(Alloc)")) - :ruleset type-analysis) - -(rule ( - (= lhs (Alloc _id amt state ty)) - (HasType amt (Base (IntT))) - ) - ((HasType lhs (TupleT (TCons ty (TCons (StateT) (TNil)))))) - :ruleset type-analysis) - -(rule ( - (= lhs (Get e i)) - (HasType e (TupleT tylist)) - ) - ; TypeList-ith needs to compute immediately, so we need to saturate type-helpers - ; rules between every iter of type-analysis rules. - ((HasType lhs (Base (TypeList-ith tylist i)))) - :ruleset type-analysis) - -(rule ( - (HasType (Get expr i) (TupleT tl)) - (= (TypeList-length tl) len) - (>= i len)) - ((panic "index out of bounds")) - :ruleset error-checking) -(rule ( - (HasType (Get expr i) (TupleT tl)) - (= (TypeList-length tl) len) - (< i 0) - ) - ((panic "negative index")) - :ruleset error-checking) - -; ================================= -; Tuple operations -; ================================= - -(rule ( - (= lhs (Single e)) - (HasType e (TupleT tylist)) - ) - ((panic "don't nest tuples")) - :ruleset error-checking) - -(rule ( - (= lhs (Single e)) - (HasType e (Base basety)) - ) - ((HasType lhs (TupleT (TCons basety (TNil))))) - :ruleset type-analysis) - -(rule ( - (= lhs (Concat e1 e2)) - (HasType e1 (TupleT tylist1)) - (HasType e2 (TupleT tylist2)) - ) - ; TLConcat needs to compute immediately, so we need to saturate type-helpers - ; rules between every iter of type-analysis rules. - ((HasType lhs (TupleT (TLConcat tylist1 tylist2)))) - :ruleset type-analysis) - -; ================================= -; Control flow -; ================================= -(rule ((= lhs (If pred inputs then else))) - ((ExpectType pred (Base (BoolT)) "If predicate must be boolean")) - :ruleset type-analysis) -(rule ( - (= lhs (If pred inputs then else)) - (HasType pred (Base (BoolT))) - (HasType then ty) - (HasType else ty) - ) - ((HasType lhs ty)) - :ruleset type-analysis) - -(rule ( - (= lhs (If pred inputs then else)) - (HasType pred (Base (BoolT))) - (HasType then tya) - (HasType else tyb) - (!= tya tyb) - ) - ((panic "if branches had different types")) - :ruleset error-checking) - - - -(rule ((= lhs (Switch pred inputs branches))) - ((ExpectType pred (Base (IntT)) "Switch predicate must be integer")) - :ruleset type-analysis) - -; base case: single branch switch has type of branch -(rule ( - (= lhs (Switch pred inputs (Cons branch (Nil)))) - (HasType pred (Base (IntT))) - (HasType branch ty) - ) - ((HasType lhs ty)) - :ruleset type-analysis) - -; recursive case: peel off a layer -(rule ((Switch pred inputs (Cons branch rest))) - ((Switch pred inputs rest)) - :ruleset type-analysis) - -(rule ( - (= lhs (Switch pred inputs (Cons branch rest))) - (HasType pred (Base (IntT))) - (HasType branch ty) - (HasType (Switch pred inputs rest) ty) ; rest of the branches also have type ty - ) - ((HasType lhs ty)) - :ruleset type-analysis) - -(rule ( - (= lhs (Switch pred inputs (Cons branch rest))) - (HasType pred (Base (IntT))) - (HasType branch tya) - (HasType (Switch pred inputs rest) tyb) - (!= tya tyb) - ) - ((panic "switch branches had different types")) - :ruleset error-checking) - -(rule ((Arg ty ctx)) - ( - (HasType (Arg ty ctx) ty) - (HasArgType (Arg ty ctx) ty) - ) - :ruleset type-analysis) - - -(rule ( - (= lhs (DoWhile inp pred-body)) - (HasType inp (Base ty)) - ) - ((panic "loop input must be tuple")) - :ruleset error-checking) -(rule ( - (= lhs (DoWhile inp pred-body)) - (HasType inp (Base (PointerT ty))) - ) - ((panic "loop input must be tuple")) - :ruleset error-checking) -(rule ( - (= lhs (DoWhile inp pred-body)) - (HasType pred-body (Base ty)) - ) - ((panic "loop pred-body must be tuple")) - :ruleset error-checking) -(rule ( - (= lhs (DoWhile inp pred-body)) - (HasType pred-body (Base (PointerT ty))) - ) - ((panic "loop pred-body must be tuple")) - :ruleset error-checking) - -(rule ( - (= lhs (DoWhile inp pred-body)) - (HasType inp (TupleT tylist)) - ) - ((HasArgType pred-body (TupleT tylist))) - :ruleset type-analysis) - -(rule ((= lhs (DoWhile inp pred-body))) - ((ExpectType (Get pred-body 0) (Base (BoolT)) "loop pred must be bool")) - :ruleset type-analysis) - -(rule ( - (= lhs (DoWhile inp pred-body)) - (HasType inp (TupleT tylist)) ; input is a tuple - ; pred-body is a tuple where the first elt is a bool - ; and the rest of the list matches the input type - (HasType pred-body (TupleT (TCons (BoolT) tylist))) - ) - ((HasType lhs (TupleT tylist))) ; whole thing has type of inputs/outputs - :ruleset type-analysis) - -(rule ( - (= lhs (DoWhile inp pred-body)) - (HasType inp (TupleT in-tys)) - (HasType pred-body (TupleT (TCons (BoolT) out-tys))) - (!= in-tys out-tys) - ) - ((panic "input types and output types don't match")) - :ruleset error-checking) - -; ================================= -; Functions -; ================================= - -(rule ((= lhs (Function name in-ty out-ty body))) - ( - ; Arg should have the specified type in the body - (HasArgType body in-ty) - ; Expect the body to have the specified output type - (ExpectType body out-ty "Function body had wrong type") - ) - :ruleset type-analysis) - -(rule ( - (= lhs (Call name arg)) - (Function name in-ty out-ty body) - ) - ; Expect the arg to have the right type for the function - ((ExpectType arg in-ty "function called with wrong arg type")) - :ruleset type-analysis) - -(rule ( - (= lhs (Call name arg)) - (Function name in-ty out-ty body) - (HasType arg in-ty) - ; We don't need to check the type of the function body, it will - ; be checked elsewhere. If we did require (HasType body out-ty), - ; recursive functions would not get assigned a type. - ) - ((HasType lhs out-ty)) - :ruleset type-analysis) - -; find which types are pure -(relation PureBaseType (BaseType)) -(relation PureType (Type)) -(relation PureTypeList (TypeList)) - -(PureBaseType (IntT)) -(PureBaseType (BoolT)) -(rule ((Base ty) - (PureBaseType ty)) - ((PureType (Base ty))) - :ruleset type-analysis) -(rule ((TupleT tylist) - (PureTypeList tylist)) - ((PureType (TupleT tylist))) - :ruleset type-analysis) -(rule ((TNil)) - ((PureTypeList (TNil))) - :ruleset type-analysis) -(rule ((TCons hd tl) - (PureBaseType hd) - (PureTypeList tl)) - ((PureTypeList (TCons hd tl))) - :ruleset type-analysis) - -(function ListExpr-length (ListExpr) i64) -(function ListExpr-ith (ListExpr i64) Expr :unextractable) -(function ListExpr-suffix (ListExpr i64) ListExpr :unextractable) -(function Append (ListExpr Expr) ListExpr :unextractable) - -(rule ((Switch pred inputs branch)) ((union (ListExpr-suffix branch 0) branch)) :ruleset always-run) - -(rule ((= (ListExpr-suffix top n) (Cons hd tl))) - ((union (ListExpr-ith top n) hd) - (union (ListExpr-suffix top (+ n 1)) tl)) :ruleset always-run) - -(rule ((= (ListExpr-suffix list n) (Nil))) - ((set (ListExpr-length list) n)) :ruleset always-run) - -(rewrite (Append (Cons a b) e) - (Cons a (Append b e)) - :ruleset always-run) -(rewrite (Append (Nil) e) - (Cons e (Nil)) - :ruleset always-run) - -(function tuple-length (Expr) i64 :unextractable) - -(rule ((HasType expr (TupleT tl)) - (= len (TypeList-length tl))) - ((set (tuple-length expr) len)) :ruleset always-run) - -;; Create a Get for every index, and rewrite it to see through Concat -(rule ((Single expr)) ((union (Get (Single expr) 0) expr)) :ruleset always-run) -;; initial get -(rule ((> (tuple-length tuple) 0)) - ((Get tuple 0)) - :ruleset always-run) -;; next get -(rule ((= len (tuple-length tuple)) - (= ith (Get tuple i)) - (< (+ i 1) len) - ) - ((Get tuple (+ 1 i))) - :ruleset always-run) - -;; descend left -(rule ((Get (Concat expr1 expr2) i) - (= (tuple-length expr1) len1) - (< i len1)) - ((union (Get (Concat expr1 expr2) i) - (Get expr1 i))) - :ruleset always-run) -;; descend right -(rule ((Get (Concat expr1 expr2) i) - (= (tuple-length expr1) len1) - (>= i len1)) - ((union (Get (Concat expr1 expr2) i) - (Get expr2 (- i len1)))) - :ruleset always-run) - - -;; A temporary context. -;; Be sure to delete at the end of all actions or else!!! -;; This is safer than using a persistant context, since we may miss an important part of the query. -(function TmpCtx () Assumption) - -(rule ((TmpCtx)) - ((panic "TmpCtx should not exist outside rule body")) - :ruleset always-run) - - -(ruleset subsume-after-helpers) -;; After running the `saturating` ruleset, these if statements can be subsumed -(relation ToSubsumeIf (Expr Expr Expr Expr)) -; (rule ((ToSubsumeIf a b c d)) -; ((subsume (If a b c d))) -; :ruleset subsume-after-helpers) - - - -(relation ExprIsValid (Expr)) -(relation ListExprIsValid (ListExpr)) -(rule ((ExprIsValid (Function _name _tyin _tyout _out))) ((ExprIsValid _out)) :ruleset always-run) -(rule ((ExprIsValid (Top _op _x _y _z))) ((ExprIsValid _x) -(ExprIsValid _y) -(ExprIsValid _z)) :ruleset always-run) -(rule ((ExprIsValid (Bop _op _x _y))) ((ExprIsValid _x) -(ExprIsValid _y)) :ruleset always-run) -(rule ((ExprIsValid (Uop _op _x))) ((ExprIsValid _x)) :ruleset always-run) -(rule ((ExprIsValid (Get _tup _i))) ((ExprIsValid _tup)) :ruleset always-run) -(rule ((ExprIsValid (Concat _x _y))) ((ExprIsValid _x) -(ExprIsValid _y)) :ruleset always-run) -(rule ((ExprIsValid (Single _x))) ((ExprIsValid _x)) :ruleset always-run) -(rule ((ExprIsValid (Switch _pred _inputs _branches))) ((ExprIsValid _pred) -(ExprIsValid _inputs) -(ListExprIsValid _branches)) :ruleset always-run) -(rule ((ExprIsValid (If _pred _input _then _else))) ((ExprIsValid _pred) -(ExprIsValid _input) -(ExprIsValid _then) -(ExprIsValid _else)) :ruleset always-run) -(rule ((ExprIsValid (DoWhile _in _pred-and-output))) ((ExprIsValid _in) -(ExprIsValid _pred-and-output)) :ruleset always-run) -(rule ((ExprIsValid (Call _func _arg))) ((ExprIsValid _arg)) :ruleset always-run) -(rule ((ListExprIsValid (Cons _hd _tl))) ((ExprIsValid _hd) -(ListExprIsValid _tl)) :ruleset always-run) -(rule ((ExprIsValid (Alloc _id _e _state _ty))) ((ExprIsValid _e) -(ExprIsValid _state)) :ruleset always-run) -(relation ExprIsResolved (Expr)) -(relation ListExprIsResolved (ListExpr)) -(rule ((= lhs (Function _name _tyin _tyout _out)) (ExprIsResolved _out)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Const _n _ty _ctx)) ) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Top _op _x _y _z)) (ExprIsResolved _x) -(ExprIsResolved _y) -(ExprIsResolved _z)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Bop _op _x _y)) (ExprIsResolved _x) -(ExprIsResolved _y)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Uop _op _x)) (ExprIsResolved _x)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Get _tup _i)) (ExprIsResolved _tup)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Concat _x _y)) (ExprIsResolved _x) -(ExprIsResolved _y)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Single _x)) (ExprIsResolved _x)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Switch _pred _inputs _branches)) (ExprIsResolved _pred) -(ExprIsResolved _inputs) -(ListExprIsResolved _branches)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (If _pred _input _then _else)) (ExprIsResolved _pred) -(ExprIsResolved _input) -(ExprIsResolved _then) -(ExprIsResolved _else)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (DoWhile _in _pred-and-output)) (ExprIsResolved _in) -(ExprIsResolved _pred-and-output)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Arg _ty _ctx)) ) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Call _func _arg)) (ExprIsResolved _arg)) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Empty _ty _ctx)) ) ((ExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Cons _hd _tl)) (ExprIsResolved _hd) -(ListExprIsResolved _tl)) ((ListExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Nil)) ) ((ListExprIsResolved lhs)) :ruleset always-run) -(rule ((= lhs (Alloc _id _e _state _ty)) (ExprIsResolved _e) -(ExprIsResolved _state)) ((ExprIsResolved lhs)) :ruleset always-run) -(relation BodyContainsExpr (Expr Expr)) -(relation BodyContainsListExpr (Expr ListExpr)) -(rule ((Function _name _tyin _tyout _out)) ((BodyContainsExpr (Function _name _tyin _tyout _out) _out)) :ruleset always-run) -(rule ((If _pred _input _then _else)) ((BodyContainsExpr (If _pred _input _then _else) _then) (BodyContainsExpr (If _pred _input _then _else) _else)) :ruleset always-run) -(rule ((DoWhile _in _pred-and-output)) ((BodyContainsExpr (DoWhile _in _pred-and-output) _pred-and-output)) :ruleset always-run) -(rule ((BodyContainsExpr body (Top _op _x _y _z))) ((BodyContainsExpr body _x) (BodyContainsExpr body _y) (BodyContainsExpr body _z)) :ruleset always-run) -(rule ((BodyContainsExpr body (Bop _op _x _y))) ((BodyContainsExpr body _x) (BodyContainsExpr body _y)) :ruleset always-run) -(rule ((BodyContainsExpr body (Uop _op _x))) ((BodyContainsExpr body _x)) :ruleset always-run) -(rule ((BodyContainsExpr body (Get _tup _i))) ((BodyContainsExpr body _tup)) :ruleset always-run) -(rule ((BodyContainsExpr body (Concat _x _y))) ((BodyContainsExpr body _x) (BodyContainsExpr body _y)) :ruleset always-run) -(rule ((BodyContainsExpr body (Single _x))) ((BodyContainsExpr body _x)) :ruleset always-run) -(rule ((BodyContainsExpr body (Switch _pred _inputs _branches))) ((BodyContainsExpr body _pred) (BodyContainsExpr body _inputs)) :ruleset always-run) -(rule ((BodyContainsExpr body (If _pred _input _then _else))) ((BodyContainsExpr body _pred) (BodyContainsExpr body _input)) :ruleset always-run) -(rule ((BodyContainsExpr body (DoWhile _in _pred-and-output))) ((BodyContainsExpr body _in)) :ruleset always-run) -(rule ((BodyContainsExpr body (Call _func _arg))) ((BodyContainsExpr body _arg)) :ruleset always-run) -(rule ((BodyContainsListExpr body (Cons _hd _tl))) ((BodyContainsExpr body _hd)) :ruleset always-run) -(rule ((BodyContainsExpr body (Alloc _id _e _state _ty))) ((BodyContainsExpr body _e) (BodyContainsExpr body _state)) :ruleset always-run) - - (relation ExprIsPure (Expr)) - (relation ListExprIsPure (ListExpr)) - (relation BinaryOpIsPure (BinaryOp)) - (relation UnaryOpIsPure (UnaryOp)) - (relation TopIsPure (TernaryOp)) -(TopIsPure (Select)) -(BinaryOpIsPure (Add)) -(BinaryOpIsPure (Sub)) -(BinaryOpIsPure (Mul)) -(BinaryOpIsPure (Div)) -(BinaryOpIsPure (Eq)) -(BinaryOpIsPure (LessThan)) -(BinaryOpIsPure (GreaterThan)) -(BinaryOpIsPure (LessEq)) -(BinaryOpIsPure (GreaterEq)) -(BinaryOpIsPure (FAdd)) -(BinaryOpIsPure (FSub)) -(BinaryOpIsPure (FMul)) -(BinaryOpIsPure (FDiv)) -(BinaryOpIsPure (FEq)) -(BinaryOpIsPure (FLessThan)) -(BinaryOpIsPure (FGreaterThan)) -(BinaryOpIsPure (FLessEq)) -(BinaryOpIsPure (FGreaterEq)) -(BinaryOpIsPure (And)) -(BinaryOpIsPure (Or)) -(BinaryOpIsPure (PtrAdd)) -(UnaryOpIsPure (Not)) - - (rule ((Function _name _tyin _tyout _out) (ExprIsPure _out)) - ((ExprIsPure (Function _name _tyin _tyout _out))) - :ruleset always-run) - - (rule ((Const _n _ty _ctx)) - ((ExprIsPure (Const _n _ty _ctx))) - :ruleset always-run) - - (rule ((Top _op _x _y _z) (ExprIsPure _x) (ExprIsPure _y) (ExprIsPure _z)) - ((ExprIsPure (Top _op _x _y _z))) - :ruleset always-run) - - (rule ((Bop _op _x _y) (BinaryOpIsPure _op) (ExprIsPure _x) (ExprIsPure _y)) - ((ExprIsPure (Bop _op _x _y))) - :ruleset always-run) - - (rule ((Uop _op _x) (UnaryOpIsPure _op) (ExprIsPure _x)) - ((ExprIsPure (Uop _op _x))) - :ruleset always-run) - - (rule ((Get _tup _i) (ExprIsPure _tup)) - ((ExprIsPure (Get _tup _i))) - :ruleset always-run) - - (rule ((Concat _x _y) (ExprIsPure _x) (ExprIsPure _y)) - ((ExprIsPure (Concat _x _y))) - :ruleset always-run) - - (rule ((Single _x) (ExprIsPure _x)) - ((ExprIsPure (Single _x))) - :ruleset always-run) - - (rule ((Switch _pred _inputs _branches) (ExprIsPure _pred) (ExprIsPure _inputs) (ListExprIsPure _branches)) - ((ExprIsPure (Switch _pred _inputs _branches))) - :ruleset always-run) - - (rule ((If _pred _input _then _else) (ExprIsPure _pred) (ExprIsPure _input) (ExprIsPure _then) (ExprIsPure _else)) - ((ExprIsPure (If _pred _input _then _else))) - :ruleset always-run) - - (rule ((DoWhile _in _pred-and-output) (ExprIsPure _in) (ExprIsPure _pred-and-output)) - ((ExprIsPure (DoWhile _in _pred-and-output))) - :ruleset always-run) - - (rule ((Arg _ty _ctx)) - ((ExprIsPure (Arg _ty _ctx))) - :ruleset always-run) - - (rule ((Call _f _arg) (ExprIsPure _arg) (ExprIsPure (Function _f inty outty out))) - ((ExprIsPure (Call _f _arg))) - :ruleset always-run) - - (rule ((Empty _ty _ctx)) - ((ExprIsPure (Empty _ty _ctx))) - :ruleset always-run) - - (rule ((Cons _hd _tl) (ExprIsPure _hd) (ListExprIsPure _tl)) - ((ListExprIsPure (Cons _hd _tl))) - :ruleset always-run) - - (rule ((Nil)) - ((ListExprIsPure (Nil))) - :ruleset always-run) - -; This file provides AddContext, a helpers that copies a sub-egraph into -; a new one with a new context. -; Users of AddContext can specify how deeply to do this copy. - - -(ruleset context) - -(function AddContext (Assumption Expr) Expr :unextractable) -(function AddContextList (Assumption ListExpr) ListExpr :unextractable) - -;; ################################ saturation - -;; Adding context a second time does nothing, so union -(rule - ((= lhs (AddContext ctx inner)) - (= inner (AddContext ctx expr))) - ((union lhs inner)) - :ruleset context) - - -;; ############################## Base cases- leaf nodes - -;; replace existing contexts that are around leaf nodes -;; AddContext assumes the new context is more specific than the old one -(rule ((= lhs (AddContext ctx (Arg ty oldctx)))) - ((union lhs (Arg ty ctx))) - :ruleset context) -(rule ((= lhs (AddContext ctx (Const c ty oldctx)))) - ((union lhs (Const c ty ctx))) - :ruleset context) -(rule ((= lhs (AddContext ctx (Empty ty oldctx)))) - ((union lhs (Empty ty ctx))) - :ruleset context) - - - - -;; ######################################### Operators -(rewrite (AddContext ctx (Bop op c1 c2)) - (Bop op - (AddContext ctx c1) - (AddContext ctx c2)) - :ruleset context) -(rewrite (AddContext ctx (Uop op c1)) - (Uop op (AddContext ctx c1)) - :ruleset context) -(rewrite (AddContext ctx (Get c1 index)) - (Get (AddContext ctx c1) index) - :ruleset context) -(rewrite (AddContext ctx (Alloc id c1 state ty)) - (Alloc id (AddContext ctx c1) (AddContext ctx state) ty) - :ruleset context) -(rewrite (AddContext ctx (Call name c1)) - (Call name (AddContext ctx c1)) - :ruleset context) - -(rewrite (AddContext ctx (Single c1)) - (Single (AddContext ctx c1)) - :ruleset context) -(rewrite (AddContext ctx (Concat c1 c2)) - (Concat - (AddContext ctx c1) - (AddContext ctx c2)) - :ruleset context) - -;; ################################### List operators - -(rewrite (AddContextList ctx (Nil)) - (Nil) - :ruleset context) - -(rewrite (AddContextList ctx (Cons c1 rest)) - (Cons (AddContext ctx c1) - (AddContextList ctx rest)) - :ruleset context) - - -;; ########################################## Control flow -(rewrite (AddContext ctx (Switch pred inputs branches)) - (Switch (AddContext ctx pred) - (AddContext ctx inputs) - branches) - :ruleset context) - -;; For stop at region, still add context to inputs -(rule ((= lhs (AddContext ctx (If pred inputs c1 c2)))) - ((union lhs - (If (AddContext ctx pred) - (AddContext ctx inputs) - c1 - c2))) - :ruleset context) - - -;; For stop at loop, still add context to inputs -(rule ((= lhs (AddContext ctx (DoWhile inputs outputs)))) - ((union lhs - (DoWhile - (AddContext ctx inputs) - outputs))) - :ruleset context) - - -;; Substitution rules allow for substituting some new expression for the argument -;; in some new context. -;; It performs the substitution, copying over the equalities from the original eclass. -;; It only places context on the leaf nodes. - -(ruleset subst) -(ruleset apply-subst-unions) -(ruleset cleanup-subst) - -;; (Subst assumption to in) substitutes `to` for `(Arg ty)` in `in`. -;; It also replaces the leaf context in `to` with `assumption` using `AddContext`. -;; `assumption` *justifies* this substitution, as the context that the result is used in. -;; In other words, it must refine the equivalence relation of `in` with `to` as the argument. -(function Subst (Assumption Expr Expr) Expr ) - -;; Used to delay unions for the subst ruleset. -;; This is necessary because substitution may not terminate if it can -;; observe its own results- it may create infinitly large terms. -;; Instead, we phase substitution by delaying resulting unions in this table. -;; After applying this table, substitutions and this table are cleared. -(function DelayedSubstUnion (Expr Expr) Expr ) - -;; add a type rule to get the arg type of a substitution -;; this enables nested substitutions -(rule ((= lhs (Subst assum to in)) - (HasArgType to ty)) - ((HasArgType lhs ty)) - :ruleset subst) - -;; leaf node with context -;; replace this context- subst assumes the context is more specific -(rule ((= lhs (Subst assum to (Arg ty oldctx))) - ) - ;; add the assumption `to` - ((DelayedSubstUnion lhs (AddContext assum to))) - :ruleset subst) -(rule ((= lhs (Subst assum to (Const c ty oldctx))) - (HasArgType to newty)) - ((DelayedSubstUnion lhs (Const c newty assum))) - :ruleset subst) -(rule ((= lhs (Subst assum to (Empty ty oldctx))) - (HasArgType to newty)) - ((DelayedSubstUnion lhs (Empty newty assum))) - :ruleset subst) - -;; Operators -(rule ((= lhs (Subst assum to (Bop op c1 c2))) - (ExprIsResolved (Bop op c1 c2))) - ((DelayedSubstUnion lhs - (Bop op (Subst assum to c1) - (Subst assum to c2)))) - :ruleset subst) -(rule ((= lhs (Subst assum to (Uop op c1))) - (ExprIsResolved (Uop op c1))) - ((DelayedSubstUnion lhs - (Uop op (Subst assum to c1)))) - :ruleset subst) - -(rule ((= lhs (Subst assum to (Get c1 index))) - (ExprIsResolved (Get c1 index))) - ((DelayedSubstUnion lhs - (Get (Subst assum to c1) index))) - :ruleset subst) -(rule ((= lhs (Subst assum to (Alloc id c1 c2 ty))) - (ExprIsResolved (Alloc id c1 c2 ty))) - ((DelayedSubstUnion lhs - (Alloc id (Subst assum to c1) - (Subst assum to c2) - ty))) - :ruleset subst) -(rule ((= lhs (Subst assum to (Call name c1))) - (ExprIsResolved (Call name c1))) - ((DelayedSubstUnion lhs - (Call name (Subst assum to c1)))) - :ruleset subst) - - -;; Tuple operators -(rule ((= lhs (Subst assum to (Single c1))) - (ExprIsResolved (Single c1))) - ((DelayedSubstUnion lhs - (Single (Subst assum to c1)))) - :ruleset subst) -(rule ((= lhs (Subst assum to (Concat c1 c2))) - (ExprIsResolved (Concat c1 c2))) - ((DelayedSubstUnion lhs - (Concat (Subst assum to c1) - (Subst assum to c2)))) - :ruleset subst) - -;; Control flow -(rule ((= lhs (Subst assum to inner)) - (= inner (Switch pred inputs c1)) - (ExprIsResolved inner)) - ((DelayedSubstUnion lhs - (Switch (Subst assum to pred) - (Subst assum to inputs) - c1))) - :ruleset subst) -(rule ((= lhs (Subst assum to inner)) - (= inner (If pred inputs c1 c2)) - (ExprIsResolved inner)) - ((DelayedSubstUnion lhs - (If (Subst assum to pred) - (Subst assum to inputs) - c1 - c2))) - :ruleset subst) -(rule ((= lhs (Subst assum to (DoWhile in out))) - (ExprIsResolved (DoWhile in out))) - ((DelayedSubstUnion lhs - (DoWhile (Subst assum to in) - out))) - :ruleset subst) - -;; substitute into function (convenience for testing) -(rewrite (Subst assum to (Function name inty outty body)) - (Function name inty outty (Subst assum to body)) - :when ((ExprIsResolved body)) - :ruleset subst) - - - -;; ########################### Apply subst unions - -(rule ((DelayedSubstUnion lhs rhs)) - ((union lhs rhs)) - :ruleset apply-subst-unions) - - -;; ########################### Cleanup subst and DelayedSubstUnion - -(rule ((DelayedSubstUnion lhs rhs)) - ((subsume (DelayedSubstUnion lhs rhs))) - :ruleset cleanup-subst) - -; this cleanup is important- if we don't subsume these substitutions, they -; may oberve their own results and create infinitely sized terms. -; ex: get(parallel!(arg(), int(2)), 0) ignores the first element of the tuple -; so it's equivalent to infinite other times with any other value as the first element of the tuple. -; Check ExprIsResolved to confirm that the substitution finished (all sub-substitutions are done). -(rule ((ExprIsResolved (Subst assum to in))) - ((subsume (Subst assum to in))) - :ruleset cleanup-subst) - -; We only have context for Exprs, not ListExprs. -(relation ContextOf (Expr Assumption)) - -(rule ((Arg ty ctx)) - ((ContextOf (Arg ty ctx) ctx)) - :ruleset always-run) -(rule ((Const c ty ctx)) - ((ContextOf (Const c ty ctx) ctx)) - :ruleset always-run) -(rule ((Empty ty ctx)) - ((ContextOf (Empty ty ctx) ctx)) - :ruleset always-run) - -; Error checking - each expr should only have a single context -(rule ((ContextOf x ctx1) - (ContextOf x ctx2) - (!= ctx1 ctx2)) - ( - (panic "Equivalent expressions have nonequivalent context, breaking the single context invariant.") - ) - :ruleset error-checking) - - -(rule ((Top op x y z) (ContextOf x ctx)) - ((ContextOf (Top op x y z) ctx)) :ruleset always-run) - -(rule ((Top op x y z) (ContextOf y ctx)) - ((ContextOf (Top op x y z) ctx)) :ruleset always-run) - -(rule ((Top op x y z) (ContextOf z ctx)) - ((ContextOf (Top op x y z) ctx)) :ruleset always-run) - -(rule ((Bop op x y) (ContextOf x ctx)) - ((ContextOf (Bop op x y) ctx)) :ruleset always-run) - -(rule ((Bop op x y) (ContextOf y ctx)) - ((ContextOf (Bop op x y) ctx)) :ruleset always-run) - -(rule ((Uop op x) (ContextOf x ctx)) - ((ContextOf (Uop op x) ctx)) :ruleset always-run) - -(rule ((Get tup i) (ContextOf tup ctx)) - ((ContextOf (Get tup i) ctx)) :ruleset always-run) - -(rule ((Concat x y) (ContextOf x ctx)) - ((ContextOf (Concat x y) ctx)) :ruleset always-run) - -(rule ((Concat x y) (ContextOf y ctx)) - ((ContextOf (Concat x y) ctx)) :ruleset always-run) - -(rule ((Single x) (ContextOf x ctx)) - ((ContextOf (Single x) ctx)) :ruleset always-run) - -(rule ((Switch pred inputs branches) (ContextOf pred ctx)) - ((ContextOf (Switch pred inputs branches) ctx)) :ruleset always-run) - -(rule ((If pred inputs then else) (ContextOf pred ctx)) - ((ContextOf (If pred inputs then else) ctx)) :ruleset always-run) - -(rule ((If pred inputs then else) (ContextOf inputs ctx)) - ((ContextOf (If pred inputs then else) ctx)) :ruleset always-run) - -(rule ((DoWhile in pred-and-output) (ContextOf in ctx)) - ((ContextOf (DoWhile in pred-and-output) ctx)) :ruleset always-run) - -(rule ((Call func arg) (ContextOf arg ctx)) - ((ContextOf (Call func arg) ctx)) :ruleset always-run) - -(rule ((Alloc amt e state ty) (ContextOf e ctx)) - ((ContextOf (Alloc amt e state ty) ctx)) :ruleset always-run) - -(rule ((Alloc amt e state ty) (ContextOf state ctx)) - ((ContextOf (Alloc amt e state ty) ctx)) :ruleset always-run) - -(ruleset canon) - -; Commutativity -(rewrite (Bop (Add) x y) (Bop (Add) y x) :ruleset canon) -(rewrite (Bop (Mul) x y) (Bop (Mul) y x) :ruleset canon) -(rewrite (Bop (Eq) x y) (Bop (Eq) y x) :ruleset canon) -(rewrite (Bop (And) x y) (Bop (And) y x) :ruleset canon) -(rewrite (Bop (Or) x y) (Bop (Or) y x) :ruleset canon) - -; Canonicalize to < -; x > y ==> y < x -(rewrite (Bop (GreaterThan) x y) (Bop (LessThan) y x) :ruleset canon) - -; x >= y ==> y < x + 1 -; x >= y ==> y - 1 < x -(rule ( - (= lhs (Bop (GreaterEq) x y)) - (HasArgType x ty) - (ContextOf lhs ctx) - ) - ( - (union lhs (Bop (LessThan) y (Bop (Add) x (Const (Int 1) ty ctx)))) - (union lhs (Bop (LessThan) (Bop (Sub) y (Const (Int 1) ty ctx)) x)) - ) - :ruleset canon) - -; x <= y ==> x < y + 1 -; x <= y ==> x - 1 < y -(rule ( - (= lhs (Bop (LessEq) x y)) - (HasArgType y ty) - (ContextOf lhs ctx) - ) - ( - (union lhs (Bop (LessThan) x (Bop (Add) y (Const (Int 1) ty ctx)))) - (union lhs (Bop (LessThan) (Bop (Sub) x (Const (Int 1) ty ctx)) y)) - ) - :ruleset canon) - - -; Make Concats right-deep -(rewrite (Concat (Concat a b) c) - (Concat a (Concat b c)) - :ruleset always-run) -; Simplify Concat's with empty -(rewrite (Concat (Empty ty ctx) x) - x - :ruleset always-run) -(rewrite (Concat x (Empty ty ctx)) - x - :ruleset always-run) - -; Make a tuple that is a sub-range of another tuple -; tuple start len -(function SubTuple (Expr i64 i64) Expr :unextractable) - -(rewrite (SubTuple expr x 0) - (Empty ty ctx) - :when ((HasArgType expr ty) (ContextOf expr ctx)) - :ruleset always-run) - -(rewrite (SubTuple expr x 1) - (Single (Get expr x)) - :ruleset always-run) - -(rewrite (SubTuple expr a b) - (Concat (Single (Get expr a)) (SubTuple expr (+ a 1) (- b 1))) - :when ((> b 1)) - :ruleset always-run) - -; Helper functions to remove one element from a tuple or type list -; tuple idx -(function TupleRemoveAt (Expr i64) Expr :unextractable) -(function TypeListRemoveAt (TypeList i64) TypeList :unextractable) - -(rewrite (TupleRemoveAt tuple idx) - (Concat (SubTuple tuple 0 idx) - (SubTuple tuple (+ idx 1) (- len (+ idx 1)))) - :when ((= len (tuple-length tuple))) - :ruleset always-run) - -(rewrite (TypeListRemoveAt (TNil) _idx) (TNil) :ruleset always-run) -(rewrite (TypeListRemoveAt (TCons x xs) 0 ) xs :ruleset always-run) -(rewrite (TypeListRemoveAt (TCons x xs) idx) - (TCons x (TypeListRemoveAt xs (- idx 1))) - :when ((> idx 0)) - :ruleset always-run) - -;; Compute the tree size of program, not dag size -(function Expr-size (Expr) i64 :unextractable :merge (min old new) ) -(function ListExpr-size (ListExpr) i64 :unextractable :merge (min old new)) - -(rule ((= expr (Function name tyin tyout out)) - (= sum (Expr-size out))) - ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) - -(rule ((= expr (Const n ty assum))) - ((set (Expr-size expr) 1)) :ruleset always-run) - -(rule ((= expr (Bop op x y)) - (= sum (+ (Expr-size y) (Expr-size x)))) - ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) - -(rule ((= expr (Uop op x)) - (= sum (Expr-size x))) - ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) - -(rule ((= expr (Get tup i)) - (= sum (Expr-size tup))) - ((set (Expr-size expr) sum)) :ruleset always-run) - -(rule ((= expr (Concat x y)) - (= sum (+ (Expr-size y) (Expr-size x)))) - ((set (Expr-size expr) sum)) :ruleset always-run) - -(rule ((= expr (Single x)) - (= sum (Expr-size x))) - ((set (Expr-size expr) sum)) :ruleset always-run) - -(rule ((= expr (Switch pred inputs branches)) - (= sum (+ (Expr-size inputs) (+ (ListExpr-size branches) (Expr-size pred))))) - ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) - -(rule ((= expr (If pred inputs then else)) - (= sum (+ (Expr-size inputs) (+ (Expr-size else) (+ (Expr-size then) (Expr-size pred)))))) - ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) - -(rule ((= expr (DoWhile in pred-and-output)) - (= sum (+ (Expr-size pred-and-output) (Expr-size in)))) - ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) - -(rule ((= expr (Arg ty assum))) - ((set (Expr-size expr) 1)) :ruleset always-run) - -(rule ((= expr (Call func arg)) - (= sum (Expr-size arg))) - ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) - -(rule ((Empty ty assum)) ((set (Expr-size (Empty ty assum)) 0)) :ruleset always-run) - -(rule ((= expr (Cons hd tl)) - (= sum (+ (ListExpr-size tl) (Expr-size hd)))) - ((set (ListExpr-size expr) sum)) :ruleset always-run) - -(rule ((Nil)) - ((set (ListExpr-size (Nil)) 0)) :ruleset always-run) - -(rule ((= expr (Alloc id e state ty)) ;; do state edge's expr should be counted? - (= sum (Expr-size e))) - ((set (Expr-size expr) (+ sum 1))) :ruleset always-run) -;; Like Subst but for dropping inputs to a region -;; See subst.egg for more implementation documentation - -(ruleset drop) -(ruleset apply-drop-unions) -(ruleset cleanup-drop) - -;; (DropAt ctx idx in) removes all references to `(Get (Arg ...) idx)` in `in`. -;; It also replaces the leaf contexts with `ctx` and fixes up argument types, -;; as well as updating `(Get (Arg ...) j)` to `(Get (Arg ...) (- j 1))` for j > idx. -(function DropAt (Assumption i64 Expr) Expr :unextractable) -(function DelayedDropUnion (Expr Expr) Expr :unextractable) - -;; Helper that precomputes the arg type that we need -(function DropAtInternal (Type Assumption i64 Expr) Expr :unextractable) -(rule ((= lhs (DropAt ctx idx in)) - (HasArgType in (TupleT oldty))) - - ((let newty (TupleT (TypeListRemoveAt oldty idx))) - (union lhs (DropAtInternal newty ctx idx in))) - :ruleset drop) - -;; Leaves -(rule ((= lhs (DropAtInternal newty newctx idx (Const c oldty oldctx)))) - ((DelayedDropUnion lhs (Const c newty newctx))) - :ruleset drop) -(rule ((= lhs (DropAtInternal newty newctx idx (Empty oldty oldctx)))) - ((DelayedDropUnion lhs (Empty newty newctx))) - :ruleset drop) -; get stuck on purpose if `i = idx` or if we find a bare `Arg` -(rule ((= lhs (DropAtInternal newty newctx idx (Get (Arg oldty oldctx) i))) - (< i idx)) - ((DelayedDropUnion lhs (Get (Arg newty newctx) i))) - :ruleset drop) -(rule ((= lhs (DropAtInternal newty newctx idx (Get (Arg oldty oldctx) i))) - (> i idx)) - ((DelayedDropUnion lhs (Get (Arg newty newctx) (- i 1)))) - :ruleset drop) - -;; Operators -(rule ((= lhs (DropAtInternal newty newctx idx (Bop op c1 c2))) - (ExprIsResolved (Bop op c1 c2))) - ((DelayedDropUnion lhs (Bop op - (DropAtInternal newty newctx idx c1) - (DropAtInternal newty newctx idx c2)))) - :ruleset drop) - -(rule ((= lhs (DropAtInternal newty newctx idx (Uop op c1))) - (ExprIsResolved (Uop op c1))) - ((DelayedDropUnion lhs (Uop op - (DropAtInternal newty newctx idx c1)))) - :ruleset drop) - -;; this is okay because we get stuck at `Arg`s -(rule ((= lhs (DropAtInternal newty newctx idx (Get c1 index))) - (ExprIsResolved (Get c1 index))) - ((DelayedDropUnion lhs (Get - (DropAtInternal newty newctx idx c1) - index))) - :ruleset drop) - -(rule ((= lhs (DropAtInternal newty newctx idx (Alloc id c1 c2 ty))) - (ExprIsResolved (Alloc id c1 c2 ty))) - ((DelayedDropUnion lhs (Alloc id - (DropAtInternal newty newctx idx c1) - (DropAtInternal newty newctx idx c2) - ty))) - :ruleset drop) - -(rule ((= lhs (DropAtInternal newty newctx idx (Call name c1))) - (ExprIsResolved (Call name c1))) - ((DelayedDropUnion lhs (Call name - (DropAtInternal newty newctx idx c1)))) - :ruleset drop) - -;; Tuple operators -(rule ((= lhs (DropAtInternal newty newctx idx (Single c1))) - (ExprIsResolved (Single c1))) - ((DelayedDropUnion lhs (Single - (DropAtInternal newty newctx idx c1)))) - :ruleset drop) - -(rule ((= lhs (DropAtInternal newty newctx idx (Concat c1 c2))) - (ExprIsResolved (Concat c1 c2))) - ((DelayedDropUnion lhs (Concat - (DropAtInternal newty newctx idx c1) - (DropAtInternal newty newctx idx c2)))) - :ruleset drop) - -;; Control flow -(rule ((= lhs (DropAtInternal newty newctx idx (Switch pred inputs c1))) - (ExprIsResolved (Switch pred inputs c1))) - ((DelayedDropUnion lhs (Switch - (DropAtInternal newty newctx idx pred) - (DropAtInternal newty newctx idx inputs) - c1))) - :ruleset drop) - -(rule ((= lhs (DropAtInternal newty newctx idx (If pred inputs c1 c2))) - (ExprIsResolved (If pred inputs c1 c2))) - ((DelayedDropUnion lhs (If - (DropAtInternal newty newctx idx pred) - (DropAtInternal newty newctx idx inputs) - c1 - c2))) - :ruleset drop) - -(rule ((= lhs (DropAtInternal newty newctx idx (DoWhile in out))) - (ExprIsResolved (DoWhile in out))) - ((DelayedDropUnion lhs (DoWhile - (DropAtInternal newty newctx idx in) - out))) - :ruleset drop) - -(rewrite (DropAtInternal newty newctx idx (Function name inty outty body)) - (Function name inty outty (DropAtInternal newty newctx idx body)) - :when ((ExprIsResolved body)) - :ruleset drop) - - - -;; ########################### Apply drop unions - -(rule ((DelayedDropUnion lhs rhs)) - ((union lhs rhs)) - :ruleset apply-drop-unions) - -;; ########################### Cleanup Dropat, DropAtInternal and DelayedDropUnion - -(rule ((ExprIsResolved (DropAt newctx idx in))) - ((subsume (DropAt newctx idx in))) - :ruleset cleanup-drop) - -(rule ((ExprIsResolved (DropAtInternal newty newctx idx in))) - ((subsume (DropAtInternal newty newctx idx in))) - :ruleset cleanup-drop) - -(rule ((DelayedDropUnion lhs rhs)) - ((subsume (DelayedDropUnion lhs rhs))) - :ruleset cleanup-drop) - -(ruleset interval-analysis) - -(datatype Bound - (IntB i64) - (BoolB bool) - (bound-max Bound Bound) - (bound-min Bound Bound)) - -; bound tables -(function lo-bound (Expr) Bound :unextractable :merge (bound-max old new)) -(function hi-bound (Expr) Bound :unextractable :merge (bound-min old new)) - -; if lo > hi, panic -; We can't run these rules because unreachable branches may have impossible intervals -; Consider re-enabling these rules if we implement an is-reachable analysis -; (rule ( -; (= (IntB lo) (lo-bound expr)) -; (= (IntB hi) (hi-bound expr)) -; (> lo hi) -; ) -; ((panic "lo bound greater than hi bound")) -; :ruleset interval-analysis) -; (rule ( -; (= (BoolB true) (lo-bound expr)) -; (= (BoolB false) (hi-bound expr)) -; ) -; ((panic "lo bound greater than hi bound")) -; :ruleset interval-analysis) - -; combinators -(rewrite (bound-max (IntB x) (IntB y)) - (IntB (max x y)) - :ruleset interval-analysis) -(rewrite (bound-min (IntB x) (IntB y)) - (IntB (min x y)) - :ruleset interval-analysis) -(rewrite (bound-max (BoolB x) (BoolB y)) - (BoolB (or x y)) - :ruleset interval-analysis) -(rewrite (bound-min (BoolB x) (BoolB y)) - (BoolB (and x y)) - :ruleset interval-analysis) - -; ================================= -; Constants -; ================================= -(rule ((= lhs (Const (Int x) ty ctx))) - ( - (set (lo-bound lhs) (IntB x)) - (set (hi-bound lhs) (IntB x)) - ) - :ruleset interval-analysis) - -(rule ((= lhs (Const (Bool x) ty ctx))) - ( - (set (lo-bound lhs) (BoolB x)) - (set (hi-bound lhs) (BoolB x)) - ) - :ruleset interval-analysis) - -; ================================= -; Constant Folding -; ================================= -(rule ( - (= (IntB x) (lo-bound expr)) - (= (IntB x) (hi-bound expr)) - (HasArgType expr ty) - (ContextOf expr ctx) - ) - ((union expr (Const (Int x) ty ctx))) - :ruleset interval-analysis) - -(rule ( - (= (BoolB x) (lo-bound expr)) - (= (BoolB x) (hi-bound expr)) - (HasArgType expr ty) - (ContextOf expr ctx) - ) - ((union expr (Const (Bool x) ty ctx))) - :ruleset interval-analysis) - -; lower bound being true means the bool must be true -(rule ( - (= (BoolB true) (lo-bound expr)) - (HasArgType expr ty) - (ContextOf expr ctx) - ) - ((union expr (Const (Bool true) ty ctx))) - :ruleset interval-analysis) - -; upper bound being false means the bool must be false -(rule ( - (= (BoolB false) (hi-bound expr)) - (HasArgType expr ty) - (ContextOf expr ctx) - ) - ((union expr (Const (Bool false) ty ctx))) - :ruleset interval-analysis) - -; ================================= -; Arithmetic -; ================================= -; + a b interval is (+ la lb) (+ ha hb) -(rule ( - (= lhs (Bop (Add) a b)) - (= (IntB la) (lo-bound a)) - (= (IntB lb) (lo-bound b)) - ) - ((set (lo-bound lhs) (IntB (+ la lb)))) - :ruleset interval-analysis) -(rule ( - (= lhs (Bop (Add) a b)) - (= (IntB ha) (hi-bound a)) - (= (IntB hb) (hi-bound b)) - ) - ((set (hi-bound lhs) (IntB (+ ha hb)))) - :ruleset interval-analysis) - -; - a b interval is (- la hb) (- ha lb) -(rule ( - (= lhs (Bop (Sub) a b)) - (= (IntB la) (lo-bound a)) - (= (IntB hb) (hi-bound b)) - ) - ((set (lo-bound lhs) (IntB (- la hb)))) - :ruleset interval-analysis) -(rule ( - (= lhs (Bop (Sub) a b)) - (= (IntB ha) (hi-bound a)) - (= (IntB lb) (lo-bound b)) - ) - ((set (hi-bound lhs) (IntB (- ha lb)))) - :ruleset interval-analysis) - -; Multiplication for two constants -; TODO: Make fancier interval analysis -(rule ( - (= lhs (Bop (Mul) a b)) - (= (IntB x) (lo-bound a)) - (= (IntB x) (hi-bound a)) - (= (IntB y) (lo-bound b)) - (= (IntB y) (hi-bound b)) - ) - ( - (set (lo-bound lhs) (IntB (* x y))) - (set (hi-bound lhs) (IntB (* x y))) - ) - :ruleset interval-analysis) - -; negative * negative is positive -(rule ( - (= lhs (Bop (Mul) x y)) - (= (IntB hi-x) (hi-bound x)) - (= (IntB hi-y) (hi-bound y)) - (<= hi-x 0) - (<= hi-y 0) - ) - ((set (lo-bound lhs) (IntB 0))) - :ruleset interval-analysis) - -; negative * positive is negative -(rule ( - (= lhs (Bop (Mul) x y)) - (= (IntB hi-x) (hi-bound x)) - (= (IntB lo-y) (lo-bound y)) - (<= hi-x 0) ; x <= 0 (x is negative) - (>= lo-y 0) ; y >= 0 (y is positive) - ) - ((set (hi-bound lhs) (IntB 0))) - :ruleset interval-analysis) - -; positive * positive is positive -(rule ( - (= lhs (Bop (Mul) x y)) - (= (IntB lo-x) (lo-bound x)) - (= (IntB lo-y) (lo-bound y)) - (>= lo-x 0) - (>= lo-y 0) - ) - ((set (lo-bound lhs) (IntB 0))) - :ruleset interval-analysis) - -; < a b interval is (< ha lb) (< la hb) -(rule ( - (= lhs (Bop (LessThan) a b)) - (= (IntB ha) (hi-bound a)) - (= (IntB lb) (lo-bound b)) - ) - ( - (set (lo-bound lhs) (BoolB (bool-< ha lb))) - ) - :ruleset interval-analysis) -(rule ( - (= lhs (Bop (LessThan) a b)) - (= (IntB la) (lo-bound a)) - (= (IntB hb) (hi-bound b)) - ) - ((set (hi-bound lhs) (BoolB (bool-< la hb)))) - :ruleset interval-analysis) - -; ================================= -; Conditionals -; ================================= -; if the predicate is true, merge with then branch -(rule ( - (= lhs (If cond inputs thn els)) - (ContextOf lhs if_ctx) - (= (BoolB true) (lo-bound cond)) - ) - ((union lhs (Subst if_ctx inputs thn))) - :ruleset interval-analysis) - -; if the predicate is false, merge with else branch -(rule ( - (= lhs (If cond inputs thn els)) - (ContextOf lhs if_ctx) - (= (BoolB false) (hi-bound cond)) - ) - ((union lhs (Subst if_ctx inputs els))) - :ruleset interval-analysis) - -; lo-bound of If is the min of the lower bounds -; hi-bound of If is the max of the upper bounds -(rule ( - (= lhs (If cond inputs thn els)) - (= lo-thn (lo-bound thn)) - (= lo-els (lo-bound els)) - ) - ((set (lo-bound lhs) (bound-min lo-thn lo-els))) - :ruleset interval-analysis) -(rule ( - (= lhs (If cond inputs thn els)) - (= hi-thn (hi-bound thn)) - (= hi-els (hi-bound els)) - ) - ((set (hi-bound lhs) (bound-max hi-thn hi-els))) - :ruleset interval-analysis) - -; Same rules, but for Ifs that have multiple outputs -(rule ( - (= lhs (If pred inputs thn els)) - (= lo-thn (lo-bound (Get thn i))) - (= lo-els (lo-bound (Get els i))) - ) - ((set (lo-bound (Get lhs i)) (bound-min lo-thn lo-els))) - :ruleset interval-analysis) -(rule ( - (= lhs (If cond inputs thn els)) - (= hi-thn (hi-bound (Get thn i))) - (= hi-els (hi-bound (Get els i))) - ) - ((set (hi-bound (Get lhs i)) (bound-max hi-thn hi-els))) - :ruleset interval-analysis) - -; If the If takes a tuple -(rule ( - ; expr < value - (= pred (Bop (LessThan) expr value)) - (= if_e (If pred inputs then else)) - ; the left operand of the < is an input to the if region - (= expr (Get inputs i)) - ; the right operand of the < has an upper bound - (= (IntB v) (hi-bound value)) - ; context node inside the if region - (= ctx (Arg ty (InIf true pred inputs))) - (HasType inputs ty) - ) - ; expr < value was true, so we know expr is at most (hi-bound value) - 1 - ((set (hi-bound (Get ctx i)) (IntB (- v 1)))) - :ruleset interval-analysis) -(rule ( - ; expr < value - (= pred (Bop (LessThan) expr value)) - (= if_e (If pred inputs then else)) - ; the left operand of the < is an input to the if region - (= expr (Get inputs i)) - ; the right operand of the < has a lower bound - (= (IntB v) (lo-bound value)) - ; context node inside the if region - (= ctx (Arg ty (InIf false pred inputs))) - (HasType inputs ty) - ) - ; expr < value was false, so we know expr is at least (lo-bound value) - ((set (lo-bound (Get ctx i)) (IntB v))) - :ruleset interval-analysis) - -(rule ( - ; value < expr - (= pred (Bop (LessThan) value expr)) - (= if_e (If pred inputs then else)) - ; the right operand of the < is an input to the if region - (= expr (Get inputs i)) - ; the left operand of the < has a lower bound - (= (IntB v) (lo-bound value)) - ; context node inside the if region - (= ctx (Arg ty (InIf true pred inputs))) - (HasType inputs ty) - ) - ; value < expr was true, so we know expr is at least (lo-bound value) + 1 - ((set (lo-bound (Get ctx i)) (IntB (+ v 1)))) - :ruleset interval-analysis) -(rule ( - ; value < expr - (= pred (Bop (LessThan) value expr)) - (= if_e (If pred inputs then else)) - ; the right operand of the < is an input to the if region - (= expr (Get inputs i)) - ; the left operand of the < has an upper bound - (= (IntB v) (hi-bound value)) - ; context node inside the if region - (= ctx (Arg ty (InIf false pred inputs))) - (HasType inputs ty) - ) - ; value < expr was false, so we know expr is at most (hi-bound value) - ((set (hi-bound (Get ctx i)) (IntB v))) - :ruleset interval-analysis) - -;; Push intervals for inputs into if region -(rule ( - (= if (If pred inputs then_ else_)) - (= ctx (Arg ty (InIf b pred inputs))) - (HasType inputs ty) - (= lo (lo-bound (Get inputs i))) - - ) - ((set (lo-bound (Get ctx i)) lo)) - :ruleset interval-analysis) -(rule ( - (= if (If pred inputs then_ else_)) - (= ctx (Arg ty (InIf b pred inputs))) - (HasType inputs ty) - (= hi (hi-bound (Get inputs i))) - - ) - ((set (hi-bound (Get ctx i)) hi)) - :ruleset interval-analysis) - -; (if (a == b) thn els) -; in the thn branch, we know that a has the same bounds as b -(rule ( - (= pred (Bop (Eq) expr val)) - (= if_e (If pred inputs thn els)) - ; the left operand of the == is an input to the if region - (= expr (Get inputs i)) - (= ctx (Arg ty (InIf true pred inputs))) - (HasType inputs ty) - (= (IntB lo) (lo-bound val)) - ) - ((set (lo-bound (Get ctx i)) (IntB lo))) - :ruleset interval-analysis) -(rule ( - (= pred (Bop (Eq) expr val)) - (= if_e (If pred inputs thn els)) - ; the left operand of the == is an input to the if region - (= expr (Get inputs i)) - (= ctx (Arg ty (InIf true pred inputs))) - (HasType inputs ty) - (= (IntB hi) (hi-bound val)) - ) - ((set (hi-bound (Get ctx i)) (IntB hi))) - :ruleset interval-analysis) - - -(rule ( - ;; argument has loop context - (Arg ty (InLoop inputs outputs)) - ;; in the loop, the argument is passed through - ;; note that some_ctx is not the same as (InLoop inputs outputs) - (= (Get (Arg ty some_ctx) ith) (Get outputs (+ 1 ith))) - ;; input has some bound - (= bound (lo-bound (Get inputs ith))) - ) - ( - (set (lo-bound (Get (Arg ty (InLoop inputs outputs)) ith)) bound) - ) - :ruleset interval-analysis) -(rule ( - ;; argument has loop context - (Arg ty (InLoop inputs outputs)) - ;; in the loop, the argument is passed through - (= (Get (Arg ty some_ctx) ith) (Get outputs (+ 1 ith))) - ;; input has some bound - (= bound (hi-bound (Get inputs ith))) - ) - ( - (set (hi-bound (Get (Arg ty (InLoop inputs outputs)) ith)) bound) - ) - :ruleset interval-analysis) - - -(ruleset switch_rewrite) - -; if (a and b) X Y ~~> if a (if b X Y) Y -(rule ((= lhs (If (Bop (And) a b) ins X Y)) - (HasType ins (TupleT ins_ty)) - (= len (tuple-length ins))) - - ((let outer_ins (Concat (Single b) ins)) - (let outer_ins_ty (TupleT (TCons (BoolT) ins_ty))) - - (let inner_pred (Get (Arg outer_ins_ty (InIf true a outer_ins)) 0)) - (let sub_arg_true (SubTuple (Arg outer_ins_ty (InIf true a outer_ins)) 1 len)) - (let sub_arg_false (SubTuple (Arg outer_ins_ty (InIf false a outer_ins)) 1 len)) - - (let inner_X (AddContext (InIf true inner_pred sub_arg_true) X)) - (let inner_Y (AddContext (InIf false inner_pred sub_arg_true) Y)) - (let outer_Y (Subst (InIf false a outer_ins) sub_arg_false Y)) - - (let inner (If inner_pred sub_arg_true inner_X inner_Y)) - (union lhs (If a outer_ins inner outer_Y))) - - :ruleset switch_rewrite) - -; if (a or b) X Y ~~> if a X (if b X Y) -(rule ((= lhs (If (Bop (Or) a b) ins X Y)) - (HasType ins (TupleT ins_ty)) - (= len (tuple-length ins))) - - ((let outer_ins (Concat (Single b) ins)) - (let outer_ins_ty (TupleT (TCons (BoolT) ins_ty))) - - (let inner_pred (Get (Arg outer_ins_ty (InIf false a outer_ins)) 0)) - (let sub_arg_true (SubTuple (Arg outer_ins_ty (InIf true a outer_ins)) 1 len)) - (let sub_arg_false (SubTuple (Arg outer_ins_ty (InIf false a outer_ins)) 1 len)) - - (let outer_X (Subst (InIf true a outer_ins) sub_arg_true X)) - (let inner_X (AddContext (InIf true inner_pred sub_arg_false) X)) - (let inner_Y (AddContext (InIf false inner_pred sub_arg_false) Y)) - - (let inner (If inner_pred sub_arg_false inner_X inner_Y)) - (union lhs (If a outer_ins outer_X inner ))) - - :ruleset switch_rewrite) - -(relation Debug (Assumption Expr Expr)) -(rule ((If (Const (Bool true) ty ctx) ins thn els)) -( - (Debug ctx ins thn) -) - :ruleset always-run) - -(rewrite (If (Const (Bool true) ty ctx) ins thn els) - (Subst ctx ins thn) - :ruleset always-run) - -(rewrite (If (Const (Bool false) ty ctx) ins thn els) - (Subst ctx ins els) - :ruleset switch_rewrite) - -(rule ((= lhs (If pred ins thn els)) - (= (Get thn i) (Const (Bool true) ty ctx1)) - (= (Get els i) (Const (Bool false) ty ctx2))) - ((union (Get lhs i) pred)) :ruleset switch_rewrite) - -(rule ((= lhs (If pred ins thn els)) - (= (Get thn i) (Const (Bool false) ty ctx1)) - (= (Get els i) (Const (Bool true) ty ctx2))) - ((union (Get lhs i) (Uop (Not) pred))) :ruleset switch_rewrite) - -; Simple rewrites that don't do a ton with control flow. - -(ruleset peepholes) - -(rewrite (Bop (Mul) (Const (Int 0) ty ctx) e) (Const (Int 0) ty ctx) :ruleset peepholes) -(rewrite (Bop (Mul) e (Const (Int 0) ty ctx)) (Const (Int 0) ty ctx) :ruleset peepholes) -(rewrite (Bop (Mul) (Const (Int 1) ty ctx) e) e :ruleset peepholes) -(rewrite (Bop (Mul) e (Const (Int 1) ty ctx)) e :ruleset peepholes) -(rewrite (Bop (Add) (Const (Int 0) ty ctx) e) e :ruleset peepholes) -(rewrite (Bop (Add) e (Const (Int 0) ty ctx) ) e :ruleset peepholes) - -(rewrite (Bop (Mul) (Const (Int j) ty ctx) (Const (Int i) ty ctx)) (Const (Int (* i j)) ty ctx) :ruleset peepholes) -(rewrite (Bop (Add) (Const (Int j) ty ctx) (Const (Int i) ty ctx)) (Const (Int (+ i j)) ty ctx) :ruleset peepholes) - -(rewrite (Bop (And) (Const (Bool true) ty ctx) e) e :ruleset peepholes) -(rewrite (Bop (And) e (Const (Bool true) ty ctx)) e :ruleset peepholes) -(rewrite (Bop (And) (Const (Bool false) ty ctx) e) (Const (Bool false) ty ctx) :ruleset peepholes) -(rewrite (Bop (And) e (Const (Bool false) ty ctx)) (Const (Bool false) ty ctx) :ruleset peepholes) -(rewrite (Bop (Or) (Const (Bool false) ty ctx) e) e :ruleset peepholes) -(rewrite (Bop (Or) e (Const (Bool false) ty ctx)) e :ruleset peepholes) -(rewrite (Bop (Or) (Const (Bool true) ty ctx) e) (Const (Bool true) ty ctx) :ruleset peepholes) -(rewrite (Bop (Or) e (Const (Bool true) ty ctx)) (Const (Bool true) ty ctx) :ruleset peepholes) - - -(datatype IntOrInfinity - (Infinity) - (NegInfinity) - (I i64)) - -(function MaxIntOrInfinity (IntOrInfinity IntOrInfinity) IntOrInfinity) -(rewrite (MaxIntOrInfinity (Infinity) _) (Infinity) :ruleset always-run) -(rewrite (MaxIntOrInfinity _ (Infinity)) (Infinity) :ruleset always-run) -(rewrite (MaxIntOrInfinity (NegInfinity) x) x :ruleset always-run) -(rewrite (MaxIntOrInfinity x (NegInfinity)) x :ruleset always-run) -(rewrite (MaxIntOrInfinity (I x) (I y)) (I (max x y)) :ruleset always-run) - -(function MinIntOrInfinity (IntOrInfinity IntOrInfinity) IntOrInfinity) -(rewrite (MinIntOrInfinity (NegInfinity) _) (NegInfinity) :ruleset always-run) -(rewrite (MinIntOrInfinity _ (NegInfinity)) (NegInfinity) :ruleset always-run) -(rewrite (MinIntOrInfinity (Infinity) x) x :ruleset always-run) -(rewrite (MinIntOrInfinity x (Infinity)) x :ruleset always-run) -(rewrite (MinIntOrInfinity (I x) (I y)) (I (min x y)) :ruleset always-run) - -(function AddIntOrInfinity (IntOrInfinity IntOrInfinity) IntOrInfinity) -(rewrite (AddIntOrInfinity (Infinity) (Infinity)) (Infinity) :ruleset always-run) -(rewrite (AddIntOrInfinity (Infinity) (I _)) (Infinity) :ruleset always-run) -(rewrite (AddIntOrInfinity (I _) (Infinity)) (Infinity) :ruleset always-run) -(rewrite (AddIntOrInfinity (NegInfinity) (NegInfinity)) (NegInfinity) :ruleset always-run) -(rewrite (AddIntOrInfinity (NegInfinity) (I _)) (NegInfinity) :ruleset always-run) -(rewrite (AddIntOrInfinity (I _) (NegInfinity)) (NegInfinity) :ruleset always-run) -(rewrite (AddIntOrInfinity (I x) (I y)) (I (+ x y)) :ruleset always-run) - -(datatype IntInterval (MkIntInterval IntOrInfinity IntOrInfinity)) - -(function UnionIntInterval (IntInterval IntInterval) IntInterval) -(rewrite (UnionIntInterval (MkIntInterval lo1 hi1) (MkIntInterval lo2 hi2)) - (MkIntInterval (MinIntOrInfinity lo1 lo2) (MaxIntOrInfinity hi1 hi2)) - :ruleset always-run) - -(function IntersectIntInterval (IntInterval IntInterval) IntInterval) -(rewrite (IntersectIntInterval (MkIntInterval lo1 hi1) (MkIntInterval lo2 hi2)) - (MkIntInterval (MaxIntOrInfinity lo1 lo2) (MinIntOrInfinity hi1 hi2)) - :ruleset always-run) - -(function AddIntInterval (IntInterval IntInterval) IntInterval) -(rewrite (AddIntInterval (MkIntInterval lo1 hi1) (MkIntInterval lo2 hi2)) - (MkIntInterval (AddIntOrInfinity lo1 lo2) - (AddIntOrInfinity hi1 hi2)) - :ruleset always-run) - - -(datatype List - (Nil-List) - (Cons-List i64 IntInterval List)) - -(function Length-List (List) i64) -(rule ((= x (Nil-List))) - ((set (Length-List x) 0)) - :ruleset always-run) -(rule ((= x (Cons-List hd0 hd1 tl)) - (= l (Length-List tl))) - ((set (Length-List x) (+ l 1))) - :ruleset always-run) -(rule ((= x (Nil-List))) - ((set (Length-List x) 0)) - :ruleset memory-helpers) -(rule ((= x (Cons-List hd0 hd1 tl)) - (= l (Length-List tl))) - ((set (Length-List x) (+ l 1))) - :ruleset memory-helpers) - -(relation IsEmpty-List (List)) -(rule ((= x (Nil-List))) - ((IsEmpty-List x)) - :ruleset always-run) - -(relation IsNonEmpty-List (List)) -(rule ((= x (Cons-List hd0 hd1 tl))) - ((IsNonEmpty-List x)) - :ruleset always-run) - -(function RevConcat-List (List List) List :cost 1000) -(rewrite (RevConcat-List (Nil-List) l) - l - :ruleset always-run) -(rewrite (RevConcat-List (Cons-List hd0 hd1 tl) l) - (RevConcat-List tl (Cons-List hd0 hd1 l)) - :ruleset always-run) - -(function Rev-List (List) List :cost 1000) -(rewrite (Rev-List m) - (RevConcat-List m (Nil-List)) - :ruleset always-run) - -(function Concat-List (List List) List :cost 1000) -(rewrite (Concat-List x y) - (RevConcat-List (Rev-List x) y) - :ruleset always-run) - -; SuffixAt and At must be demanded, otherwise these are O(N^2) -(relation DemandAt-List (List)) -(relation SuffixAt-List (List i64 List)) -(relation At-List (List i64 i64 IntInterval)) -(rule ((DemandAt-List x)) - ((SuffixAt-List x 0 x)) - :ruleset always-run) -(rule ((SuffixAt-List x i (Cons-List hd0 hd1 tl))) - ((SuffixAt-List x (+ i 1) tl) - (At-List x i hd0 hd1)) - :ruleset always-run) - -(function Union-List (List List) List) - ; The third argument of the helper is a WIP result map. - ; Invariant: keys of the result map are not present in the first two and are in descending order - (function UnionHelper-List (List List List) List) - (rewrite (Union-List m1 m2) - (Rev-List (UnionHelper-List m1 m2 (Nil-List))) - :ruleset always-run) - - ; both m1 and m2 empty - (rewrite (UnionHelper-List (Nil-List) (Nil-List) res) - res - :ruleset always-run) - ; take from m1 when m2 empty and vice versa - (rewrite - (UnionHelper-List - (Nil-List) - (Cons-List hd0 hd1 tl) - res) - (UnionHelper-List - (Nil-List) - tl - (Cons-List hd0 hd1 res)) - :ruleset always-run) - (rewrite - (UnionHelper-List - (Cons-List hd0 hd1 tl) - (Nil-List) - res) - (UnionHelper-List - tl - (Nil-List) - (Cons-List hd0 hd1 res)) - :ruleset always-run) - - ; when both nonempty and smallest key different, take smaller key - (rule ((= f (UnionHelper-List l1 l2 res)) - (= l1 (Cons-List k1 a1 tl1)) - (= l2 (Cons-List k2 b1 tl2)) - (< k1 k2)) - ((union f - (UnionHelper-List tl1 l2 (Cons-List k1 a1 res)))) - :ruleset always-run) - (rule ((= f (UnionHelper-List l1 l2 res)) - (= l1 (Cons-List k1 a1 tl1)) - (= l2 (Cons-List k2 b1 tl2)) - (< k2 k1)) - ((union f - (UnionHelper-List l1 tl2 (Cons-List k2 b1 res)))) - :ruleset always-run) - - ; when shared smallest key, union interval - (rule ((= f (UnionHelper-List l1 l2 res)) - (= l1 (Cons-List k a1 tl1)) - (= l2 (Cons-List k b1 tl2))) - ((union f - (UnionHelper-List tl1 tl2 - (Cons-List k (UnionIntInterval a1 b1) res)))) - :ruleset always-run) - -(function Intersect-List (List List) List) - ; The third argument of the helper is a WIP result map. - ; Invariant: keys of the result map are not present in the first two and are in descending order - (function IntersectHelper-List (List List List) List) - (rewrite (Intersect-List m1 m2) - (Rev-List (IntersectHelper-List m1 m2 (Nil-List))) - :ruleset always-run) - - ; m1 or m2 empty - (rewrite (IntersectHelper-List (Nil-List) m2 res) - res - :ruleset always-run) - (rewrite (IntersectHelper-List m1 (Nil-List) res) - res - :ruleset always-run) - - ; when both nonempty and smallest key different, drop smaller key - (rule ((= f (IntersectHelper-List l1 l2 res)) - (= l1 (Cons-List k1 a1 tl1)) - (= l2 (Cons-List k2 b1 tl2)) - (< k1 k2)) - ((union f (IntersectHelper-List tl1 l2 res))) - :ruleset always-run) - (rule ((= f (IntersectHelper-List l1 l2 res)) - (= l1 (Cons-List k1 a1 tl1)) - (= l2 (Cons-List k2 b1 tl2)) - (< k2 k1)) - ((union f (IntersectHelper-List tl1 l2 res))) - :ruleset always-run) - -(datatype MyBool (MyTrue) (MyFalse)) - -(function IntIntervalValid (IntInterval) MyBool) -(rewrite (IntIntervalValid (MkIntInterval (I lo) (I hi))) - (MyTrue) - :when ((<= lo hi)) - :ruleset always-run) -(rewrite (IntIntervalValid (MkIntInterval (I lo) (I hi))) - (MyFalse) - :when ((> lo hi)) - :ruleset always-run) -(rewrite (IntIntervalValid (MkIntInterval (NegInfinity) _)) - (MyTrue) - :ruleset always-run) -(rewrite (IntIntervalValid (MkIntInterval _ (Infinity))) - (MyTrue) - :ruleset always-run) - -(function ConsIfNonEmpty (i64 IntInterval List) - List - :cost 100) -(rule ((ConsIfNonEmpty k v tl)) - ((IntIntervalValid v)) - :ruleset always-run) -(rule ((= f (ConsIfNonEmpty k v tl)) - (= (MyTrue) (IntIntervalValid v))) - ((union f (Cons-List k v tl))) - :ruleset always-run) -(rule ((= f (ConsIfNonEmpty k v tl)) - (= (MyFalse) (IntIntervalValid v))) - ((union f tl)) - :ruleset always-run) - - ; when shared smallest key, intersect interval - (rule ((= f (IntersectHelper-List l1 l2 res)) - (= l1 (Cons-List k a1 tl1)) - (= l2 (Cons-List k b1 tl2))) - ((union f - (IntersectHelper-List tl1 tl2 - (ConsIfNonEmpty k (IntersectIntInterval a1 b1) res)))) - :ruleset always-run) - -(function AddIntIntervalToAll (IntInterval List) - List) -(rewrite (AddIntIntervalToAll _ (Nil-List)) - (Nil-List) - :ruleset always-run) -(rewrite (AddIntIntervalToAll x (Cons-List allocid offset tl)) - (Cons-List allocid (AddIntInterval x offset) - (AddIntIntervalToAll x tl)) - :ruleset always-run) - -(datatype PtrPointees - (PointsTo List) - (PointsAnywhere)) - -(function AddIntIntervalToPtrPointees (IntInterval PtrPointees) PtrPointees) -(rewrite (AddIntIntervalToPtrPointees interval (PointsAnywhere)) - (PointsAnywhere) - :ruleset always-run) -(rewrite (AddIntIntervalToPtrPointees interval (PointsTo l)) - (PointsTo (AddIntIntervalToAll interval l)) - :ruleset always-run) - -(function Union-PtrPointees (PtrPointees PtrPointees) PtrPointees) -(rewrite (Union-PtrPointees (PointsAnywhere) _) - (PointsAnywhere) - :ruleset always-run) -(rewrite (Union-PtrPointees _ (PointsAnywhere)) - (PointsAnywhere) - :ruleset always-run) -(rewrite (Union-PtrPointees (PointsTo x) (PointsTo y)) - (PointsTo (Union-List x y)) - :ruleset always-run) -(function Intersect-PtrPointees (PtrPointees PtrPointees) PtrPointees) -(rewrite (Intersect-PtrPointees (PointsAnywhere) x) - x - :ruleset always-run) -(rewrite (Intersect-PtrPointees x (PointsAnywhere)) - x - :ruleset always-run) -(rewrite (Intersect-PtrPointees (PointsTo x) (PointsTo y)) - (PointsTo (Intersect-List x y)) - :ruleset always-run) - -(relation PointsNowhere-PtrPointees (PtrPointees)) -(rule ((= f (PointsTo x)) - (IsEmpty-List x)) - ((PointsNowhere-PtrPointees f)) - :ruleset always-run) - - -(datatype List - (Nil-List) - (Cons-List PtrPointees List)) - -(function Length-List (List) i64) -(rule ((= x (Nil-List))) - ((set (Length-List x) 0)) - :ruleset always-run) -(rule ((= x (Cons-List hd0 tl)) - (= l (Length-List tl))) - ((set (Length-List x) (+ l 1))) - :ruleset always-run) -(rule ((= x (Nil-List))) - ((set (Length-List x) 0)) - :ruleset memory-helpers) -(rule ((= x (Cons-List hd0 tl)) - (= l (Length-List tl))) - ((set (Length-List x) (+ l 1))) - :ruleset memory-helpers) - -(relation IsEmpty-List (List)) -(rule ((= x (Nil-List))) - ((IsEmpty-List x)) - :ruleset always-run) - -(relation IsNonEmpty-List (List)) -(rule ((= x (Cons-List hd0 tl))) - ((IsNonEmpty-List x)) - :ruleset always-run) - -(function RevConcat-List (List List) List :cost 1000) -(rewrite (RevConcat-List (Nil-List) l) - l - :ruleset always-run) -(rewrite (RevConcat-List (Cons-List hd0 tl) l) - (RevConcat-List tl (Cons-List hd0 l)) - :ruleset always-run) - -(function Rev-List (List) List :cost 1000) -(rewrite (Rev-List m) - (RevConcat-List m (Nil-List)) - :ruleset always-run) - -(function Concat-List (List List) List :cost 1000) -(rewrite (Concat-List x y) - (RevConcat-List (Rev-List x) y) - :ruleset always-run) - -; SuffixAt and At must be demanded, otherwise these are O(N^2) -(relation DemandAt-List (List)) -(relation SuffixAt-List (List i64 List)) -(relation At-List (List i64 PtrPointees)) -(rule ((DemandAt-List x)) - ((SuffixAt-List x 0 x)) - :ruleset always-run) -(rule ((SuffixAt-List x i (Cons-List hd0 tl))) - ((SuffixAt-List x (+ i 1) tl) - (At-List x i hd0)) - :ruleset always-run) - -(relation All (List)) -(rule ((= x (Nil-List))) - ((All x)) - :ruleset always-run) -(rule ((= x (Cons-List hd0 tl)) - (PointsNowhere-PtrPointees hd0) - (All tl)) - ((All x)) - :ruleset always-run) - - - -(function Zip (List List) List :cost 1000) -(rewrite (Zip (Nil-List) (Nil-List)) - (Nil-List) - :ruleset always-run) -(rewrite (Zip - (Cons-List x0 tl1) - (Cons-List y0 tl2)) - (Cons-List - (Union-PtrPointees x0 y0) - (Zip tl1 tl2)) - :when ((= (Length-List tl1) (Length-List tl2))) - :ruleset always-run) - -(function Zip (List List) List :cost 1000) -(rewrite (Zip (Nil-List) (Nil-List)) - (Nil-List) - :ruleset always-run) -(rewrite (Zip - (Cons-List x0 tl1) - (Cons-List y0 tl2)) - (Cons-List - (Intersect-PtrPointees x0 y0) - (Zip tl1 tl2)) - :ruleset always-run) - - -(sort ExprSetPrim (Set Expr)) - -(datatype ExprSet (ES ExprSetPrim)) - -(function ExprSet-intersect (ExprSet ExprSet) ExprSet) -(rewrite (ExprSet-intersect (ES set1) (ES set2)) (ES (set-intersect set1 set2)) - :ruleset memory-helpers) -(function ExprSet-union (ExprSet ExprSet) ExprSet) -(rewrite (ExprSet-union (ES set1) (ES set2)) (ES (set-union set1 set2)) - :ruleset memory-helpers) -(relation ExprSet-contains (ExprSet Expr)) -(rule ((ES set1) (set-contains set1 x)) - ((ExprSet-contains (ES set1) x)) - :ruleset memory-helpers) -(function ExprSet-insert (ExprSet Expr) ExprSet) -(rewrite (ExprSet-insert (ES set1) x) - (ES (set-insert set1 x)) - :ruleset memory-helpers) -(function ExprSet-length (ExprSet) i64) -(rewrite (ExprSet-length (ES set1)) (set-length set1) :ruleset memory-helpers) - -; ============================ -; Pointees -; ============================ - - -; List is used as an association list; the i64 keys -; (corresponding to alloc ids) are always unique and sorted, the IntInterval -; values correspond to offset ranges. -; -; (TuplePointsTo [{0->[4,5], 1->[0,0]}, {0->[0,0]}]) -; indicates a tuple with two components. -; - The first component might point to Alloc 0 at offsets 4 or 5, -; or Alloc 1 at offset 0 -; - The second component points to Alloc 0 at offset 0 -(datatype Pointees - (TuplePointsTo List) - (PtrPointsTo PtrPointees)) - -(function UnwrapPtrPointsTo (Pointees) PtrPointees) -(rewrite (UnwrapPtrPointsTo (PtrPointsTo x)) - x - :ruleset memory-helpers) -(function UnwrapTuplePointsTo (Pointees) List) -(rewrite (UnwrapTuplePointsTo (TuplePointsTo x)) - x - :ruleset memory-helpers) - -(relation PointsNowhere (Pointees)) -(rule ((= f (PtrPointsTo x)) - (PointsNowhere-PtrPointees x)) - ((PointsNowhere f)) - :ruleset memory-helpers) -(rule ((= f (TuplePointsTo l)) - (All l)) - ((PointsNowhere f)) - :ruleset memory-helpers) - -(function UnionPointees (Pointees Pointees) Pointees) -(rewrite (UnionPointees (PtrPointsTo x) (PtrPointsTo y)) - (PtrPointsTo (Union-PtrPointees x y)) - :ruleset memory-helpers) -(rewrite (UnionPointees (TuplePointsTo x) (TuplePointsTo y)) - (TuplePointsTo (Zip x y)) - :when ((= (Length-List x) (Length-List y))) - :ruleset memory-helpers) -(function IntersectPointees (Pointees Pointees) Pointees) -(rewrite (IntersectPointees (PtrPointsTo x) (PtrPointsTo y)) - (PtrPointsTo (Intersect-PtrPointees x y)) - :ruleset memory-helpers) -(rewrite (IntersectPointees (TuplePointsTo x) (TuplePointsTo y)) - (TuplePointsTo (Zip x y)) - :ruleset memory-helpers) - -(function GetPointees (Pointees i64) Pointees) -(rule ((= f (GetPointees (TuplePointsTo l) i)) - (At-List l i x)) - ((union f (PtrPointsTo x))) - :ruleset memory-helpers) - -(function PointeesDropFirst (Pointees) Pointees) -(rewrite (PointeesDropFirst (TuplePointsTo (Cons-List hd tl))) - (TuplePointsTo tl) - :ruleset memory-helpers) - -; ============================ -; Resolved -; ============================ - -; Resolved checks if an e-class contains a term containing only constructors and -; primitives; i.e. whether equality is decideable -(relation Resolved-IntOrInfinity (IntOrInfinity)) -(rule ((= f (I _))) - ((Resolved-IntOrInfinity f)) - :ruleset memory-helpers) -(rule ((= f (Infinity))) - ((Resolved-IntOrInfinity f)) - :ruleset memory-helpers) -(rule ((= f (NegInfinity))) - ((Resolved-IntOrInfinity f)) - :ruleset memory-helpers) - -(relation Resolved-IntInterval (IntInterval)) -(rule ((= f (MkIntInterval lo hi)) - (Resolved-IntOrInfinity lo) - (Resolved-IntOrInfinity hi)) - ((Resolved-IntInterval f)) - :ruleset memory-helpers) - -(relation Resolved-List (List)) -(rule ((= f (Nil-List))) - ((Resolved-List f)) - :ruleset memory-helpers) -(rule ((= f (Cons-List allocid offsets tl)) - (Resolved-List tl) - (Resolved-IntInterval offsets)) - ((Resolved-List f)) - :ruleset memory-helpers) - -(relation Resolved-PtrPointees (PtrPointees)) -(rule ((= f (PointsAnywhere))) - ((Resolved-PtrPointees f)) - :ruleset memory-helpers) -(rule ((= f (PointsTo x)) - (Resolved-List x)) - ((Resolved-PtrPointees f)) - :ruleset memory-helpers) - -(relation Resolved-List (List)) -(rule ((= f (Nil-List))) - ((Resolved-List f)) - :ruleset memory-helpers) -(rule ((= f (Cons-List hd tl)) - (Resolved-List tl) - (Resolved-PtrPointees hd)) - ((Resolved-List f)) - :ruleset memory-helpers) - -(relation Resolved-Pointees (Pointees)) -(rule ((= f (TuplePointsTo x)) - (Resolved-List x)) - ((Resolved-Pointees f)) - :ruleset memory-helpers) -(rule ((= f (PtrPointsTo x)) - (Resolved-PtrPointees x)) - ((Resolved-Pointees f)) - :ruleset memory-helpers) - - -;;;;; - -(function BaseTypeToPtrPointees (BaseType) PtrPointees :cost 100) -(rewrite (BaseTypeToPtrPointees (PointerT _)) - (PointsAnywhere) - :ruleset memory-helpers) -(rewrite (BaseTypeToPtrPointees (IntT)) - (PointsTo (Nil-List)) - :ruleset memory-helpers) -(rewrite (BaseTypeToPtrPointees (StateT)) - (PointsTo (Nil-List)) - :ruleset memory-helpers) -(rewrite (BaseTypeToPtrPointees (BoolT)) - (PointsTo (Nil-List)) - :ruleset memory-helpers) - -(function TypeListToList (TypeList) List :cost 1000) -(rewrite (TypeListToList (TNil)) - (Nil-List) - :ruleset memory-helpers) -(rewrite (TypeListToList (TCons hd tl)) - (Cons-List - (BaseTypeToPtrPointees hd) - (TypeListToList tl)) - :ruleset memory-helpers) - -(function TypeToPointees (Type) Pointees :cost 1000) -(rewrite (TypeToPointees (TupleT tylist)) - (TuplePointsTo (TypeListToList tylist)) - :ruleset memory-helpers) -(rewrite (TypeToPointees (Base basety)) - (PtrPointsTo (BaseTypeToPtrPointees basety)) - :ruleset memory-helpers) - -; ============================ -; Update PointerishType -; ============================ - -(relation PointerishType (Type)) -(relation PointerishTypeList (TypeList)) - -(rule ((= f (Base (PointerT ty)))) - ((PointerishType f)) - :ruleset always-run) - -(rule ((= f (TCons (PointerT ty) tl))) - ((PointerishTypeList f)) - :ruleset always-run) - -(rule ((= f (TCons hd tl)) - (PointerishTypeList tl)) - ((PointerishTypeList f)) - :ruleset always-run) - -(rule ((= f (TupleT l)) - (PointerishTypeList l)) - ((PointerishType f)) - :ruleset always-run) - -; ============================ -; Update PointsToCells -; ============================ - -; arg pointees result pointees -(function PointsToCells (Expr Pointees) Pointees :unextractable) - -; Top-level demand -(rule ((Function name in-ty out-ty body)) - ((PointsToCells body (TypeToPointees in-ty))) - :ruleset memory-helpers) - -; Demand PointsToCells along state edge and pointer-typed values -(rule ((PointsToCells (Bop (Print) e state) ap)) - ((PointsToCells state ap)) - :ruleset memory-helpers) -(rule ((PointsToCells (Bop (Load) e state) ap)) - ((PointsToCells e ap) - (PointsToCells state ap)) - :ruleset memory-helpers) -(rule ((PointsToCells (Top (Write) ptr val state) ap)) - ((PointsToCells ptr ap) - (PointsToCells state ap)) - :ruleset memory-helpers) -(rule ((PointsToCells (Alloc id sz state ty) ap)) - ((PointsToCells state ap)) - :ruleset memory-helpers) -(rule ((PointsToCells (Bop (Free) ptr state) ap)) - ((PointsToCells ptr ap) - (PointsToCells state ap)) - :ruleset memory-helpers) -(rule ((PointsToCells (Get x i) ap)) - ((PointsToCells x ap)) - :ruleset memory-helpers) -(rule ((PointsToCells (Concat x y) ap)) - ((PointsToCells x ap) - (PointsToCells y ap)) - :ruleset memory-helpers) -(rule ((PointsToCells (Single x) ap)) - ((PointsToCells x ap)) - :ruleset memory-helpers) - -; Compute and propagate PointsToCells -(rewrite (PointsToCells (Concat x y) aps) - (TuplePointsTo (Concat-List - (UnwrapTuplePointsTo (PointsToCells x aps)) - (UnwrapTuplePointsTo (PointsToCells y aps)))) - :when ((HasType (Concat x y) ty) (PointerishType ty)) - :ruleset memory-helpers) - -(rewrite (PointsToCells (Get x i) aps) - (GetPointees (PointsToCells x aps) i) - :when ((HasType (Get x i) ty) (PointerishType ty)) - :ruleset memory-helpers) - -(rewrite (PointsToCells (Single x) aps) - (TuplePointsTo - (Cons-List - (UnwrapPtrPointsTo (PointsToCells x aps)) - (Nil-List))) - :when ((HasType (Single x) ty) (PointerishType ty)) - :ruleset memory-helpers) - -(rewrite (PointsToCells (Arg ty_ ctx) aps) - aps - :when ((HasType (Arg ty_ ctx) ty) (PointerishType ty)) - :ruleset memory-helpers) - -; Allow non-pointer types to resolve -(rule ((PointsToCells x aps) - (HasType x ty)) - ((TypeToPointees ty)) - :ruleset memory-helpers) -(rule ((= f (PointsToCells x aps)) - (HasType x ty) - (= pointees (TypeToPointees ty)) - (PointsNowhere pointees)) - ((union f pointees)) - :ruleset memory-helpers) - -(rewrite (PointsToCells (Bop (PtrAdd) x e) aps) - (PtrPointsTo - (AddIntIntervalToPtrPointees - (MkIntInterval (I lo) (I hi)) - (UnwrapPtrPointsTo (PointsToCells x aps)))) - :when ((= (IntB lo) (lo-bound e)) - (= (IntB hi) (hi-bound e))) - :ruleset memory-helpers) - -(rewrite (PointsToCells (If c inputs t e) aps) - (UnionPointees - (PointsToCells t (PointsToCells inputs aps)) - (PointsToCells e (PointsToCells inputs aps))) - :when ((HasType (If c inputs t e) ty) (PointerishType ty)) - :ruleset memory) - -(rewrite (PointsToCells (Alloc id sz state ty) aps) - (TuplePointsTo - (Cons-List - (PointsTo - (Cons-List - id - (MkIntInterval (I 0) (I 0)) - (Nil-List))) - (Cons-List - (PointsTo (Nil-List)) ; state output points to nothing - (Nil-List)))) - :ruleset memory-helpers) - -; arg pointees * loop in * loop out * i64 -> result pointees -(function PointsToCellsAtIter (Pointees Expr Expr i64) Pointees) - -; compute first two -(rule ((= e (DoWhile inputs pred-body)) - (PointsToCells e aps)) - ((set (PointsToCellsAtIter aps inputs pred-body 0) - (PointsToCells inputs aps)) - (set (PointsToCellsAtIter aps inputs pred-body 1) - (UnionPointees - (PointsToCellsAtIter aps inputs pred-body 0) - (PointeesDropFirst - (PointsToCells pred-body (PointsToCellsAtIter aps inputs pred-body 0)))))) - :ruleset memory-helpers) - -; avoid quadratic query -(function succ (i64) i64 :unextractable) -(rule ((PointsToCellsAtIter aps inputs pred-body i)) - ((set (succ i) (+ i 1))) - :ruleset memory-helpers) - -; Note that this rule is bounded by ruleset memory -(rule ((= pointees0 (PointsToCellsAtIter aps inputs pred-body i)) - (= pointees1 (PointsToCellsAtIter aps inputs pred-body (succ i))) - (Resolved-Pointees pointees0) - (Resolved-Pointees pointees1) - (!= pointees0 pointees1)) - ((set (PointsToCellsAtIter aps inputs pred-body (+ i 2)) - (UnionPointees - pointees1 - (PointeesDropFirst - (PointsToCells pred-body pointees1))))) - :ruleset memory) - -(rule ((= pointees (PointsToCellsAtIter aps inputs pred-body i)) - (= pointees (PointsToCellsAtIter aps inputs pred-body (succ i)))) - ((set (PointsToCells (DoWhile inputs pred-body) aps) - pointees)) - :ruleset memory) - -(rule ((PtrPointsTo (PointsTo l))) - ((DemandAt-List l)) - :ruleset memory-helpers) -(rule ((TuplePointsTo l)) - ((DemandAt-List l)) - :ruleset memory-helpers) - -; ============================ -; Update DontAlias -; ============================ - -(relation DemandDontAlias (Expr Expr Pointees)) -; pointer, pointer, arg pointees -(relation DontAlias (Expr Expr Pointees)) - - -(rule ((DemandDontAlias ptr1 ptr2 arg-pointees) - (BodyContainsExpr body ptr1) - (BodyContainsExpr body ptr2) - (HasType ptr1 (Base (PointerT ty))) - (HasType ptr2 (Base (PointerT ty))) - (= pointees1 (PointsToCells ptr1 arg-pointees)) - (= pointees2 (PointsToCells ptr2 arg-pointees))) - ((IntersectPointees pointees1 pointees2)) - :ruleset memory-helpers) - -(rule ((PointsNowhere - (IntersectPointees - (PointsToCells ptr1 arg-pointees) - (PointsToCells ptr2 arg-pointees)))) - ((DontAlias ptr1 ptr2 arg-pointees)) - :ruleset memory-helpers) - -; ============================ -; Update PointsToExpr -; ============================ - -; program point, pointer -(function PointsToExpr (Expr Expr) Expr :unextractable) - -; After a load, the ptr points to the loaded value -(rule ((= f (Bop (Load) ptr state))) - ((set (PointsToExpr (Get f 1) ptr) (Get f 0))) - :ruleset memory-helpers) - -; If we load and we already know what the pointer points to -; TODO this rule breaks the weakly linear invariant -; when a previous load may not be on the path -;(rule ((= e (Bop (Load) addr state)) -; (= v (PointsToExpr state addr))) -; ((union (Get e 0) v) -; (union (Get e 1) state)) -; :ruleset memory-helpers) - -; Loads and prints don't affect what what pointers already point to -(rule ((= f (PointsToExpr state addr)) - (= e (Bop (Load) any-addr state))) - ((let new-state (Get e 1)) - (union (PointsToExpr new-state addr) f)) - :ruleset memory-helpers) -(rule ((= f (PointsToExpr state addr)) - (= e (Bop (Print) any-val state))) - ((let new-state e) - (union (PointsToExpr new-state addr) f)) - :ruleset memory-helpers) - -; Writes don't affect what a pointer points to if it writes to another pointer -; guaranteed to not alias. -(rule ((= e (Top (Write) addr data state)) - (HasArgType addr argty) - (= otherdata (PointsToExpr state otheraddr))) - ((DemandDontAlias addr otheraddr (TypeToPointees argty))) - :ruleset memory-helpers) -(rule ((= e (Top (Write) addr data state)) - (HasArgType addr argty) - (= otherdata (PointsToExpr state otheraddr)) - (DontAlias addr otheraddr (TypeToPointees argty))) - ((set (PointsToExpr e otheraddr) otherdata)) - :ruleset memory-helpers) - -; For a write, mark the given expression as containing `data`. -(rule ((= e (Top (Write) addr data state))) - ((union (PointsToExpr e addr) data)) - :ruleset memory-helpers) - -; ============================ -; Update CellHasValues (currently unused) -; ============================ - -; ; program point, cell -; (function CellHasValues (Expr i64) ExprSet :merge (ExprSet-intersect old new)) - -; ; At the time of an alloc, a cell doesn't contain any values -; (rule ((= f (Alloc id amt state ty))) - ; ((set (CellHasValues (Get f 1) id) (ES (set-empty)))) - ; :ruleset memory-helpers) - -; ; These two rules find (Write ptr val state) where -; ; ptr points to cells given no assumptions about where (Arg) points. -; ; TODO: make sensitive to offsets -; (rule ((= e (Top (Write) ptr val state)) - ; (HasArgType ptr argty)) - ; ((TypeToPointees argty)) - ; :ruleset memory-helpers) -; (rule ((= e (Top (Write) ptr val state)) - ; (HasArgType ptr argty) - ; (= (PtrPointsTo (PointsTo cells)) (PointsToCells ptr (TypeToPointees argty))) - ; (At-List cells any-idx alloc-id offsets) - ; (= vals (CellHasValues state cell))) - ; ((set (CellHasValues e cell) (ExprSet-insert vals val))) - ; :ruleset memory-helpers) - -;; Loop Invariant - -;; bool: whether the term in the Expr is an invariant. -(function is-inv-Expr (Expr Expr) bool :unextractable :merge (or old new)) -(function is-inv-ListExpr (Expr ListExpr) bool :unextractable :merge (or old new)) - -;; in default, when there is a find, set is-inv to false -(rule ((BodyContainsExpr loop term) - (= loop (DoWhile inputs pred_out))) - ((set (is-inv-Expr loop term) false)) :ruleset always-run) -(rule ((BodyContainsListExpr loop term) - (= loop (DoWhile inputs pred_out))) - ((set (is-inv-ListExpr loop term) false)) :ruleset always-run) - -(relation is-inv-ListExpr-helper (Expr ListExpr i64)) -(rule ((BodyContainsListExpr loop list) - (= loop (DoWhile inputs pred_out))) - ((is-inv-ListExpr-helper loop list 0)) :ruleset always-run) - -(rule ((is-inv-ListExpr-helper loop list i) - (= true (is-inv-Expr loop expr)) - (= expr (ListExpr-ith list i))) - ((is-inv-ListExpr-helper loop list (+ i 1))) :ruleset always-run) - -(rule ((is-inv-ListExpr-helper loop list i) - (= i (ListExpr-length list))) - ((set (is-inv-ListExpr loop list) true)) :ruleset always-run) - - -(ruleset boundary-analysis) -;; An Expr is on boundary when it is invariant and its parent is not -; loop invariant-expr -(relation boundary-Expr (Expr Expr)) - -;; boundary for ListExpr's children -(rule ((= true (is-inv-Expr loop expr)) - (= false (is-inv-ListExpr loop list)) - (= expr (ListExpr-ith list i))) - ((boundary-Expr loop expr)) :ruleset boundary-analysis) - -;; if a output branch/pred is invariant, it's also boundary-Expr -(rule ((= true (is-inv-Expr loop expr)) - (= loop (DoWhile in pred_out)) - (= expr (Get pred_out i))) - ((boundary-Expr loop expr)) :ruleset boundary-analysis) - - -(function hoisted-loop (Expr Expr) bool :unextractable :merge (or old new) ) -(rule ((= loop (DoWhile in pred_out))) - ((set (hoisted-loop in pred_out) false)) :ruleset always-run) - -(function InExtendedLoop (Expr Expr Expr) Assumption) - -;; mock function -(ruleset loop-inv-motion) - -(rule ((boundary-Expr loop inv) - (> (Expr-size inv) 1) - ;; TODO: replace Expr-size when cost model is ready - (= loop (DoWhile in pred_out)) - ;; the outter assumption of the loop - (ContextOf loop loop_ctx) - (HasType in in_type) - (HasType inv inv_type) - (= inv_type (Base base_inv_ty)) - (= in_type (TupleT tylist)) - (= false (hoisted-loop in pred_out)) - (= len (tuple-length in))) - ((let new_input (Concat in (Single (Subst loop_ctx in inv)))) - (let new_input_type (TupleT (TLConcat tylist (TCons base_inv_ty (TNil))))) - ;; create an virtual assume node, union it with actuall InLoop later - (let assum (InExtendedLoop in pred_out new_input)) - (let new_out_branch (Get (Arg new_input_type assum) len)) - ;; this two subst only change arg to arg with new type - (let substed_pred_out (Subst assum (Arg new_input_type assum) pred_out)) - (let inv_in_new_loop (Subst assum (Arg new_input_type assum) inv)) - (let new_pred_out (Concat substed_pred_out (Single new_out_branch))) - - (let new_loop (DoWhile new_input new_pred_out)) - (union assum (InLoop new_input new_pred_out)) - (union inv_in_new_loop new_out_branch) - (let wrapper (SubTuple new_loop 0 len)) - (union loop wrapper) - (subsume (DoWhile in pred_out)) - ;; don't hoist same loop again - (set (hoisted-loop in pred_out) true) - ) - :ruleset loop-inv-motion) - - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Const _n _ty _ctx))) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Get (Arg ty ctx) i)) - (= loop (DoWhile in pred_out)) - (= expr (Get pred_out (+ i 1)))) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Function _name _tyin _tyout _out)) - - ) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Top _op _x _y _z)) - (= true (is-inv-Expr loop _x)) (= true (is-inv-Expr loop _y)) (= true (is-inv-Expr loop _z)) - ) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Bop _op _x _y)) (BinaryOpIsPure _op) - (= true (is-inv-Expr loop _x)) (= true (is-inv-Expr loop _y)) - ) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Uop _op _x)) (UnaryOpIsPure _op) - (= true (is-inv-Expr loop _x)) - ) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Get _tup _i)) - (= true (is-inv-Expr loop _tup)) - ) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Concat _x _y)) - (= true (is-inv-Expr loop _x)) (= true (is-inv-Expr loop _y)) - ) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Single _x)) - (= true (is-inv-Expr loop _x)) - ) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Switch _pred _inputs _branches)) - (= true (is-inv-Expr loop _pred)) (= true (is-inv-Expr loop _inputs)) (= true (is-inv-ListExpr loop _branches)) - ) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (If _pred _input _then _else)) - (= true (is-inv-Expr loop _pred)) (= true (is-inv-Expr loop _input)) - ) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (DoWhile _in _pred-and-output)) - (= true (is-inv-Expr loop _in)) - (ExprIsPure expr)) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Call _func _arg)) - (= true (is-inv-Expr loop _arg)) - (ExprIsPure expr)) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - -(rule ((BodyContainsExpr loop expr) - (= loop (DoWhile in out)) - (= expr (Empty _ty _ctx)) - - ) - ((set (is-inv-Expr loop expr) true)) :ruleset always-run) - - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Top _op _x _y _z)) - (= expr1 _x)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Top _op _x _y _z)) - (= expr1 _y)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Top _op _x _y _z)) - (= expr1 _z)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Bop _op _x _y)) - (= expr1 _x)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Bop _op _x _y)) - (= expr1 _y)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Uop _op _x)) - (= expr1 _x)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Concat _x _y)) - (= expr1 _x)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Concat _x _y)) - (= expr1 _y)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Single _x)) - (= expr1 _x)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Switch _pred _inputs _branches)) - (= expr1 _pred)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Switch _pred _inputs _branches)) - (= expr1 _inputs)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (If _pred _input _then _else)) - (= expr1 _pred)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (If _pred _input _then _else)) - (= expr1 _input)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (DoWhile _in _pred-and-output)) - (= expr1 _in)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Call _func _arg)) - (= expr1 _arg)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Alloc _id _e _state _ty)) - (= expr1 _e)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) - -(rule ((= true (is-inv-Expr loop expr1)) - (= false (is-inv-Expr loop expr2)) - (= expr2 (Alloc _id _e _state _ty)) - (= expr1 _state)) - ((boundary-Expr loop expr1)) :ruleset boundary-analysis) -;; Some simple simplifications of loops -(ruleset loop-simplify) - -(rewrite - (DoWhile (Arg ty ctx) - (Concat (Single (Const (Bool false) ty ctx2)) - (Single (Const constant ty ctx2)))) - (Single (Const constant ty ctx)) - :ruleset loop-simplify) -;; Some simple simplifications of loops -(ruleset loop-unroll) -(ruleset loop-peel) - -;; inputs, outputs -> number of iterations -;; The minimum possible guess is 1 because of do-while loops -;; TODO: dead loop deletion can turn loops with a false condition to a body -(function LoopNumItersGuess (Expr Expr) i64 :merge (max 1 (min old new))) - -;; by default, guess that all loops run 1000 times -(rule ((DoWhile inputs outputs)) - ((set (LoopNumItersGuess inputs outputs) 1000)) - :ruleset always-run) - -;; Figure out number of iterations for a loop with constant bounds and initial value -;; and i is updated before checking pred -;; TODO: can make this work for increment by any constant -(rule - ((= lhs (DoWhile inputs outputs)) - (= num-inputs (tuple-length inputs)) - (= pred (Get outputs 0)) - ;; iteration counter starts at start_const - (= (Const (Int start_const) _ty1 _ctx1) (Get inputs counter_i)) - ;; updated counter at counter_i - (= next_counter (Get outputs (+ counter_i 1))) - ;; increments by one each loop - (= next_counter (Bop (Add) (Get (Arg _ty _ctx) counter_i) - ;; TODO: put c instead of (Int 1) and mul by c - (Const (Int 1) _ty2 _ctx2))) - ;; while next_counter less than end_constant - (= pred (Bop (LessThan) next_counter - (Const (Int end_constant) _ty3 _ctx3))) - ;; end constant is greater than start constant - (> end_constant start_const) - ) - ( - (set (LoopNumItersGuess inputs outputs) (- end_constant start_const)) - ) - :ruleset always-run) - -;; Figure out number of iterations for a loop with constant bounds and initial value -;; and i is updated after checking pred -(rule - ((= lhs (DoWhile inputs outputs)) - (= num-inputs (tuple-length inputs)) - (= pred (Get outputs 0)) - ;; iteration counter starts at start_const - (= (Const (Int start_const) _ty1 _ctx1) (Get inputs counter_i)) - ;; updated counter at counter_i - (= next_counter (Get outputs (+ counter_i 1))) - ;; increments by one each loop - (= next_counter (Bop (Add) (Get (Arg _ty _ctx) counter_i) - (Const (Int 1) _ty2 _ctx2))) - ;; while this counter less than end_constant - (= pred (Bop (LessThan) (Get (Arg _ty _ctx) counter_i) - (Const (Int end_constant) _ty3 _ctx3))) - ;; end constant is greater than start constant - (> end_constant start_const) - ) - ( - (set (LoopNumItersGuess inputs outputs) (+ (- end_constant start_const) 1)) - ) - :ruleset always-run) - -;; loop peeling rule -;; Only peel loops that we know iterate < 5 times -(rule - ((= lhs (DoWhile inputs outputs)) - (ContextOf lhs ctx) - (HasType inputs inputs-ty) - (= outputs-len (tuple-length outputs)) - (= old_cost (LoopNumItersGuess inputs outputs)) - (< old_cost 5) - ) - ( - (let executed-once - (Subst ctx inputs outputs)) - (let executed-once-body - (SubTuple executed-once 1 (- outputs-len 1))) - (let then-ctx - (InIf true (Get executed-once 0) executed-once-body)) - (let else-ctx - (InIf false (Get executed-once 0) executed-once-body)) - (union lhs - ;; check if we need to continue executing the loop - (If (Get executed-once 0) - executed-once-body ;; inputs are the body executed once - (DoWhile (Arg inputs-ty then-ctx) - outputs) ;; right now, loop unrolling shares the same outputs, but we could add more context here - (Arg inputs-ty else-ctx))) - (set (LoopNumItersGuess (Arg inputs-ty then-ctx) outputs) (- old_cost 1)) - ) - :ruleset loop-peel) - -;; unroll a loop with constant bounds and initial value -(rule - ((= lhs (DoWhile inputs outputs)) - (= num-inputs (tuple-length inputs)) - (= pred (Get outputs 0)) - ;; iteration counter starts at start_const - (= (Const (Int start_const) _ty1 _ctx1) (Get inputs counter_i)) - ;; updated counter at counter_i - (= next_counter (Get outputs (+ counter_i 1))) - ;; increments by one each loop - (= next_counter (Bop (Add) (Get (Arg _ty _ctx) counter_i) - (Const (Int 1) _ty2 _ctx2))) - ;; while less than end_constant - (= pred (Bop (LessThan) next_counter - (Const (Int end_constant) _ty3 _ctx3))) - ;; start and end constant is a multiple of 4 and greater than start_const - (> end_constant start_const) - (= (% start_const 4) 0) - (= (% end_constant 4) 0) - (= old_cost (LoopNumItersGuess inputs outputs)) - ) - ( - (let one-iter (SubTuple outputs 1 num-inputs)) - (let unrolled - (Subst (TmpCtx) one-iter - (Subst (TmpCtx) one-iter - (Subst (TmpCtx) one-iter - outputs)))) - (union lhs - (DoWhile inputs - unrolled)) - (let actual-ctx (InLoop inputs unrolled)) - (union (TmpCtx) actual-ctx) - - (set (LoopNumItersGuess inputs unrolled) (/ old_cost 4)) - (delete (TmpCtx)) - ) - :ruleset loop-unroll) - - - -(ruleset passthrough) - - -;; Pass through thetas -(rule ((= lhs (Get loop i)) - (= loop (DoWhile inputs pred-outputs)) - (= (Get pred-outputs (+ i 1)) (Get (Arg _ty _ctx) i)) - ;; only pass through pure types, since some loops don't terminate - ;; so the state edge must pass through them - (HasType (Get loop i) lhs_ty) - (PureType lhs_ty) - ) - ((union lhs (Get inputs i))) - :ruleset passthrough) - -;; Pass through switch arguments -(rule ((= lhs (Get switch i)) - (= switch (Switch pred inputs branches)) - (= (ListExpr-length branches) 2) - (= branch0 (ListExpr-ith branches 0)) - (= branch1 (ListExpr-ith branches 1)) - (= (Get branch0 i) (Get (Arg _ _ctx0) j)) - (= (Get branch1 i) (Get (Arg _ _ctx1) j)) - (= passed-through (Get inputs j)) - (HasType lhs lhs_ty) - (!= lhs_ty (Base (StateT)))) - ((union lhs passed-through)) - :ruleset passthrough) - -;; Pass through switch predicate -(rule ((= lhs (Get switch i)) - (= switch (Switch pred inputs branches)) - (= (ListExpr-length branches) 2) - (= branch0 (ListExpr-ith branches 0)) - (= branch1 (ListExpr-ith branches 1)) - (= (Get branch0 i) (Const (Bool false) _ _ctx0)) - (= (Get branch1 i) (Const (Bool true) _ _ctx1))) - ((union lhs pred)) - :ruleset passthrough) - -;; Pass through if arguments -(rule ((= if (If pred inputs then_ else_)) - (= (Get then_ i) (Get (Arg arg_ty _then_ctx) j)) - (= (Get else_ i) (Get (Arg arg_ty _else_ctx) j)) - (HasType (Get then_ i) lhs_ty) - (!= lhs_ty (Base (StateT)))) - ((union (Get if i) (Get inputs j))) - :ruleset passthrough) - -; Pass through if state edge arguments -; To maintain the invariant, we have to union the other outputs with a pure if statement -;; TODO This rule causes blowup in the egraph, unclear why -;; disabled for now -(ruleset pass-through-state-edge-if) -(rule ((= outputs (If pred inputs then_ else_)) - - (= (Get then_ i) (Get (Arg arg_ty then_ctx) j)) - (= (Get else_ i) (Get (Arg arg_ty else_ctx) j)) - - (HasType (Get then_ i) (Base (StateT)))) - - ((let lhs (Get outputs i)) - (let new_inputs (TupleRemoveAt inputs j)) - - (let new_then_ctx (InIf true pred new_inputs)) - (let new_else_ctx (InIf false pred new_inputs)) - - (let old_then (TupleRemoveAt then_ i)) - (let old_else (TupleRemoveAt else_ i)) - - (let new_then (DropAt new_then_ctx j old_then)) - (let new_else (DropAt new_else_ctx j old_else)) - - (let old_outputs (TupleRemoveAt outputs i)) - (let new_if (If pred new_inputs new_then new_else)) - (union new_if old_outputs) - - (union lhs (Get inputs j)) - ;; Be careful not to subsume the original if statement immediately, - ;; since TupleRemoveAt still needs to match on it - (ToSubsumeIf pred inputs then_ else_)) - :ruleset pass-through-state-edge-if) - - -;; Pass through if predicate -(rule ((= if (If pred inputs then_ else_)) - (= (Get then_ i) (Const (Bool true) _ _thenctx)) - (= (Get else_ i) (Const (Bool false) _ _elsectx))) - - ((let new_then (TupleRemoveAt then_ i)) - (let new_else (TupleRemoveAt else_ i)) - (let new_if (If pred inputs new_then new_else)) - - (union (Get if i) pred) - (union (TupleRemoveAt if i) new_if) - (ToSubsumeIf pred inputs then_ else_)) - :ruleset passthrough) - -;; ORIGINAL -;; a = 0 -;; c = 3 -;; for i = 0 to n: -;; a = i * c -;; -;; OPTIMIZED -;; a = 0 -;; c = 3 -;; d = 0 -;; for i = 0 to n: -;; a += d -;; d += c -(ruleset loop-strength-reduction) - -; Finds invariants/constants within a body. -; Columns: body; value of invariant in inputs; value of invariant in outputs -;; Get the input and output value of an invariant, or constant int, within the loop -;; loop in out -(relation lsr-inv (Expr Expr Expr)) - -; TODO: there may be a bug with finding the invariant, or it just may not be extracted. -; Can make this work on loop_with_mul_by_inv and a rust test later. -; (rule ( -; (= loop (DoWhile inputs pred-and-body)) -; (= (Get outputs (+ i 1)) (Get (Arg arg-type assm) i))) -; ((inv loop (Get inputs i) (Get (Arg arg-type assm) i))) :ruleset always-run) -(rule ( - (= loop (DoWhile inputs pred-and-body)) - (ContextOf inputs loop-input-ctx) - (ContextOf pred-and-body loop-output-ctx) - (= constant (Const c out-type loop-output-ctx)) - (HasArgType inputs in-type) - ) - ((lsr-inv loop (Const c in-type loop-input-ctx) constant)) :ruleset always-run) - -(rule - ( - ;; Find loop - (= old-loop (DoWhile inputs pred-and-outputs)) - (ContextOf pred-and-outputs loop-ctx) - - ; Find loop variable (argument that gets incremented with an invariant) - (lsr-inv old-loop loop-incr-in loop-incr-out) - ; Since the first el of pred-and-outputs is the pred, we need to offset i - (= (Get pred-and-outputs (+ i 1)) (Bop (Add) (Get (Arg arg-type assm) i) loop-incr-out)) - - ; Find invariant where input is same as output, or constant - (lsr-inv old-loop c-in c-out) - - ; Find multiplication of loop variable and invariant - (= old-mul (Bop (Mul) c-out (Get (Arg arg-type assm) i))) - (ContextOf old-mul loop-ctx) - - (= arg-type (TupleT ty-list)) - ) - ( - ; Each time we need to update d by the product of the multiplied constant and the loop increment - (let addend (Bop (Mul) c-out loop-incr-out)) - - ; n is index of our new, temporary variable d - (let n (tuple-length inputs)) - - ; Initial value of d is i * c - (let d-init (Bop (Mul) c-in (Get inputs i))) - - ; Construct optimized theta - ; new-inputs already has the correct context - (let new-inputs (Concat inputs (Single d-init))) - - ; We need to create a new type, with one more input - (let new-arg-ty (TupleT (TLConcat ty-list (TCons (IntT) (TNil))))) - - ; Value of d in loop. Add context to addend - (let d-out (Bop (Add) (Get (Arg new-arg-ty (TmpCtx)) n) - (Subst (TmpCtx) (Arg new-arg-ty (TmpCtx)) addend))) - - ; build the old body, making sure to set the correct arg type and context - (let new-body - (Concat - (Subst (TmpCtx) (Arg new-arg-ty (TmpCtx)) pred-and-outputs) - (Single d-out))) - - (let new-loop (DoWhile new-inputs new-body)) - - ; Now that we have the new loop, union the temporary context with the actual ctx - (union (TmpCtx) (InLoop new-inputs new-body)) - - ; Substitute d for the *i expression - (let new-mul - (Bop - (Mul) - (Subst (TmpCtx) (Arg new-arg-ty (TmpCtx)) c-out) - (Get (Arg new-arg-ty (TmpCtx)) i))) - (union (Get (Arg new-arg-ty (TmpCtx)) n) new-mul) - - ; Subsume the multiplication in the new loop to prevent - ; from firing loop strength reduction again on the new loop - (subsume - (Bop - (Mul) - (Subst (TmpCtx) (Arg new-arg-ty (TmpCtx)) c-out) - (Get (Arg new-arg-ty (TmpCtx)) i))) - - ; Project all but last - (union old-loop (SubTuple new-loop 0 n)) - (delete (TmpCtx)) - ) - :ruleset loop-strength-reduction -) -(let __tmp0 (StateT )) -(let __tmp1 (TNil )) -(let __tmp2 (TCons __tmp0 __tmp1)) -(let __tmp3 (TupleT __tmp2)) -(let __tmp4 (Print )) -(let __tmp5 (InFunc "main")) -(let __tmp6 (Arg __tmp3 __tmp5)) -(let __tmp7 (Get __tmp6 0)) -(let __tmp8 (Single __tmp7)) -(let __tmp9 (Int 0)) -(let __tmp10 (Const __tmp9 __tmp3 __tmp5)) -(let __tmp11 (Single __tmp10)) -(let __tmp12 (Int 1)) -(let __tmp13 (Const __tmp12 __tmp3 __tmp5)) -(let __tmp14 (Single __tmp13)) -(let __tmp15 (Concat __tmp11 __tmp14)) -(let __tmp16 (Concat __tmp8 __tmp15)) -(let __tmp17 (LessThan )) -(let __tmp18 (IntT )) -(let __tmp19 (TCons __tmp18 __tmp1)) -(let __tmp20 (TCons __tmp18 __tmp19)) -(let __tmp21 (TCons __tmp0 __tmp20)) -(let __tmp22 (TupleT __tmp21)) -(let __tmp23 (InFunc "dummy")) -(let __tmp24 (Arg __tmp22 __tmp23)) -(let __tmp25 (Get __tmp24 1)) -(let __tmp26 (Get __tmp24 2)) -(let __tmp27 (Bop __tmp17 __tmp25 __tmp26)) -(let __tmp28 (Single __tmp27)) -(let __tmp29 (Get __tmp24 0)) -(let __tmp30 (Single __tmp29)) -(let __tmp31 (Add )) -(let __tmp32 (Bop __tmp31 __tmp26 __tmp25)) -(let __tmp33 (Single __tmp32)) -(let __tmp34 (Single __tmp26)) -(let __tmp35 (Concat __tmp33 __tmp34)) -(let __tmp36 (Concat __tmp30 __tmp35)) -(let __tmp37 (Concat __tmp28 __tmp36)) -(let __tmp38 (InLoop __tmp16 __tmp37)) -(let __tmp39 (Arg __tmp22 __tmp38)) -(let __tmp40 (Get __tmp39 1)) -(let __tmp41 (Get __tmp39 2)) -(let __tmp42 (Bop __tmp17 __tmp40 __tmp41)) -(let __tmp43 (Single __tmp42)) -(let __tmp44 (Get __tmp39 0)) -(let __tmp45 (Single __tmp44)) -(let __tmp46 (Bop __tmp31 __tmp41 __tmp40)) -(let __tmp47 (Single __tmp46)) -(let __tmp48 (Single __tmp41)) -(let __tmp49 (Concat __tmp47 __tmp48)) -(let __tmp50 (Concat __tmp45 __tmp49)) -(let __tmp51 (Concat __tmp43 __tmp50)) -(let __tmp52 (DoWhile __tmp16 __tmp51)) -(let __tmp53 (Get __tmp52 1)) -(let __tmp54 (Get __tmp52 0)) -(let __tmp55 (Bop __tmp4 __tmp53 __tmp54)) -(let __tmp56 (Single __tmp55)) -(let __tmp57 (Function "main" __tmp3 __tmp3 __tmp56)) -(let __tmp58 (Nil )) -(let __tmp59 (Program __tmp57 __tmp58)) - -(let PROG __tmp59) -(relation InlinedCall (String Expr)) - -; (let expected (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 2) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))) - -; (let substituted ( Subst (InFunc "main") (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))))) 0)) (Concat (Single (Const (Int 2) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))))))))) -; (let iftrue -; (If (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))))) 0)) (Concat (Single (Const (Int 2) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))))))) (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf false (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))))))) -; (Debug (If (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))))) 0)) (Concat (Single (Const (Int 2) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))))))) (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf false (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))))))) - (unstable-combined-ruleset saturating - always-run - passthrough - canon - type-analysis - context - interval-analysis - memory-helpers - ) - - - (unstable-combined-ruleset optimizations - loop-simplify - memory - loop-unroll - peepholes - loop-peel - ) - - (unstable-combined-ruleset expensive-optimizations - optimizations - switch_rewrite - ;loop-inv-motion - loop-strength-reduction - ) - - (run-schedule - -;; saturate all helpers first -(saturate - (saturate - (saturate type-helpers) ;; resolve type helpers, finding correct types - (saturate error-checking) ;; check for errors, relies on type-helpers saturating - saturating) - - (saturate drop) - apply-drop-unions - cleanup-drop - - subsume-after-helpers - - (saturate subst) ;; do e-substitution - apply-subst-unions ;; apply the unions from substitution - cleanup-subst ;; clean up substitutions that are done - - - (saturate boundary-analysis) ;; find boundaries of invariants -) - - - (repeat 2 - -;; saturate all helpers first -(saturate - (saturate - (saturate type-helpers) ;; resolve type helpers, finding correct types - (saturate error-checking) ;; check for errors, relies on type-helpers saturating - saturating) - - (saturate drop) - apply-drop-unions - cleanup-drop - - subsume-after-helpers - - (saturate subst) ;; do e-substitution - apply-subst-unions ;; apply the unions from substitution - cleanup-subst ;; clean up substitutions that are done - - - (saturate boundary-analysis) ;; find boundaries of invariants -) - - - expensive-optimizations) - (repeat 4 - -;; saturate all helpers first -(saturate - (saturate - (saturate type-helpers) ;; resolve type helpers, finding correct types - (saturate error-checking) ;; check for errors, relies on type-helpers saturating - saturating) - - (saturate drop) - apply-drop-unions - cleanup-drop - - subsume-after-helpers - - (saturate subst) ;; do e-substitution - apply-subst-unions ;; apply the unions from substitution - cleanup-subst ;; clean up substitutions that are done - - - (saturate boundary-analysis) ;; find boundaries of invariants -) - - - optimizations) - -;; saturate all helpers first -(saturate - (saturate - (saturate type-helpers) ;; resolve type helpers, finding correct types - (saturate error-checking) ;; check for errors, relies on type-helpers saturating - saturating) - - (saturate drop) - apply-drop-unions - cleanup-drop - - subsume-after-helpers - - (saturate subst) ;; do e-substitution - apply-subst-unions ;; apply the unions from substitution - cleanup-subst ;; clean up substitutions that are done - - - (saturate boundary-analysis) ;; find boundaries of invariants -) -(saturate - (saturate - (saturate type-helpers) ;; resolve type helpers, finding correct types - (saturate error-checking) ;; check for errors, relies on type-helpers saturating - saturating) - - (saturate drop) - apply-drop-unions - cleanup-drop - - subsume-after-helpers - - (saturate subst) ;; do e-substitution - apply-subst-unions ;; apply the unions from substitution - cleanup-subst ;; clean up substitutions that are done - - - (saturate boundary-analysis) ;; find boundaries of invariants -) - - -) - - -; (print-function Subst 100) -; (let substituted ( Subst (InFunc "main") (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))))) 0)) (Concat (Single (Const (Int 2) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))))))))) -; (let thn (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))))) 0)) (Concat (Single (Const (Int 2) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf true (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))))))))) -; (let els (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InIf false (Const (Bool true) (TupleT (TCons (StateT) (TNil))) (InFunc "main")) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main")))))))) -; (query-extract :variants 5 thn) -; (query-extract :variants 5 els) -; (query-extract :variants 5 substituted) -(query-extract :variants 5 __tmp52) -; (check (= __tmp52 expected)) - -; (print-function Debug 10) -; (DoWhile (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))))))) 1) (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))))))))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))))))) 0)) (Concat (Single (Bop (Add) (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))))))) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))))))) 1))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2)))))))))))) -; (DoWhile (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))))))) 1) (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))))))))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))))))) 0)) (Concat (Single (Bop (Add) (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))))))) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))))))) 1))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InLoop (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TNil))) (InFunc "main")) 0)) (Concat (Single (Const (Int 0) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))) (Single (Const (Int 1) (TupleT (TCons (StateT) (TNil))) (InFunc "main"))))) (Concat (Single (Bop (LessThan) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2))) (Concat (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 0)) (Concat (Single (Bop (Add) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2) (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 1))) (Single (Get (Arg (TupleT (TCons (StateT) (TCons (IntT) (TCons (IntT) (TNil))))) (InFunc "dummy")) 2)))))))))))) - -; (If ) \ No newline at end of file From 539cbd8514f00f1418f0f7cd54a7d4fd0ebf938e Mon Sep 17 00:00:00 2001 From: Kirsten <32720576+kirstenmg@users.noreply.github.com> Date: Thu, 23 May 2024 12:14:17 -0700 Subject: [PATCH 5/7] Update rulesets --- dag_in_context/src/optimizations/loop_unroll.egg | 9 +++++---- dag_in_context/src/optimizations/switch_rewrites.egg | 5 +++-- dag_in_context/src/schedule.rs | 2 ++ tests/snapshots/files__gamma_condition_and-optimize.snap | 2 +- tests/snapshots/files__sqrt-optimize.snap | 4 ++-- 5 files changed, 13 insertions(+), 9 deletions(-) diff --git a/dag_in_context/src/optimizations/loop_unroll.egg b/dag_in_context/src/optimizations/loop_unroll.egg index e02b53ef5..55135d7e5 100644 --- a/dag_in_context/src/optimizations/loop_unroll.egg +++ b/dag_in_context/src/optimizations/loop_unroll.egg @@ -1,6 +1,7 @@ ;; Some simple simplifications of loops (ruleset loop-unroll) (ruleset loop-peel) +(ruleset loop-iters-analysis) ;; inputs, outputs -> number of iterations ;; The minimum possible guess is 1 because of do-while loops @@ -10,14 +11,14 @@ ;; by default, guess that all loops run 1000 times (rule ((DoWhile inputs outputs)) ((set (LoopNumItersGuess inputs outputs) 1000)) - :ruleset always-run) + :ruleset loop-iters-analysis) ;; For a loop that is false, its num iters is 1 (rule ((= loop (DoWhile inputs outputs)) (= (Const (Bool false) ty ctx) (Get outputs 0))) ((set (LoopNumItersGuess inputs outputs) 1)) -:ruleset always-run) +:ruleset loop-iters-analysis) ;; Figure out number of iterations for a loop with constant bounds and initial value ;; and i is updated before checking pred @@ -43,7 +44,7 @@ ( (set (LoopNumItersGuess inputs outputs) (/ (- end_constant start_const) increment)) ) - :ruleset always-run) + :ruleset loop-iters-analysis) ;; Figure out number of iterations for a loop with constant bounds and initial value ;; and i is updated after checking pred @@ -68,7 +69,7 @@ ( (set (LoopNumItersGuess inputs outputs) (+ (/ (- end_constant start_const) increment) 1)) ) - :ruleset always-run) + :ruleset loop-iters-analysis) ;; loop peeling rule ;; Only peel loops that we know iterate < 5 times diff --git a/dag_in_context/src/optimizations/switch_rewrites.egg b/dag_in_context/src/optimizations/switch_rewrites.egg index 748f128d0..778c6eb95 100644 --- a/dag_in_context/src/optimizations/switch_rewrites.egg +++ b/dag_in_context/src/optimizations/switch_rewrites.egg @@ -1,4 +1,5 @@ (ruleset switch_rewrite) +(ruleset always-switch-rewrite) ; if (a and b) X Y ~~> if a (if b X Y) Y (rule ((= lhs (If (Bop (And) a b) ins X Y)) @@ -44,11 +45,11 @@ (rewrite (If (Const (Bool true) ty ctx) ins thn els) (Subst ctx ins thn) - :ruleset always-run) + :ruleset always-switch-rewrite) (rewrite (If (Const (Bool false) ty ctx) ins thn els) (Subst ctx ins els) - :ruleset switch_rewrite) + :ruleset always-switch-rewrite) (rule ((= lhs (If pred ins thn els)) (= (Get thn i) (Const (Bool true) ty ctx1)) diff --git a/dag_in_context/src/schedule.rs b/dag_in_context/src/schedule.rs index 40ec492b5..5ecada4d3 100644 --- a/dag_in_context/src/schedule.rs +++ b/dag_in_context/src/schedule.rs @@ -37,6 +37,8 @@ pub fn mk_schedule() -> String { context interval-analysis memory-helpers + always-switch-rewrite + loop-iters-analysis ) diff --git a/tests/snapshots/files__gamma_condition_and-optimize.snap b/tests/snapshots/files__gamma_condition_and-optimize.snap index 5b6fe2370..d2fb01cff 100644 --- a/tests/snapshots/files__gamma_condition_and-optimize.snap +++ b/tests/snapshots/files__gamma_condition_and-optimize.snap @@ -5,7 +5,7 @@ expression: visualization.result @main(v0: int) { .v1_: v2_: int = const 0; - v3_: bool = gt v0 v2_; + v3_: bool = lt v2_ v0; v4_: bool = lt v0 v2_; v5_: int = const 1; v6_: int = const 3; diff --git a/tests/snapshots/files__sqrt-optimize.snap b/tests/snapshots/files__sqrt-optimize.snap index 35f236503..fb7981af8 100644 --- a/tests/snapshots/files__sqrt-optimize.snap +++ b/tests/snapshots/files__sqrt-optimize.snap @@ -36,8 +36,8 @@ expression: visualization.result v29_: float = fadd v22_ v28_; v30_: float = fdiv v29_ v25_; v31_: float = fdiv v30_ v22_; - v32_: bool = fge v31_ v24_; - v33_: bool = fle v31_ v23_; + v32_: bool = fle v31_ v23_; + v33_: bool = fge v31_ v24_; v34_: bool = and v32_ v33_; v35_: bool = const true; v36_: float = id v21_; From f36cef019332ddada7785276e1ea042201ad383c Mon Sep 17 00:00:00 2001 From: Kirsten <32720576+kirstenmg@users.noreply.github.com> Date: Thu, 23 May 2024 13:59:22 -0700 Subject: [PATCH 6/7] Update snapshot --- dag_in_context/src/optimizations/loop_unroll.egg | 4 ++-- dag_in_context/src/schedule.rs | 2 +- tests/snapshots/files__jumping_loop-optimize.snap | 14 ++++++++++++++ .../files__unroll_multiple_4-optimize.snap | 10 +++++----- 4 files changed, 22 insertions(+), 8 deletions(-) diff --git a/dag_in_context/src/optimizations/loop_unroll.egg b/dag_in_context/src/optimizations/loop_unroll.egg index 55135d7e5..022756849 100644 --- a/dag_in_context/src/optimizations/loop_unroll.egg +++ b/dag_in_context/src/optimizations/loop_unroll.egg @@ -72,14 +72,14 @@ :ruleset loop-iters-analysis) ;; loop peeling rule -;; Only peel loops that we know iterate < 5 times +;; Only peel loops that we know iterate < 3 times (rule ((= lhs (DoWhile inputs outputs)) (ContextOf lhs ctx) (HasType inputs inputs-ty) (= outputs-len (tuple-length outputs)) (= old_cost (LoopNumItersGuess inputs outputs)) - (< old_cost 5) + (< old_cost 3) ) ( (let executed-once diff --git a/dag_in_context/src/schedule.rs b/dag_in_context/src/schedule.rs index 5ecada4d3..e77e5b72d 100644 --- a/dag_in_context/src/schedule.rs +++ b/dag_in_context/src/schedule.rs @@ -47,7 +47,6 @@ pub fn mk_schedule() -> String { memory loop-unroll peepholes - loop-peel ) (unstable-combined-ruleset expensive-optimizations @@ -55,6 +54,7 @@ pub fn mk_schedule() -> String { switch_rewrite ;loop-inv-motion loop-strength-reduction + loop-peel ) (run-schedule diff --git a/tests/snapshots/files__jumping_loop-optimize.snap b/tests/snapshots/files__jumping_loop-optimize.snap index a1c1c23ac..03867db9c 100644 --- a/tests/snapshots/files__jumping_loop-optimize.snap +++ b/tests/snapshots/files__jumping_loop-optimize.snap @@ -4,4 +4,18 @@ expression: visualization.result --- @main { .v0_: + v1_: int = const 0; + v2_: int = const 18; + v3_: int = const 4; + v4_: int = id v1_; + v5_: int = id v2_; + v6_: int = id v3_; +.v7_: + v8_: int = add v4_ v6_; + v9_: bool = lt v8_ v5_; + v4_: int = id v8_; + v5_: int = id v5_; + v6_: int = id v6_; + br v9_ .v7_ .v10_; +.v10_: } diff --git a/tests/snapshots/files__unroll_multiple_4-optimize.snap b/tests/snapshots/files__unroll_multiple_4-optimize.snap index 093bd6745..e338c81fa 100644 --- a/tests/snapshots/files__unroll_multiple_4-optimize.snap +++ b/tests/snapshots/files__unroll_multiple_4-optimize.snap @@ -4,11 +4,11 @@ expression: visualization.result --- @main { .v0_: - v1_: int = const 16; - v2_: int = const 0; + v1_: int = const 0; + v2_: int = const 16; v3_: int = const 1; - v4_: int = id v2_; - v5_: int = id v1_; + v4_: int = id v1_; + v5_: int = id v2_; v6_: int = id v3_; .v7_: v8_: int = add v4_ v6_; @@ -21,5 +21,5 @@ expression: visualization.result v6_: int = id v6_; br v12_ .v7_ .v13_; .v13_: - print v1_; + print v4_; } From 73bd6719d7d4f0666ba3768b6dfc7156a3d4dcc9 Mon Sep 17 00:00:00 2001 From: Kirsten <32720576+kirstenmg@users.noreply.github.com> Date: Fri, 24 May 2024 15:10:36 -0700 Subject: [PATCH 7/7] Snapshots --- .../files__range_check-optimize.snap | 23 ------------------- .../files__range_splitting-optimize.snap | 21 ----------------- 2 files changed, 44 deletions(-) diff --git a/tests/snapshots/files__range_check-optimize.snap b/tests/snapshots/files__range_check-optimize.snap index cc6d1879f..59f868ab0 100644 --- a/tests/snapshots/files__range_check-optimize.snap +++ b/tests/snapshots/files__range_check-optimize.snap @@ -22,7 +22,6 @@ expression: visualization.result v15_: int = id v14_; br v5_ .v16_ .v17_; .v16_: -<<<<<<< HEAD v15_: int = id v14_; .v17_: v2_: int = id v15_; @@ -34,26 +33,4 @@ expression: visualization.result jmp .v12_; .v18_: print v2_; -======= - v17_: int = const 1; - v18_: int = add v17_ v6_; - v19_: int = id v18_; - br v9_ .v20_ .v21_; -.v20_: - v19_: int = id v18_; -.v21_: - v6_: int = id v19_; - br v9_ .v7_ .v22_; -.v22_: - v3_: int = id v6_; - print v3_; - ret; -.v13_: - v23_: int = const 2; - print v23_; - v15_: int = id v6_; - jmp .v16_; -.v5_: - print v3_; ->>>>>>> main } diff --git a/tests/snapshots/files__range_splitting-optimize.snap b/tests/snapshots/files__range_splitting-optimize.snap index 925a9af76..1e64a449e 100644 --- a/tests/snapshots/files__range_splitting-optimize.snap +++ b/tests/snapshots/files__range_splitting-optimize.snap @@ -31,26 +31,5 @@ expression: visualization.result v12_: int = id v2_; jmp .v13_; .v17_: -<<<<<<< HEAD print v2_; -======= - v18_: int = id v9_; - br v11_ .v19_ .v20_; -.v19_: - v18_: int = id v9_; -.v20_: - v6_: int = id v18_; - br v11_ .v7_ .v21_; -.v21_: - v3_: int = id v6_; - print v3_; - ret; -.v14_: - v22_: int = const 2; - print v22_; - v16_: int = id v6_; - jmp .v17_; -.v5_: - print v3_; ->>>>>>> main }