home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 04 / calcsim2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-04-26  |  23.5 KB  |  530 lines
  1. (*****************************************************************************)
  2. (*                              CALCSIM2.PAS                                 *)
  3. (*                                                                           *)
  4. (*                     Vereinfachen von Calc-Programmen Teil 2               *)
  5. (*****************************************************************************)
  6.  
  7. PROCEDURE simple(pptr : calc_prog);
  8.  
  9. VAR pptra,pptrb : calc_prog;
  10.  
  11.   PROCEDURE restoreptr;
  12.  
  13.   BEGIN
  14.     pptra := pptr^.nextinst;
  15.     pptrb := endof(pptra);
  16.     IF pptrb <> nil
  17.       THEN
  18.         pptrb := pptrb^.nextinst;
  19.   END;
  20.  
  21.   PROCEDURE erase_entry;
  22.  
  23.   BEGIN
  24.     WHILE help1 <> pptrb DO
  25.       BEGIN
  26.         help2 := help1;
  27.         help1 := help1^.nextinst;
  28.         Dispose(help2)
  29.       END;
  30.   END;
  31.  
  32.   PROCEDURE pusha;
  33.  
  34.   BEGIN
  35.     pptr^ := pptra^;
  36.     help1 := pptr;
  37.     WHILE help1^.nextinst <> pptrb DO
  38.       help1 := help1^.nextinst;
  39.     help1^.nextinst := pptrb^.nextinst;
  40.     Dispose(pptra);
  41.     Dispose(pptrb);
  42.     restoreptr
  43.   END;
  44.  
  45.   PROCEDURE skipa;
  46.  
  47.   BEGIN
  48.     help1 := pptr^.nextinst;
  49.     erase_entry;
  50.     pptr^ := pptrb^;
  51.     Dispose(pptrb);
  52.     restoreptr
  53.   END;
  54.  
  55.   PROCEDURE setconst(dummy : calc_operand);
  56.  
  57.   BEGIN
  58.     pptr^.instruct := calc_const;
  59.     pptr^.operand := dummy;
  60.     pptr^.nextinst := pptrb^.nextinst;
  61.     help1 := pptra;
  62.     erase_entry;
  63.     Dispose(pptrb);
  64.     restoreptr
  65.   END;
  66.  
  67. BEGIN
  68.   IF pptr <> nil
  69.     THEN
  70.       BEGIN
  71.         restoreptr;
  72.         IF pptr^.instruct IN [calc_neg,calc_sqr..calc_fak]
  73.           THEN
  74.             BEGIN
  75.               simple(pptra);
  76.               IF pptra^.instruct = calc_const
  77.                 THEN   (* ausrechnen ! *)
  78.                   BEGIN
  79.                     dummy := compute(pptr, pptra,nil);
  80.               (* leider ist 0.0 <> -0.0 deshalb : *)
  81.                     IF dummy = -0.0
  82.                       THEN
  83.                         dummy := 0.0;
  84.                     pptr^.instruct := calc_const;
  85.                     pptr^.operand := dummy;
  86.                     pptr^.nextinst := pptra^. nextinst;
  87.                     Dispose(pptra);
  88.                     restoreptr
  89.                   END;
  90.               IF pptr^.instruct = calc_neg
  91.                 THEN
  92.                   BEGIN
  93.                     IF pptra^.instruct = calc_neg
  94.                       THEN
  95.                         BEGIN
  96.                           pptr^ := pptra^.nextinst^;
  97.                           Dispose(pptra^.nextinst);
  98.                           Dispose(pptra);
  99.                           restoreptr
  100.                         END
  101.                   END;
  102.               IF (pptr^.instruct = calc_neg) AND(pptra^.instruct IN [
  103.                   calc_mul.. calc_div])
  104.                 THEN
  105.                   BEGIN
  106.                     help1 := endof(pptra^.nextinst);
  107.                     IF pptra^.nextinst^.instruct = calc_const
  108.                       THEN
  109.                         BEGIN
  110.                           pptra^.nextinst^.operand := -pptra^.nextinst^.
  111.                                                         operand;
  112.                           pptr^ := pptra^;
  113.                           Dispose(pptra);
  114.                           restoreptr;
  115.                         END
  116.                       ELSE
  117.                         IF help1^.nextinst^.instruct = calc_const
  118.                           THEN
  119.                             BEGIN
  120.                               help1^.nextinst^.operand := - help1^.
  121.                                                             nextinst^.
  122.                                                             operand;
  123.                               pptr^ := pptra^;
  124.                               Dispose(pptra);
  125.                               restoreptr;
  126.                             END
  127.                   END;
  128.             END
  129.           ELSE  (* jetzt werden Operationen mit Konstanten vereinfacht *)
  130.             IF pptr^.instruct IN [calc_add..calc_pow]
  131.               THEN
  132.                 BEGIN
  133.                   simple(pptra);
  134.                   simple(pptrb);
  135.                   arg1 := pptra^.instruct = calc_const;
  136.                   arg2 := pptrb^.instruct = calc_const;
  137.                   IF arg1 AND arg2
  138.                     THEN
  139.                       BEGIN
  140.                         dummy := compute(pptr,pptrb,pptra);
  141.                         pptr^.instruct := calc_const;
  142.                         pptr^.operand := dummy;
  143.                         pptr^.nextinst := pptrb^.nextinst;
  144.                         Dispose(pptra);
  145.                         Dispose(pptrb);
  146.                         restoreptr
  147.                       END
  148.                     ELSE
  149.                       IF arg2
  150.                         THEN
  151.                           BEGIN
  152.                             IF pptrb^.operand = 0.0
  153.                               THEN
  154.                                 BEGIN
  155.                                   IF pptr^.instruct IN[calc_mul.. calc_div,
  156.                                       calc_pow]
  157.                                     THEN
  158.                                       setconst(0.0)
  159.                                     ELSE
  160.                                       IF pptr^.instruct = calc_add
  161.                                         THEN
  162.                                           pusha
  163.                                         ELSE
  164.                                           IF pptr^.instruct = calc_sub
  165.                                             THEN
  166.                                               BEGIN
  167.                                                 pptr^.instruct := calc_neg;
  168.                                                 help1 := endof(pptra);
  169.                                                 help1^.nextinst := pptrb^.
  170.                                                                    nextinst
  171.                                                   ;
  172.                                                 Dispose(pptrb);
  173.                                                 restoreptr
  174.                                               END
  175.                                 END
  176.                               ELSE
  177.                                 IF (pptrb^.operand = 1.0) AND(pptr^.
  178.                                     instruct IN[ calc_mul, calc_pow])
  179.                                   THEN
  180.                                     BEGIN
  181.                                       IF pptr^.instruct = calc_mul
  182.                                         THEN
  183.                                           pusha
  184.                                         ELSE
  185.                                           setconst(1.0)
  186.                                     END
  187.                           END
  188.                         ELSE
  189.                           IF arg1
  190.                             THEN
  191.                               BEGIN
  192.                                 IF pptra^.operand = 0.0
  193.                                   THEN
  194.                                     BEGIN
  195.                                       IF pptr^.instruct IN[ calc_mul,
  196.                                           calc_pow]
  197.                                         THEN
  198.                                           BEGIN
  199.                                             IF pptr^.instruct = calc_mul
  200.                                               THEN
  201.                                                 dummy := 0.0
  202.                                               ELSE
  203.                                                 dummy := 1.0;
  204.                                             pptr^.instruct := calc_const;
  205.                                             pptr^.operand := dummy;
  206.                                             help1 := pptrb;
  207.                                             op := 1;
  208.                                             REPEAT
  209.                                               help2 := help1;
  210.                                               IF help1^.instruct IN[
  211.                                                   calc_add.. calc_pow]
  212.                                                 THEN
  213.                                                  op := Succ(op)
  214.                                                 ELSE
  215.                                                  IF help1^.instruct IN[
  216.                                                      calc_const, calc_var]
  217.                                                   THEN
  218.                                                    op := Pred(op);
  219.                                               help1 := help1^.nextinst;
  220.                                               Dispose(help2);
  221.                                             UNTIL op = 0;
  222.                                             pptr^.nextinst := help1;
  223.                                             Dispose(pptra);
  224.                                             restoreptr
  225.                                           END
  226.                                         ELSE
  227.                                           IF pptr^.instruct IN [ calc_add,
  228.                                               calc_sub]
  229.                                             THEN
  230.                                               skipa
  231.                                     END
  232.                                   ELSE
  233.                                     IF (pptra^.operand = 1.0) AND( pptr^.
  234.                                         instruct IN [ calc_mul..calc_div,
  235.                                         calc_pow])
  236.                                       THEN
  237.                                         skipa;
  238.                               END;
  239.                   IF (pptr^.instruct = calc_mul) AND(pptra^.instruct IN [
  240.                       calc_div,calc_dvd])
  241.                     THEN
  242.                       BEGIN
  243.                         help1 := endof(pptra^.nextinst);
  244.                         IF (help1^.nextinst^.instruct = calc_const)
  245.                           THEN
  246.                             IF help1^.nextinst^.operand = 1.0
  247.                               THEN
  248.                                 BEGIN
  249.                                   pptr^ := pptra^;
  250.                                   Dispose(pptra);
  251.                                   Dispose(help1^.nextinst);
  252.                                   help1^.nextinst := pptrb;
  253.                                   restoreptr
  254.                                 END
  255.                               ELSE
  256.                                 IF help1^.nextinst^.operand = -1.0
  257.                                   THEN
  258.                                     BEGIN
  259.                                       pptr^.instruct := calc_neg;
  260.                                       Dispose(help1^.nextinst);
  261.                                       help1^.nextinst := pptrb;
  262.                                       restoreptr
  263.                                     END;
  264.                       END;
  265.                   IF pptr^.instruct IN [calc_mul..calc_div]
  266.                     THEN
  267.                       BEGIN (* Negationen vereinfachen *)
  268.                         IF pptra^.instruct = calc_neg
  269.                           THEN
  270.                             IF pptrb^.instruct = calc_neg
  271.                               THEN
  272.                                 BEGIN
  273.                                   pptr^.nextinst := pptra^.nextinst;
  274.                                   Dispose(pptra);
  275.                                   pptra := pptr^.nextinst;
  276.                                   help1 := endof(pptra);
  277.                                   help1^.nextinst := pptrb^.nextinst;
  278.                                   Dispose(pptrb);
  279.                                   restoreptr;
  280.                                 END
  281.                               ELSE
  282.                                 BEGIN
  283.                                   IF ((pptrb^.instruct = calc_const) AND(
  284.                                       pptrb^. operand < 0.0))
  285.                                     THEN
  286.                                       BEGIN
  287.                                         pptr^.nextinst := pptra^.nextinst;
  288.                                         Dispose(pptra);
  289.                                         pptrb^.operand := Abs(pptrb^.
  290.                                                             operand);
  291.                                         restoreptr
  292.                                       END
  293.                                 END
  294.                           ELSE
  295.                             IF ((pptra^.instruct = calc_const) AND ( pptra^
  296.                                 . operand< 0.0))
  297.                               THEN
  298.                                 IF pptrb^.instruct = calc_neg
  299.                                   THEN
  300.                                     BEGIN
  301.                                       pptra^.nextinst := pptrb^.nextinst;
  302.                                       Dispose(pptrb);
  303.                                       pptra^.operand := Abs(pptra^. operand
  304.                                                           );
  305.                                       restoreptr
  306.                                     END;
  307.                         IF (pptra^.instruct = calc_const) AND(pptra^.
  308.                             operand = - 1.0)
  309.                           THEN
  310.                             BEGIN
  311.                               pptr^.instruct := calc_neg;
  312.                               pptr^.nextinst := pptrb;
  313.                               Dispose(pptra);
  314.                               restoreptr
  315.                             END;
  316.                         IF ((pptrb^.instruct = calc_const) AND (pptrb^.
  317.                             operand =- 1.0) AND (pptr^.instruct = calc_mul)
  318.                             )
  319.                           THEN
  320.                             BEGIN
  321.                               help1 := endof(pptra);
  322.                               help1^.nextinst := pptrb^.nextinst;
  323.                               pptr^.instruct := calc_neg;
  324.                               Dispose(pptrb);
  325.                               restoreptr
  326.                             END;
  327.                       END;
  328.                   IF (pptr^.instruct = calc_add) AND (pptra^.instruct =
  329.                       calc_neg)
  330.                     THEN
  331.                       BEGIN
  332.                         pptr^.instruct := calc_sub;
  333.                         pptr^.nextinst := pptra^.nextinst;
  334.                         Dispose(pptra);
  335.                         restoreptr
  336.                       END;
  337.                   IF (pptr^.instruct = calc_sub) AND (pptra^.instruct =
  338.                       calc_neg)
  339.                     THEN
  340.                       BEGIN
  341.                         pptr^.instruct := calc_add;
  342.                         pptr^.nextinst := pptra^.nextinst;
  343.                         Dispose(pptra);
  344.                         restoreptr
  345.                       END;
  346. (* jetzt wird's schwierig : das Kommutativgesetz *)
  347.                   IF (((pptr^.instruct = calc_mul) AND(pptra^. instruct IN[
  348.                       calc_mul..calc_div])) OR ((pptr^.instruct = calc_add)
  349.                       AND( pptra^.instruct IN[ calc_add, calc_sub]))) AND (
  350.                       pptrb^. instruct = calc_const)
  351.                     THEN
  352.                       BEGIN
  353.                         help1 := endof(pptra^.nextinst);
  354.                         help2 := endof(help1^.nextinst);
  355.                         IF pptra^.instruct IN [calc_mul,calc_add]
  356.                           THEN
  357.                             BEGIN
  358.                               IF help1^.nextinst^.instruct= calc_const
  359.                                 THEN
  360.                                   BEGIN
  361.                                     help2^.nextinst := pptra^. nextinst;
  362.                                     pptra^.nextinst := pptrb;
  363.                                     help2 := pptrb^.nextinst;
  364.                                     pptrb^.nextinst := help1^. nextinst;
  365.                                     help1^.nextinst := help2;
  366.                                   END
  367.                                 ELSE
  368.                                   IF pptra^.nextinst^.instruct= calc_const
  369.                                     THEN
  370.                                       BEGIN
  371.                                         help2^.nextinst := pptrb^. nextinst
  372.                                           ;
  373.                                         pptrb^.nextinst := help1^. nextinst
  374.                                           ;
  375.                                         help1^.nextinst := pptrb;
  376.                                       END;
  377.                             END
  378.                           ELSE
  379.                             BEGIN
  380.                               IF help1^.nextinst^.instruct= calc_const
  381.                                 THEN
  382.                                   BEGIN
  383.                                     helpinstruct := pptr^.instruct;
  384.                                     pptr^.instruct := pptra^. instruct;
  385.                                     pptra^.instruct := helpinstruct;
  386.                                     pptr^.nextinst := pptra^. nextinst;
  387.                                     pptra^.nextinst := help1^. nextinst;
  388.                                     help1^.nextinst := pptra;
  389.                                   END;
  390.                             END;
  391.                         restoreptr;
  392.                         simple(pptra);
  393.                         simple(pptrb)
  394.                       END
  395.                     ELSE
  396.                       IF (((pptr^.instruct = calc_mul) AND (pptrb^.
  397.                           instruct IN[ calc_mul..calc_div])) OR (( pptr^.
  398.                           instruct = calc_add) AND(pptrb^. instruct IN[
  399.                           calc_add,calc_sub]))) AND( pptra^.instruct =
  400.                           calc_const)
  401.                         THEN
  402.                           BEGIN
  403.                             help1 := endof(pptrb^.nextinst);
  404.                             help2 := endof(help1^.nextinst);
  405.                             IF pptrb^.instruct IN [calc_add, calc_mul]
  406.                               THEN
  407.                                 BEGIN
  408.                                   IF pptrb^.nextinst^.instruct= calc_const
  409.                                     THEN
  410.                                       BEGIN
  411.                                         pptr^.nextinst := help1^. nextinst;
  412.                                         help1^.nextinst := pptra;
  413.                                         pptra^.nextinst := help2^. nextinst
  414.                                           ;
  415.                                         help2^.nextinst := pptrb;
  416.                                       END
  417.                                     ELSE
  418.                                       IF help1^.nextinst^.instruct=
  419.                                           calc_const
  420.                                         THEN
  421.                                           BEGIN
  422.                                             pptr^.nextinst := pptrb^.
  423.                                                                 nextinst;
  424.                                             pptra^.nextinst := help1^.
  425.                                                                  nextinst;
  426.                                             help1^.nextinst := pptrb;
  427.                                             pptrb^.nextinst := pptra ;
  428.                                           END
  429.                                 END
  430.                               ELSE
  431.                                 BEGIN
  432.                                   IF help1^.nextinst^.instruct= calc_const
  433.                                     THEN
  434.                                       BEGIN
  435.                                         helpinstruct := pptr^. instruct;
  436.                                         pptr^.instruct := pptrb^. instruct;
  437.                                         pptrb^.instruct := helpinstruct;
  438.                                         pptr^.nextinst := pptrb^. nextinst;
  439.                                         pptrb^.nextinst := pptra;
  440.                                         pptra^.nextinst := help1^. nextinst
  441.                                           ;
  442.                                         help1^.nextinst := pptrb ;
  443.                                       END;
  444.                                 END;
  445.                             restoreptr;
  446.                             simple(pptra);
  447.                             simple(pptrb)
  448.                           END ;
  449.                   IF pptr^.instruct = calc_mul
  450.                     THEN
  451.                       BEGIN
  452.                         IF pptra^.instruct = calc_pow
  453.                           THEN
  454.                             BEGIN
  455.                               help2 := pptra^.nextinst;
  456.                               help1 := endof(help2);
  457.                               help1 := help1^.nextinst;
  458.                               IF (help2^.instruct = calc_const) AND equal(
  459.                                   help1, pptrb)
  460.                                 THEN
  461.                                   BEGIN
  462.                                     help2^.operand := help2^.operand + 1.0;
  463.                                     pptr^ := pptra^;
  464.                                     Dispose(pptra);
  465.                                     help2^.nextinst := pptrb;
  466.                                     erase_entry;
  467.                                     restoreptr
  468.                                   END
  469.                             END
  470.                       END;
  471.                   IF pptr^.instruct IN [calc_add,calc_sub,calc_dvd,
  472.                       calc_div, calc_mul]
  473.                     THEN
  474.                       IF equal(pptra,pptrb)
  475.                         THEN     (* sind die Operanden gleich ? *)
  476.                           BEGIN
  477.                             CASE pptr^.instruct OF 
  478.                               calc_add : BEGIN
  479.                                            pptr^.instruct := calc_mul;
  480.                                            help2 := endof(pptra);
  481.                                            help1 := pptra^.nextinst;
  482.                                            pptra^.instruct := calc_const;
  483.                                            pptra^.operand := 2.0;
  484.                                            pptra^.nextinst := help2^.
  485.                                                                 nextinst;
  486.                                            erase_entry;
  487.                                            restoreptr
  488.                                          END;
  489.                               calc_sub : setconst(0.0);
  490.                               calc_div,calc_dvd : setconst(1.0);
  491.                               calc_mul : BEGIN
  492.                                            pptr^.instruct := calc_pow;
  493.                                            help2 := endof(pptra);
  494.                                            help1 := pptra^.nextinst;
  495.                                            pptra^.nextinst := help2^.
  496.                                                                 nextinst;
  497.                                            pptra^.instruct := calc_const;
  498.                                            pptra^.operand := 2.0;
  499.                                            erase_entry;
  500.                                            restoreptr
  501.                                          END;
  502.                             END
  503.                           END;
  504.                 END;
  505.       END
  506. END;
  507.  
  508. BEGIN
  509.   IF pptr <> nil
  510.     THEN
  511.       BEGIN
  512.         simpleerror := FALSE;
  513.         calcresult := TRUE;
  514.         invert(pptr);
  515.         pptr1 := pptr^.nextinst;
  516.         simple(pptr1);
  517.         IF simpleerror
  518.           THEN
  519.             BEGIN
  520.               killexpression(pptr);
  521.               calcresult := FALSE
  522.             END
  523.           ELSE
  524.             invert(pptr)
  525.       END
  526.     ELSE
  527.       calcresult := FALSE
  528. END;
  529.  
  530.