home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-src.tgz / tar.out / fsf / octave / src / tree-misc.cc < prev    next >
C/C++ Source or Header  |  1996-09-28  |  11KB  |  638 lines
  1. // tree-misc.cc                                          -*- C++ -*-
  2. /*
  3.  
  4. Copyright (C) 1992, 1993, 1994, 1995 John W. Eaton
  5.  
  6. This file is part of Octave.
  7.  
  8. Octave is free software; you can redistribute it and/or modify it
  9. under the terms of the GNU General Public License as published by the
  10. Free Software Foundation; either version 2, or (at your option) any
  11. later version.
  12.  
  13. Octave is distributed in the hope that it will be useful, but WITHOUT
  14. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  16. for more details.
  17.  
  18. You should have received a copy of the GNU General Public License
  19. along with Octave; see the file COPYING.  If not, write to the Free
  20. Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. */
  23.  
  24. #ifdef HAVE_CONFIG_H
  25. #include "config.h"
  26. #endif
  27.  
  28. #include <sys/types.h>
  29. #ifdef HAVE_UNISTD_H
  30. #include <unistd.h>
  31. #endif
  32.  
  33. #include <iostream.h>
  34.  
  35. #include "error.h"
  36. #include "tree-base.h"
  37. #include "tree-expr.h"
  38. #include "tree-cmd.h"
  39. #include "octave.h"
  40. #include "tree-misc.h"
  41. #include "tree-const.h"
  42. #include "user-prefs.h"
  43. #include "oct-obj.h"
  44.  
  45. // Nonzero means we're breaking out of a loop or function body.
  46. extern int breaking;
  47.  
  48. // Nonzero means we're jumping to the end of a loop.
  49. extern int continuing;
  50.  
  51. // Nonzero means we're returning from a function.
  52. extern int returning;
  53.  
  54. // A list of commands to be executed.
  55.  
  56. tree_statement::~tree_statement (void)
  57. {
  58.   delete command;
  59.   delete expression;
  60. }
  61.  
  62. void
  63. tree_statement::print_code (ostream& os)
  64. {
  65.   if (command)
  66.     {
  67.       command->print_code (os);
  68.  
  69.       if (! print_flag)
  70.     os << ";";
  71.  
  72.       command->print_code_new_line (os);
  73.     }
  74.   else if (expression)
  75.     {
  76.       expression->print_code (os);
  77.  
  78.       if (! print_flag)
  79.     os << ";";
  80.  
  81.       expression->print_code_new_line (os);
  82.     }
  83.  
  84.  
  85. }
  86.  
  87. tree_constant
  88. tree_statement_list::eval (int print)
  89. {
  90.   int pf;
  91.   tree_constant retval;
  92.  
  93.   if (error_state)
  94.     return retval;
  95.  
  96.   for (Pix p = first (); p != 0; next (p))
  97.     {
  98.       tree_statement *elt = this->operator () (p);
  99.  
  100.       if (print == 0)
  101.     pf = 0;
  102.       else
  103.     pf = elt->print_flag;
  104.  
  105.       tree_command *cmd = elt->command;
  106.       tree_expression *expr = elt->expression;
  107.  
  108.       if (cmd || expr)
  109.     {
  110.       if (cmd)
  111.         cmd->eval ();
  112.       else
  113.         retval = expr->eval (pf);
  114.  
  115.       if (error_state)
  116.         return tree_constant ();
  117.  
  118.       if (breaking || continuing)
  119.         break;
  120.  
  121.       if (returning)
  122.         break;
  123.     }
  124.       else
  125.     retval = tree_constant ();
  126.     }
  127.   return retval;
  128. }
  129.  
  130. Octave_object
  131. tree_statement_list::eval (int print, int nargout)
  132. {
  133.   Octave_object retval;
  134.  
  135.   if (nargout > 1)
  136.     {
  137.       int pf;
  138.  
  139.       if (error_state)
  140.     return retval;
  141.  
  142.       for (Pix p = first (); p != 0; next (p))
  143.     {
  144.       tree_statement *elt = this->operator () (p);
  145.  
  146.       if (print == 0)
  147.         pf = 0;
  148.       else
  149.         pf = elt->print_flag;
  150.  
  151.       tree_command *cmd = elt->command;
  152.       tree_expression *expr = elt->expression;
  153.  
  154.       if (cmd || expr)
  155.         {
  156.           if (cmd)
  157.         cmd->eval ();
  158.           else
  159.         {
  160.           if (expr->is_multi_val_ret_expression ())
  161.             {
  162.               Octave_object args;
  163.               tree_multi_val_ret *t = (tree_multi_val_ret *) expr;
  164.               retval = t->eval (pf, nargout, args);
  165.             }
  166.           else
  167.             retval = expr->eval (pf);
  168.         }
  169.  
  170.           if (error_state)
  171.         return tree_constant ();
  172.  
  173.           if (breaking || continuing)
  174.         break;
  175.  
  176.           if (returning)
  177.         break;
  178.         }
  179.       else
  180.         retval = Octave_object ();
  181.     }
  182.       return retval;
  183.     }
  184.   else
  185.     retval = eval (print);
  186.  
  187.   return retval;
  188. }
  189.  
  190. void
  191. tree_statement_list::print_code (ostream& os)
  192. {
  193.   for (Pix p = first (); p != 0; next (p))
  194.     {
  195.       tree_statement *elt = this->operator () (p);
  196.  
  197.       if (elt)
  198.     elt->print_code (os);
  199.     }
  200. }
  201.  
  202. Octave_object
  203. tree_argument_list::convert_to_const_vector (void)
  204. {
  205.   int len = length ();
  206.  
  207. // XXX FIXME XXX -- would be nice to know in advance how largs args
  208. // needs to be even when we have a list containing an all_va_args
  209. // token.
  210.  
  211.   Octave_object args;
  212.   args.resize (len);
  213.  
  214.   Pix p = first ();
  215.   int j = 0;
  216.   for (int k = 0; k < len; k++)
  217.     {
  218.       tree_expression *elt = this->operator () (p);
  219.       if (elt)
  220.     {
  221.       tree_constant tmp = elt->eval (0);
  222.       if (error_state)
  223.         {
  224.           ::error ("evaluating argument list element number %d", k);
  225.           args = Octave_object ();
  226.           break;
  227.         }
  228.       else
  229.         {
  230.           if (tmp.is_all_va_args ())
  231.         {
  232.           if (curr_function)
  233.             {
  234.               Octave_object tva;
  235.               tva = curr_function->octave_all_va_args ();
  236.               int n = tva.length ();
  237.               for (int i = 0; i < n; i++)
  238.             args(j++) = tva(i);
  239.             }
  240.           else
  241.             {
  242.               ::error ("all_va_args is only valid inside functions");
  243.               args = Octave_object ();
  244.               break;
  245.             }
  246.         }
  247.           else
  248.         args(j++) = tmp;
  249.         }
  250.       next (p);
  251.     }
  252.       else
  253.     {
  254.       args(j++) = tree_constant ();
  255.       break;
  256.     }
  257.     }
  258.  
  259.   args.resize (j);
  260.  
  261.   return args;
  262. }
  263.  
  264. void
  265. tree_argument_list::print_code (ostream& os)
  266. {
  267.   Pix p = first ();
  268.  
  269.   while (p)
  270.     {
  271.       tree_expression *elt = this->operator () (p);
  272.  
  273.       next (p);
  274.  
  275.       if (elt)
  276.     {
  277.       elt->print_code (os);
  278.  
  279.       if (p)
  280.         os << ", ";
  281.     }
  282.     }
  283. }
  284.  
  285. // Parameter lists.
  286.  
  287. void
  288. tree_parameter_list::mark_as_formal_parameters (void)
  289. {
  290.   for (Pix p = first (); p != 0; next (p))
  291.     {
  292.       tree_identifier *elt = this->operator () (p);
  293.       elt->mark_as_formal_parameter ();
  294.     }
  295. }
  296.  
  297. void
  298. tree_parameter_list::initialize_undefined_elements (tree_constant& val)
  299. {
  300.   for (Pix p = first (); p != 0; next (p))
  301.     {
  302.       tree_identifier *elt = this->operator () (p);
  303.       if (! elt->is_defined ())
  304.     elt->assign (val);
  305.     }
  306. }
  307.  
  308. void
  309. tree_parameter_list::define_from_arg_vector (const Octave_object& args)
  310. {
  311.   int nargin = args.length ();
  312.  
  313.   if (nargin <= 0)
  314.     return;
  315.  
  316.   int expected_nargin = length ();
  317.  
  318.   Pix p = first ();
  319.  
  320.   for (int i = 0; i < expected_nargin; i++)
  321.     {
  322.       tree_identifier *elt = this->operator () (p);
  323.  
  324.       tree_constant *tmp = 0;
  325.  
  326.       if (i < nargin)
  327.     {
  328.       if (args(i).is_defined () && args(i).is_magic_colon ())
  329.         {
  330.           ::error ("invalid use of colon in function argument list");
  331.           return;
  332.         }
  333.       tmp = new tree_constant (args(i));
  334.     }
  335.  
  336.       elt->define (tmp);
  337.  
  338.       next (p);
  339.     }
  340. }
  341.  
  342. Octave_object
  343. tree_parameter_list::convert_to_const_vector (tree_va_return_list *vr_list)
  344. {
  345.   int nout = length ();
  346.  
  347.   if (vr_list)
  348.     nout += vr_list->length ();
  349.  
  350.   Octave_object retval;
  351.   retval.resize (nout);
  352.  
  353.   int i = 0;
  354.  
  355.   for (Pix p = first (); p != 0; next (p))
  356.     {
  357.       tree_identifier *elt = this->operator () (p);
  358.  
  359.       if (elt->is_defined ())
  360.     retval(i) = elt->eval (0);
  361.  
  362.       i++;
  363.     }
  364.  
  365.   if (vr_list)
  366.     {
  367.       for (p = vr_list->first (); p != 0; vr_list->next (p))
  368.     {
  369.       retval(i) = vr_list->operator () (p);
  370.       i++;
  371.     }
  372.     }
  373.  
  374.   return retval;
  375. }
  376.  
  377. int
  378. tree_parameter_list::is_defined (void)
  379. {
  380.   int status = 1;
  381.  
  382.   for (Pix p = first (); p != 0; next (p))
  383.     {
  384.       tree_identifier *elt = this->operator () (p);
  385.  
  386.       if (! elt->is_defined ())
  387.     {
  388.       status = 0;
  389.       break;
  390.     }
  391.     }
  392.  
  393.   return status;
  394. }
  395.  
  396. void
  397. tree_parameter_list::print_code (ostream& os)
  398. {
  399.   Pix p = first ();
  400.  
  401.   while (p)
  402.     {
  403.       tree_identifier *elt = this->operator () (p);
  404.  
  405.       next (p);
  406.  
  407.       if (elt)
  408.     {
  409.       elt->print_code (os);
  410.  
  411.       if (p)
  412.         os << ", ";
  413.     }
  414.     }
  415. }
  416.  
  417. // Return lists.
  418.  
  419. void
  420. tree_return_list::print_code (ostream& os)
  421. {
  422.   Pix p = first ();
  423.  
  424.   while (p)
  425.     {
  426.       tree_index_expression *elt = this->operator () (p);
  427.  
  428.       next (p);
  429.  
  430.       if (elt)
  431.     {
  432.       elt->print_code (os);
  433.  
  434.       if (p)
  435.         os << ", ";
  436.     }
  437.     }
  438. }
  439.  
  440. // Global.
  441.  
  442. void
  443. tree_global::eval (void)
  444. {
  445.   if (ident)
  446.     {
  447.       ident->link_to_global ();
  448.     }
  449.   else if (assign_expr)
  450.     {
  451.       tree_identifier *id = 0;
  452.       if (assign_expr->left_hand_side_is_identifier_only ()
  453.       && (id = assign_expr->left_hand_side_id ()))
  454.     {
  455.       id->link_to_global ();
  456.       assign_expr->eval (0);
  457.     }
  458.       else
  459.     error ("global: unable to make individual structure elements global");
  460.     }
  461. }
  462.  
  463. void
  464. tree_global::print_code (ostream& os)
  465. {
  466.   if (ident)
  467.     ident->print_code (os);
  468.  
  469.   if (assign_expr)
  470.     assign_expr->print_code (os);
  471. }
  472.  
  473. // Global initializer lists.
  474.  
  475. void
  476. tree_global_init_list::eval (void)
  477. {
  478.   for (Pix p = first (); p != 0; next (p))
  479.     {
  480.       tree_global *t = this->operator () (p);
  481.       t->eval ();
  482.     }
  483. }
  484.  
  485. void
  486. tree_global_init_list::print_code (ostream& os)
  487. {
  488.   Pix p = first ();
  489.  
  490.   while (p)
  491.     {
  492.       tree_global *elt = this->operator () (p);
  493.  
  494.       next (p);
  495.  
  496.       if (elt)
  497.     {
  498.       elt->print_code (os);
  499.  
  500.       if (p)
  501.         os << ", ";
  502.     }
  503.     }
  504. }
  505.  
  506. // If.
  507.  
  508. int
  509. tree_if_clause::is_else_clause (void)
  510. {
  511.   return (! expr);
  512. }
  513.  
  514. int
  515. tree_if_clause::eval (void)
  516. {
  517.   if (expr)
  518.     {
  519.       tree_constant t1 = expr->eval (0);
  520.  
  521.       if (error_state || t1.is_undefined ())
  522.     return 0;
  523.  
  524.       if (t1.rows () == 0 || t1.columns () == 0)
  525.     {
  526.       int flag = user_pref.propagate_empty_matrices;
  527.       if (flag < 0)
  528.         warning ("if: empty matrix used in conditional");
  529.       else if (flag == 0)
  530.         {
  531.           ::error ("if: empty matrix used in conditional");
  532.           return 0;
  533.         }
  534.       t1 = tree_constant (0.0);
  535.     }
  536.       else if (! t1.is_scalar_type ())
  537.     {
  538.       tree_constant t2 = t1.all ();
  539.       t1 = t2.all ();
  540.     }
  541.  
  542.       int expr_value = 0;
  543.  
  544.       if (t1.is_real_scalar ())
  545.     expr_value = (int) t1.double_value ();
  546.       else if (t1.is_complex_scalar ())
  547.     expr_value = t1.complex_value () != 0.0;
  548.       else
  549.     error ("if: all (all (cond)) is not a scalar");
  550.  
  551.       if (expr_value)
  552.     {
  553.       if (list)
  554.         list->eval (1);
  555.  
  556.       return 1;
  557.     }
  558.     }
  559.   else
  560.     {
  561.       if (list)
  562.     list->eval (1);
  563.  
  564.       return 1;
  565.     }
  566.  
  567.   return 0;
  568. }
  569.  
  570. void
  571. tree_if_clause::print_code (ostream& os)
  572. {
  573.   if (expr)
  574.     expr->print_code (os);
  575.  
  576.   print_code_new_line (os);
  577.   increment_indent_level ();
  578.  
  579.   if (list)
  580.     {
  581.       list->print_code (os);
  582.  
  583.       decrement_indent_level ();
  584.     }
  585. }
  586.  
  587. // List of if commands.
  588.  
  589. void
  590. tree_if_command_list::eval (void)
  591. {
  592.   for (Pix p = first (); p != 0; next (p))
  593.     {
  594.       tree_if_clause *t = this->operator () (p);
  595.  
  596.       if (t->eval () || error_state)
  597.     break;
  598.     }
  599. }
  600.  
  601. void
  602. tree_if_command_list::print_code (ostream& os)
  603. {
  604.   Pix p = first ();
  605.  
  606.   int first_elt = 1;
  607.  
  608.   while (p)
  609.     {
  610.       tree_if_clause *elt = this->operator () (p);
  611.  
  612.       if (elt)
  613.     {
  614.       if (! first_elt)
  615.         {
  616.           print_code_indent (os);
  617.  
  618.           if (elt->is_else_clause ())
  619.         os << "else";
  620.           else
  621.         os << "elseif ";
  622.         }
  623.  
  624.       elt->print_code (os);
  625.     }
  626.  
  627.       first_elt = 0;
  628.       next (p);
  629.     }
  630. }
  631.  
  632. /*
  633. ;;; Local Variables: ***
  634. ;;; mode: C++ ***
  635. ;;; page-delimiter: "^/\\*" ***
  636. ;;; End: ***
  637. */
  638.