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