home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume10 / ifp / part04 / interp / apply.c < prev    next >
Encoding:
C/C++ Source or Header  |  1987-07-05  |  10.1 KB  |  384 lines
  1.  
  2. /****** apply.c *******************************************************/
  3. /**                                                                  **/
  4. /**                    University of Illinois                        **/
  5. /**                                                                  **/
  6. /**                Department of Computer Science                    **/
  7. /**                                                                  **/
  8. /**   Tool: IFP                         Version: 0.5                 **/
  9. /**                                                                  **/
  10. /**   Author:  Arch D. Robison          Date:   May 1, 1985          **/
  11. /**                                                                  **/
  12. /**   Revised by: Arch D. Robison       Date: July 29, 1986          **/
  13. /**                                                                  **/
  14. /**   Principal Investigators: Prof. R. H. Campbell                  **/
  15. /**                            Prof. W. J. Kubitz                    **/
  16. /**                                                                  **/
  17. /**                                                                  **/
  18. /**------------------------------------------------------------------**/
  19. /**   (C) Copyright 1987  University of Illinois Board of Trustees   **/
  20. /**                       All Rights Reserved.                       **/
  21. /**********************************************************************/
  22.  
  23. #include <stdio.h>
  24. #include "struct.h"
  25. #include "node.h"
  26. #include "stats.h"
  27. #include "cache.h"
  28.  
  29. /*
  30.  * ApplyCheck
  31.  *
  32.  * Check if a function definition is internally consistent
  33.  */
  34. boolean ApplyCheck (F)
  35.    ObjectPtr F;
  36.    {
  37.       register ListPtr P;
  38.       ObjectPtr D;
  39.  
  40.       switch (F->Tag) {
  41.  
  42.      case LIST:
  43.  
  44.         if ((P = F->List) == NULL) return 0;
  45.         else {
  46.  
  47.            switch (P->Val.Tag) {
  48.  
  49.           case NODE: return 1;
  50.  
  51.           case LIST:   /* unlinked form */
  52.              LinkPath (&P->Val,DEF);
  53.              if (P->Val.Tag==NODE && P->Val.Node->NodeType==DEF) {
  54.             D = &P->Val.Node->NodeData.NodeDef.DefCode;
  55.             if (D->Code.CodeParam >= 0 &&
  56.                 D->Code.CodeParam != ListLength (P->Next)) {
  57.                DefError ((NodePtr) NULL,F,
  58.                      "wrong number of parameters");
  59.                return 0;
  60.             }
  61.              } else {
  62.             DefError ((NodePtr) NULL,F,"not a PFO");
  63.             return 0;
  64.              }
  65.              if (P->Val.Node == FormTable[NODE_Sel].FormNode)
  66.             return P->Next->Val.Tag == INT;
  67.              else if (P->Val.Node == FormTable[NODE_C].FormNode)
  68.             return (P=P->Next) == NULL || P->Next == NULL;
  69.              else if (P->Val.Node == FormTable[NODE_Out].FormNode)
  70.             return 1;
  71. #if FETCH
  72.              else if (P->Val.Node == FormTable[NODE_Fetch].FormNode)
  73.             return 1;
  74. #endif
  75.              else {
  76.             while ((P=P->Next) != NULL)
  77.                if (!ApplyCheck (&P->Val)) return 0;
  78.             return 1;
  79.              }
  80.            
  81.              case STRING: /* unlinked function */
  82.             LinkPath (F,DEF);
  83.             if (F->Tag != NODE || F->Node->NodeType != DEF) {
  84.                DefError ((NodePtr) NULL,F,"not a definition");
  85.                return 0;
  86.             } else return 1;
  87.  
  88.              default:
  89.             IntError ("ApplyCheck: illegal P->Val.Tag value");
  90.             return 0;
  91.           }
  92.         }
  93.  
  94.      case NODE: return 1;   /* Linked function */
  95. #if XDEF
  96.      /* We should check that the string is a functional variable */
  97.      case STRING: return 1;
  98. #endif
  99.      default:
  100.         DefError ((NodePtr) NULL,F,"Invalid function/form definition");
  101.         return 0;
  102.       }
  103.    }
  104.  
  105. /*----------------------------------------------------------------------*/
  106.  
  107. extern int TraceIndent;    /* Indentation level of trace  */
  108. boolean Trace = 0;    /* Print function trace if set */
  109. #define ENTER "ENTER> "
  110. #define EXIT  "EXIT>  "
  111.  
  112. /*
  113.  * ApplyFun points to node whenever a compiled function is being applied.
  114.  * It is undefined at all other times.
  115.  * It is undefined when running multithread.
  116.  */ 
  117. NodePtr ApplyFun;
  118.  
  119. /*
  120.  * Apply
  121.  *
  122.  * Apply function *F to argument *InOut.  Put result in *InOut.
  123.  * *F is linked if it was unlinked.
  124.  *
  125.  * There are five possible representations for the function:
  126.  *
  127.  *      <string ...>           Unlinked function
  128.  *      node                   Linked function
  129.  *      <<string ...> ...>     Unlinked PFO
  130.  *      <node ...>             Linked PFO
  131.  *    string               Functional variable
  132.  *
  133.  * Input
  134.  *      *InOut = function argument
  135.  *      *F = function
  136.  *
  137.  * Output
  138.  *      *InOut = result of applying F to InOut
  139.  *      *F = linked function
  140.  *
  141.  * Note: There is some weird casting for the linked form case.
  142.  *       This is merely to avoid putting another pointer on the stack,
  143.  *       which we want to avoid since that case is recursive.
  144.  */
  145. void Apply (InOut,F)
  146.    ObjectPtr InOut;
  147.    register ObjectPtr F;
  148.    {
  149.       extern void PrintTrace ();
  150.       register ListPtr P;
  151.  
  152.       if (SysStop) {
  153.      RepTag (InOut,BOTTOM);
  154.      return;
  155.       }
  156.  
  157. #if OPSYS==MSDOS
  158.       StackCheck ();        /* Check for stack overflow or interrupt */
  159. #endif
  160.  
  161.       Stat (StatApply (InOut));        /* Collect "apply()" statistics */
  162.  
  163.       switch (F->Tag) {
  164.  
  165.      case LIST:
  166.  
  167.         if ((P=F->List)->Val.Tag == NODE) {
  168.  
  169.            if (Trace) PrintTrace (F,InOut,ENTER);    /* linked PFO */
  170.            TraceIndent++;
  171.            P = (ListPtr) P->Val.Node;
  172. #define Fn ((NodePtr) P)->NodeData.NodeDef.DefCode
  173.            if (Fn.Tag == CODE)
  174.           (*Fn.Code.CodePtr) (InOut,F->List->Next);
  175. #undef Fn
  176.            else
  177.           DefError ((NodePtr) NULL,&F->List->Val,
  178.                 "No compiled def for form");
  179.            TraceIndent--;
  180.            if (Trace || InOut->Tag==BOTTOM) PrintTrace (F,InOut,EXIT);
  181.  
  182.         } else if (P->Val.Tag == STRING) {         /* unlinked function */
  183.  
  184.            LinkPath (F,DEF);
  185.            if (F->Tag==NODE && F->Node->NodeType==DEF)
  186.           goto FunApply;
  187.            else {
  188.           DefError ((NodePtr) NULL,F,"not a definition");
  189.           RepTag (InOut,BOTTOM);
  190.            }
  191.         } else {
  192.            printf ("INTERNAL ERROR in Apply: illegal P->Val = ");
  193.            OutObject (F);
  194.            printf ("\n");
  195.         }
  196.         break;
  197.  
  198. FunApply:
  199.      case NODE: {                    /* linked function */
  200.         int SaveTrace;
  201.  
  202.         /* Evaluate linked function */
  203.         P = (ListPtr) &(ApplyFun=F->Node)->NodeData.NodeDef;
  204. #define D ((DefPtr) P)
  205.         SaveTrace = Trace;
  206.         Trace = D->DefFlags & TRACE;
  207.         if (Trace|SaveTrace) PrintTrace (F,InOut,ENTER);
  208.         TraceIndent++;
  209.  
  210.         if (D->DefCode.Tag != CODE) {
  211.            if (D->DefCode.Tag == BOTTOM) ReadDef ((NodePtr) NULL,F);
  212.            if (D->DefCode.Tag != BOTTOM) 
  213.           CheckCache (&Cache[CacheUser],Apply (InOut,&D->DefCode))
  214.            else {
  215.           DefError ((NodePtr) NULL,F,"no source definition");
  216.           RepTag (InOut,BOTTOM);
  217.            }
  218.         } else 
  219.            CheckCache (&Cache[CachePrim],
  220.                (*D->DefCode.Code.CodePtr) 
  221.                (InOut,D->DefCode.Code.CodeParam));
  222. #undef D
  223.         TraceIndent--;
  224.         if (Trace|SaveTrace || InOut->Tag == BOTTOM)
  225.            PrintTrace (F,InOut,EXIT);
  226.         Trace = SaveTrace;
  227.  
  228.         return;
  229.      }
  230. #if XDEF
  231.      case STRING: {
  232.         extern ListPtr Environment;
  233.         P = Environment;
  234.  
  235.         for (P=Environment; P!=NULL; P=P->Next->Next)
  236.            if (P->Val.String == F->String) {
  237.           RepObject (InOut,&P->Next->Val);
  238.           return;
  239.            }
  240.         IntError ("Apply: variable not in environment\n");
  241.         return;
  242.      }
  243. #endif 
  244.      default:
  245.         DefError ((NodePtr) NULL,F,"Invalid function/form definition");
  246.         RepTag (InOut,BOTTOM);
  247.         return;
  248.       }
  249.    }
  250.  
  251.  
  252. #if REFCHECK || UMAX
  253. /*
  254.  * RefCheck
  255.  *
  256.  * Check if all references required to apply function *F are defined and
  257.  * resolved.
  258.  *
  259.  * *F is linked if it was unlinked.
  260.  *
  261.  * See function 'apply' above for the function representations
  262.  *
  263.  * Input
  264.  *      Caller = &node of calling function, NULL for top level
  265.  *      *F = function
  266.  *
  267.  * Output
  268.  *      *F = linked function
  269.  *    result = 1 iff all references resolved, 0 otherwise.
  270.  *
  271.  * Note: There is some weird casting for the linked form case.
  272.  *       This is merely to avoid putting another pointer on the stack,
  273.  *       which we want to avoid since that case is recursive.
  274.  */
  275. boolean RefCheck (Caller,F)
  276.    NodePtr Caller;
  277.    register ObjectPtr F;
  278.    {
  279.       register ListPtr P;
  280.  
  281.       if (SysStop) return 0;
  282.  
  283. #if OPSYS==MSDOS
  284.       StackCheck ();
  285. #endif
  286.  
  287.       switch (F->Tag) {
  288.  
  289.      case LIST:
  290.         P = F->List;
  291.         if (P == NULL) {
  292.            IntError ("RefCheck: empty list");
  293.            return 0;
  294.  
  295.         } else {
  296.  
  297.            switch (P->Val.Tag) {
  298.  
  299.           case LIST:   /* unlinked form */
  300.              LinkPath (&P->Val,DEF);
  301.              if (P->Val.Tag!=NODE || P->Val.Node->NodeType!=DEF) {
  302.             DefError (Caller,&P->Val,"not a form");
  303.             return 0;
  304.              } /* else drop down to case NODE */
  305.  
  306.           case NODE: {  /* linked form */
  307.  
  308.              register NodePtr Fn;
  309.  
  310.              if ((Fn = P->Val.Node) == NULL) {
  311.             IntError ("RefCheck: empty NodePtr");
  312.             return 0;
  313.              } else if (Fn->NodeData.NodeDef.DefCode.Tag != CODE) {
  314.             DefError (Caller,&F->List->Val,
  315.                  "No compiled def for form");
  316.             return 0;    
  317.              } else {
  318.                 int OK = 1;
  319.                 FormEntry *T;
  320.                   for (T=FormTable; T<ArrayEnd(FormTable); T++) 
  321.                 if (T->FormNode == Fn) break;
  322.                 switch (T-FormTable) {
  323.                case NODE_Comp:
  324.                case NODE_Cons:
  325.                case NODE_Each:
  326.                case NODE_Filter:
  327.                case NODE_If:
  328.                case NODE_RInsert:
  329.                case NODE_While:
  330.                   for (P = F->List; (P=P->Next) != NULL; )
  331.                      OK &= RefCheck (Caller,&P->Val);
  332.                 }
  333.                 return OK;
  334.              }
  335.           }
  336.  
  337.           case STRING: /* unlinked function */
  338.              LinkPath (F,DEF);
  339.              if (F->Tag != NODE || F->Node->NodeType != DEF) {
  340.             DefError (Caller,F,"Not a function");
  341.             return 0;
  342.              } else break; /* down to case NODE */
  343.            
  344.           default:
  345.              IntError ("Apply: illegal P->Val.Tag value");
  346.              return 0;
  347.            }
  348.         }
  349.  
  350.      case NODE: {
  351.         /* Evaluate linked function */
  352.  
  353.         boolean OK=1;
  354.  
  355.         P = (ListPtr) &F->Node->NodeData.NodeDef;
  356. #define D ((DefPtr) P)
  357.  
  358.         if (D->DefCode.Tag != CODE) {
  359.            if (!(D->DefFlags & RESOLVED)) {
  360.           D->DefFlags |= RESOLVED;
  361.           if (D->DefCode.Tag == BOTTOM) ReadDef (Caller,F);
  362.           if (D->DefCode.Tag != BOTTOM)
  363.              OK = RefCheck (F->Node,&D->DefCode);
  364.           else {
  365.              DefError (Caller,F,"no source definition");
  366.              OK = 0;
  367.           }
  368.           D->DefFlags &= ~RESOLVED;
  369.            }
  370.         }
  371. #undef D
  372.         return OK;
  373.      }
  374.  
  375.      default:
  376.         DefError (Caller,F,"Invalid function/form definition");
  377.         return 0;
  378.       }
  379.    }
  380. #endif /* REFCHECK */
  381.  
  382. /******************************* end of apply.c *******************************/
  383.  
  384.