1 //////////////////////////////////////////////////////////////////////// 2 // 3 // Copyright (C) 2008-2021 The Octave Project Developers 4 // 5 // See the file COPYRIGHT.md in the top-level directory of this 6 // distribution or <https://octave.org/copyright/>. 7 // 8 // This file is part of Octave. 9 // 10 // Octave is free software: you can redistribute it and/or modify it 11 // under the terms of the GNU General Public License as published by 12 // the Free Software Foundation, either version 3 of the License, or 13 // (at your option) any later version. 14 // 15 // Octave is distributed in the hope that it will be useful, but 16 // WITHOUT ANY WARRANTY; without even the implied warranty of 17 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 // GNU General Public License for more details. 19 // 20 // You should have received a copy of the GNU General Public License 21 // along with Octave; see the file COPYING. If not, see 22 // <https://www.gnu.org/licenses/>. 23 // 24 //////////////////////////////////////////////////////////////////////// 25 26 #if defined (HAVE_CONFIG_H) 27 # include "config.h" 28 #endif 29 30 #include "interpreter.h" 31 #include "ov.h" 32 #include "pt-cbinop.h" 33 #include "pt-eval.h" 34 #include "pt-unop.h" 35 36 namespace octave 37 { 38 octave_value evaluate(tree_evaluator & tw,int)39 tree_compound_binary_expression::evaluate (tree_evaluator& tw, int) 40 { 41 octave_value val; 42 43 if (m_lhs) 44 { 45 octave_value a = m_lhs->evaluate (tw); 46 47 if (a.is_defined () && m_rhs) 48 { 49 octave_value b = m_rhs->evaluate (tw); 50 51 if (b.is_defined ()) 52 { 53 interpreter& interp = tw.get_interpreter (); 54 55 type_info& ti = interp.get_type_info (); 56 57 val = ::do_binary_op (ti, m_etype, a, b); 58 } 59 } 60 } 61 62 return val; 63 } 64 65 typedef tree_expression* tree_expression_ptr_t; 66 67 // If a tree expression is a transpose or hermitian transpose, return 68 // the argument and corresponding operator. 69 70 static octave_value::unary_op strip_trans_herm(tree_expression_ptr_t & exp)71 strip_trans_herm (tree_expression_ptr_t& exp) 72 { 73 if (exp->is_unary_expression ()) 74 { 75 tree_unary_expression *uexp 76 = dynamic_cast<tree_unary_expression *> (exp); 77 78 octave_value::unary_op op = uexp->op_type (); 79 80 if (op == octave_value::op_transpose 81 || op == octave_value::op_hermitian) 82 exp = uexp->operand (); 83 else 84 op = octave_value::unknown_unary_op; 85 86 return op; 87 } 88 else 89 return octave_value::unknown_unary_op; 90 } 91 92 #if 0 93 // Restore this code if short-circuit behavior can be preserved when needed. 94 // See bug #54465. 95 96 static octave_value::unary_op 97 strip_not (tree_expression_ptr_t& exp) 98 { 99 if (exp->is_unary_expression ()) 100 { 101 tree_unary_expression *uexp 102 = dynamic_cast<tree_unary_expression *> (exp); 103 104 octave_value::unary_op op = uexp->op_type (); 105 106 if (op == octave_value::op_not) 107 exp = uexp->operand (); 108 else 109 op = octave_value::unknown_unary_op; 110 111 return op; 112 } 113 else 114 return octave_value::unknown_unary_op; 115 } 116 #endif 117 118 // Possibly convert multiplication to trans_mul, mul_trans, herm_mul, 119 // or mul_herm. 120 121 static octave_value::compound_binary_op simplify_mul_op(tree_expression_ptr_t & a,tree_expression_ptr_t & b)122 simplify_mul_op (tree_expression_ptr_t& a, tree_expression_ptr_t& b) 123 { 124 octave_value::compound_binary_op retop 125 = octave_value::unknown_compound_binary_op; 126 127 octave_value::unary_op opa = strip_trans_herm (a); 128 129 if (opa == octave_value::op_hermitian) 130 retop = octave_value::op_herm_mul; 131 else if (opa == octave_value::op_transpose) 132 retop = octave_value::op_trans_mul; 133 else 134 { 135 octave_value::unary_op opb = strip_trans_herm (b); 136 137 if (opb == octave_value::op_hermitian) 138 retop = octave_value::op_mul_herm; 139 else if (opb == octave_value::op_transpose) 140 retop = octave_value::op_mul_trans; 141 } 142 143 return retop; 144 } 145 146 // Possibly convert left division to trans_ldiv or herm_ldiv. 147 148 static octave_value::compound_binary_op simplify_ldiv_op(tree_expression_ptr_t & a,tree_expression_ptr_t &)149 simplify_ldiv_op (tree_expression_ptr_t& a, tree_expression_ptr_t&) 150 { 151 octave_value::compound_binary_op retop 152 = octave_value::unknown_compound_binary_op; 153 154 octave_value::unary_op opa = strip_trans_herm (a); 155 156 if (opa == octave_value::op_hermitian) 157 retop = octave_value::op_herm_ldiv; 158 else if (opa == octave_value::op_transpose) 159 retop = octave_value::op_trans_ldiv; 160 161 return retop; 162 } 163 164 // Possibly contract and/or with negation. 165 166 #if 0 167 // Restore this code if short-circuit behavior can be preserved when needed. 168 // See bug #54465. 169 static octave_value::compound_binary_op 170 simplify_and_or_op (tree_expression_ptr_t& a, tree_expression_ptr_t& b, 171 octave_value::binary_op op) 172 { 173 octave_value::compound_binary_op retop 174 = octave_value::unknown_compound_binary_op; 175 176 octave_value::unary_op opa = strip_not (a); 177 178 if (opa == octave_value::op_not) 179 { 180 if (op == octave_value::op_el_and) 181 retop = octave_value::op_el_not_and; 182 else if (op == octave_value::op_el_or) 183 retop = octave_value::op_el_not_or; 184 } 185 else 186 { 187 octave_value::unary_op opb = strip_not (b); 188 189 if (opb == octave_value::op_not) 190 { 191 if (op == octave_value::op_el_and) 192 retop = octave_value::op_el_and_not; 193 else if (op == octave_value::op_el_or) 194 retop = octave_value::op_el_or_not; 195 } 196 } 197 198 return retop; 199 } 200 #endif 201 202 tree_binary_expression * maybe_compound_binary_expression(tree_expression * a,tree_expression * b,int l,int c,octave_value::binary_op t)203 maybe_compound_binary_expression (tree_expression *a, tree_expression *b, 204 int l, int c, octave_value::binary_op t) 205 { 206 tree_expression *ca = a; 207 tree_expression *cb = b; 208 octave_value::compound_binary_op ct; 209 210 switch (t) 211 { 212 case octave_value::op_mul: 213 ct = simplify_mul_op (ca, cb); 214 break; 215 216 case octave_value::op_ldiv: 217 ct = simplify_ldiv_op (ca, cb); 218 break; 219 220 #if 0 221 // Restore this case if short-circuit behavior can be preserved 222 // when needed. See bug #54465. 223 case octave_value::op_el_and: 224 case octave_value::op_el_or: 225 ct = simplify_and_or_op (ca, cb, t); 226 break; 227 #endif 228 229 default: 230 ct = octave_value::unknown_compound_binary_op; 231 break; 232 } 233 234 tree_binary_expression *ret 235 = (ct == octave_value::unknown_compound_binary_op 236 ? new tree_binary_expression (a, b, l, c, t) 237 : new tree_compound_binary_expression (a, b, l, c, t, ca, cb, ct)); 238 239 return ret; 240 } 241 } 242