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