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