home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / glisp / glisp.000 / GLISP.UNIX.TAR / closunix / clos_clm.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-04-03  |  18.1 KB  |  488 lines
  1. /*                 GRAPHIC LISP            */
  2. /*        Scritto nel 1991-94 da Zoia Andrea Michele     */
  3. /*        Via Pergola #1 Tirano (SO) Tel. 0342-704210    */
  4. /* file clos_clm.c */
  5.  
  6. #include "clos.h"
  7.  
  8. /* ---------------- TIPI DI DATI USATI DA METHOD_EVAL---------------------   */
  9. /* method -> (lambda1 lambda2 .... lambdan )                             */
  10. /* lambda -> contiene una struttura dati con i seguenti campi:             */
  11. /*    UFUNC_TYPE=lista di tipi(vedi sotto)                     */
  12. /*      UFUNC_PAR=lista dei nomi di parametri                     */    
  13. /*      UFUNC_SEX=lista    di s-espressioni da valutare                 */  
  14. /*    UFUNC_KEY,UFUNC_AUX=UFUNC_OPT=liste associative (A-LIST)             */
  15. /*          contenenti i nomi delle variabili opzionali,ausiliarie e chiave*/
  16. /*          ed i loro valori iniziali non ancora valutati.                 */
  17. /*    UFUNC_REST=nome della variabile a cui assegnare il resto dei parametri */
  18. /*     UFUNC_ENV=lista associativa contenente l'environment incapsulato all' */
  19. /*               atto della definizione della lambda                 */
  20. /* NOTA: method_eval usa soltanto UFUNC_TYPE                     */
  21. /*       tutti gli altri campi sono usati da Lambda_eval                     */
  22. /*                                         */
  23. /* class instance->(  (C0 C1 C2 ... Cn T)  (fields of C0)...(fields of Cn) ) */
  24. /*                    lista di precedenze  campi delle classi che appaiono   */
  25. /*              C0 e' la classe      nella lista delle precedenze      */
  26. /*                    istanziata       (a parte T )                 */                          
  27. /*                       Non sono usati da method-eval     */
  28. /*                       Sono usati soltanto da accessor_eval*/
  29.  
  30.  
  31. /* METHOD_EVAL CONTIENE L'ALGORITMO DI SELEZIONE DEL METODO ESATTO */
  32. /* TRA TUTTI QUELLI DISPONIBILI.*/
  33. /* Un metodo e' una lista di nodi-lambda cioe' di nodi che contengono delle */
  34. /* funzioni utente. Tra i vari campi del nodo-lambda c'e' UFUNC_TYPE che */
  35. /* contiene una lista di nomi di classi o NIL */
  36. /* Corrispondentemente c'e' UFUNC_PAR che e' una lista dei nomi delle */
  37. /* variabili della lambda. Ad ogni nome di parametro in UFUNC_PAR corrisponde*/
  38. /* un tipo in UFUNC_TYPE . */
  39. /* Se il tipo e' un nome allora questo nome corrisponde */
  40. /* ad una definizione di classe e l'argomento deve essere un istanza di */
  41. /* quella classe o una istanza di una sua sottoclasse. */
  42. /* Se il tipo e' nil allora l'argomento puo' */
  43. /* essere di qualsiasi tipo */
  44.  
  45. void method_eval(method,parlist,nout,genv,lenv,eval_flags)
  46. node method;
  47. node parlist;
  48. node_p *nout;
  49. node genv;
  50. node lenv;
  51. unsigned eval_flags;
  52. {
  53.  node   parl;
  54.  node   type_needed;
  55.  node   prec_list;
  56.  node   tmp;
  57.  node   mlist;
  58.  node   current_method;
  59.  lsiz_t current_parameter;
  60.  lsiz_t methods_number;
  61.  int    second_pass_needed;
  62.  int    class_matched;
  63.  
  64.  
  65.  /* method  e' la lista di tutte le funzioni che fanno capo da un metodo */
  66.  /* parlist contiene una lista di tutti gli argomenti valutati */
  67.  /* nout    e' il puntatore alla struttura che conterra' il risultato della */
  68.  /*         funzione scelta */
  69.  /* genv    e' l'environment speciale dove ci sono le variabili definite */
  70.  /*         con DEFVAR */
  71.  /* lenv    e' 'environment locale */
  72.  /* eval_flags sono dei flags da passare a lambda_eval assieme a genv e lenv */
  73.  
  74.  methods_number=listlen_func(method);
  75.  /* methods_number contiene il numero delle funzioni che fanno capo */
  76.  /* al metodo corrente */
  77.  
  78.  /************* prima passata della lista method ***********************/
  79.  /* si escludono solo i metodi che non hanno la classe nella prec-list */
  80.  /* del parametro cioe' i metodi inutilizzabili alla luce degli        */
  81.  /*                 argomenti attuali                                  */
  82.  /**********************************************************************/
  83.  
  84.  current_parameter=0;
  85.  /* e' il contatore del' argomento in esame */
  86.  
  87.  /* si scorre tutta la parlist */
  88.  parl=parlist;
  89.  while(IS_CONS(parl)){
  90.    tmp=CONSLEFT(parl);
  91.    if(IS_VALUE(tmp)&&GET_VTYPE(tmp)==NT_CLASS){
  92.      prec_list=CONSLEFT(CLASS_INSTANCE(tmp));
  93.    }else{
  94.      prec_list=NIL;
  95.    }
  96.    /* prec_list contiene la lista di precedenze della classe */
  97.    /* argomento del metodo oppure NIL se l'argomento non e' una classe */
  98.    /* NB: prec_list=lista di nomi di classi */
  99.  
  100.    /* si scorre la lista delle funzioni che fanno capo a questo metodo */
  101.    mlist=method;
  102.    while(IS_CONS(mlist)){
  103.      current_method=CONSLEFT(mlist);
  104.  
  105.      if(IS_REM(current_method)){
  106.        /* se il metodo corrente e' gia' stato escluso allora lo si salta */    
  107.        mlist=CONSRIGHT(mlist);
  108.        continue;
  109.      }
  110.  
  111.      type_needed=list_elt(UFUNC_TYPE(current_method),current_parameter);
  112.      /* UFUNC_TYPE ritorna la lista dei tipi di parametri del metodo */
  113.      /* e con list_elt si prende il tipo puntato da current_parameter */
  114.      /* type_needed contiene il tipo del parametro voluto dalla funzione */
  115.      /* NB: il tipo del parametro e' il nome della classe */
  116.      /* se list_elt ritorna VOID vuol dire che la lista e' piu' corta */
  117.      /* del previsto:allora si esclude la funzione corrente */
  118.      if(type_needed==VOID){
  119.        REM(current_method);
  120.        methods_number--;
  121.        mlist=CONSRIGHT(mlist);
  122.        continue;
  123.      }
  124.      if(prec_list==NIL){
  125.        /* l'argomento in esame non e' una classe */
  126.        if(type_needed!=NIL){
  127.          /* pero' la funzione richiede una classe */
  128.          /* allora si esclude questo metodo */
  129.          REM(current_method);
  130.          methods_number--;
  131.        }
  132.        /* else  */
  133.        /* nemmeno la funzione vuole una classe allora va bene */
  134.      }else{
  135.        /* l'argomento in esame e' una classe */
  136.        if(type_needed!=NIL){
  137.          /* anche la funzione richiede una classe */
  138.          /* si cerca se type_needed e' nella prec_list */
  139.          tmp=prec_list;
  140.          while(IS_CONS(tmp) && CONSLEFT(tmp)!=type_needed)
  141.            tmp=CONSRIGHT(tmp);
  142.  
  143.          if(!IS_CONS(tmp)){
  144.            /* type_needed non e' nella prec_list */
  145.            /* si esclude questa funzione */
  146.            REM(current_method);
  147.            methods_number--;
  148.          }
  149.        }
  150.        /* else */
  151.        /* se l'argomento in esame e' una classe e la funzione richiede */
  152.        /* un tipo generico di dato allora per ora si tiene buona la funzione */
  153.      }/* else (prec_list==NIL) */
  154.  
  155.      /* si passa alla funzione successiva */
  156.      mlist=CONSRIGHT(mlist);
  157.    }/* while */
  158.    /* si e' finito di scorrere la lista delle funzioni del metodo */
  159.  
  160.    /* si continua a sfoltire la method-list servendosi del */
  161.    /* secondo parametro */
  162.    parl=CONSRIGHT(parl);
  163.    current_parameter++;
  164.  }/* while */
  165.  
  166.  /* si controlla se non ci sono piu' funzioni */
  167.  if(!methods_number)
  168.    /* qui' si usa goto per evitare duplicazioni di codice */
  169.    goto UnmatchError;
  170.  
  171.  /* si controlla se e' rimasta una sola funzione */
  172.  if(methods_number==1)
  173.    /* qui' si usa goto per evitare duplicazioni di codice */
  174.    goto MethodFound;
  175.  
  176.  /* Arrivati fin qui' si sono escluse tutte quelle funzioni che non      */
  177.  /* possono essere applicate.                                            */
  178.  /* Quelle che rimangono devono essere sfoltite basandosi sulla lista    */
  179.  /* delle prececdenze  delle classi.                                     */
  180.  /* NB: ognuna delle funzioni rimanenti potrebbe essere applicata        */
  181.  /* con i parametri attuali :lo scopo della seconda passata e' proprio   */
  182.  /* quello di trovare il metodo migliore compatibilmente con i parametri */
  183.  /* attuali.                                                             */
  184.  
  185.  
  186.  /************* seconda passata della lista method**********************/
  187.  /*  si escludono via via tutte le funzioni che possono essere         */
  188.  /*    applicate a classi di minor precedenza rispetto ad altre        */
  189.  /*  NOTA: la seconda passata puo' richiedere a sua volta 2 passate    */
  190.  /*        per essere completata                                       */
  191.  /*        ed e' a questa seconda ''sottopassata,, alla quale si       */
  192.  /*        riferisce il flag second_pass_needed                        */
  193.  /**********************************************************************/
  194.  
  195.  current_parameter=0;
  196.  
  197.  /* si prova a scorrere tutta la parlist */
  198.  parl=parlist;
  199.  while(IS_CONS(parl)){
  200.    tmp=CONSLEFT(parl);
  201.    if(IS_VALUE(tmp)&&GET_VTYPE(tmp)==NT_CLASS){
  202.      prec_list=CONSLEFT(CLASS_INSTANCE(tmp));
  203.    }else{
  204.      prec_list=NIL;
  205.    }
  206.    /* prec_list contiene la lista di precedenze della classe  */
  207.    /* argomento del metodo oppure NIL se l'argomento non e' una classe */
  208.    /* NB: precl=lista di nomi di classi */
  209.  
  210.    /* prima passata della lista method */
  211.    /* si inizializzano i 2 flags */
  212.    class_matched=FALSE;
  213.    second_pass_needed=FALSE;
  214.  
  215.    mlist=method;
  216.    while(IS_CONS(mlist)){
  217.  
  218.      current_method=CONSLEFT(mlist);
  219.      /* current_method=metodo corrente */
  220.  
  221.      if(IS_REM(current_method)){
  222.        /* se il metodo corrente e' gia' stato escluso allora lo si salta */    
  223.        mlist=CONSRIGHT(mlist);
  224.        continue;
  225.      }
  226.  
  227.      type_needed=list_elt(UFUNC_TYPE(current_method),current_parameter);
  228.      /* NOTA: ora list_elt tova sicuramente l'elemento current_parameter */
  229.      /* nella lista UFUNC_TYPE(method) dato che nella passata precedente */
  230.      /* sono state escluse tutte le funzioni che non avevano un numero */
  231.      /* sufficiente di parametri */
  232.  
  233.      /* se prec_list==NIL allora la prima passata ha gia' provveduto ad */
  234.      /* escludere la funzione nel caso che type_needed!=NIL o a tenerla */
  235.      /* buona se type_needed==NIL */
  236.  
  237.      if(prec_list!=NIL){
  238.        if(type_needed==NIL){
  239.          /* il parametro formale e' una classe e il metodo richede un */
  240.          /* tipo generico di dato : allora si marca il metodo solo se non ne */
  241.      /* sono stati trovati altri che potrebbero andar bene. */
  242.          /* comunque c'e' bisogno di una seconda passata della lista */
  243.          /* dei metodi in modo da poter escludere questo metodo */
  244.          /* se se ne troveranno altri piu' corretti */
  245.          if(class_matched){
  246.            REM(current_method);
  247.            methods_number--;
  248.          }else{
  249.            second_pass_needed=TRUE;
  250.          }         
  251.        }else{
  252.          /* il parametro formale e' una classe ed anche il metodo richiede */
  253.          /* una classe : allora si vede  se type_needed (del metodo) e' in */
  254.          /* prec_list (precedenze del parametro formale) prima o in */
  255.          /* coincidenza della prima classe marcata in prec_list */
  256.          /* se non lo si trova in prec_list allora si esclude il metodo */
  257.          /* se lo si trova allora si vede se e' in concomitanza della classe */
  258.          /* marcata (cioe' quella con precedenza piu' elevata incontrata */
  259.          /* finora): se e' cosi' si tiene buono il metodo */
  260.          /* se invece typel si trova prima della prima classe marcata */
  261.          /* allora oltre a tenere buono il metodo bisogna fare una seconda */
  262.          /* passata per escludere i metodi che si riferivano ad una classe */
  263.          /* con minore precedenza */
  264.           
  265.          /* cerca type_needed in prec_list e si ferma alla fine di precl */
  266.          /* o al primo elemento marcato */
  267.          tmp=prec_list;
  268.          while( IS_CONS(tmp) && !IS_REM(CONSLEFT(tmp)) ){
  269.            if(CONSLEFT(tmp)==type_needed)break;
  270.            tmp=CONSRIGHT(tmp);
  271.          }    
  272.       if(IS_CONS(tmp)){
  273.        /* il while precedente si e' interrotto perche' si e' */
  274.        /* verificata l'uguaglianza e/o si e' trovato un nodo REM */
  275.            if(CONSLEFT(tmp)==type_needed){
  276.          /* e' stata trovata una classe che va bene */
  277.              if(!IS_REM(CONSLEFT(tmp))){
  278.                /* la classe non era marcata :la si marca */
  279.                /* e si richiede una seconda passata solo se il flag */
  280.                /* class matched e' TRUE */
  281.            /* cioe' se e' gia' stato trovato un metodo riferito ad una */
  282.            /* classe con precedenza minore allora fai una */
  283.            /* seconda passata per eliminarlo */
  284.                REM(CONSLEFT(tmp));
  285.                if(class_matched){
  286.                  second_pass_needed=TRUE;
  287.                }
  288.                class_matched=TRUE;
  289.              }  
  290.              /* else */
  291.              /* era gia' marcata non c'e' bisogno di una seconda */
  292.              /* passata e non c'e' bisogno nemmeno di settare il flag */
  293.              /* class_matched perche' dato che qualcosa e' gia' stato */
  294.              /* marcato allora si sara' provveduto a settare questo flag */
  295.              /* insomma qui' non si fa nulla ed il metodo va bene */
  296.              /* ---- */
  297.            }else{
  298.              /* non e' stata trovata la classe: si esclude il metodo */
  299.              REM(current_method);
  300.              methods_number--;
  301.            }     
  302.          }else{
  303.            /* non e' stata trovata la classe: si esclude il metodo */
  304.            REM(current_method);
  305.            methods_number--;
  306.          }   
  307.        }/* else (type_needed==NIL) */
  308.      }/* if (prec_list==NIL) */
  309.      
  310.      /* si passa al prossimo metodo */
  311.      mlist=CONSRIGHT(mlist);
  312.    }/* while   prima passata */
  313.  
  314.    if(second_pass_needed){
  315.  
  316.      /* seconda passata della lista method */
  317.      mlist=method;
  318.      while(IS_CONS(mlist)){
  319.  
  320.        current_method=CONSLEFT(mlist);
  321.  
  322.        if(IS_REM(current_method)){
  323.          /* se il metodo corrente e' gia' stato escluso allora lo si salta */
  324.          mlist=CONSRIGHT(mlist);
  325.          continue;
  326.        }
  327.  
  328.        type_needed=list_elt(UFUNC_TYPE(current_method),current_parameter);
  329.        /* NOTA: ora list_elt tova sicuramente l'elemento current_parameter */
  330.        /* nella lista UFUNC_TYPE(method) dato che nella passata precedente */
  331.        /* sono state escluse tutte le funzioni che non avevano un numero */
  332.        /* sufficiente di parametri */
  333.  
  334.        /* se prec_list==NIL  in entrambi i casi di typel */
  335.        /* non si fa nulla dato che la prima */
  336.        /* passata qui' ha gia' fatto tutto il possibile */
  337.        if(prec_list!=NIL){
  338.          if(type_needed==NIL){
  339.            /* il parametro formale e' una classe e il metodo richede un */
  340.            /* tipo generico di dato : allora si marca il metodo solo se */
  341.            /* non ne sono stati trovati altri (nella passata precedente) che */
  342.            /* potrebbero andar bene. */
  343.            if(class_matched){
  344.              REM(current_method);
  345.              methods_number--;
  346.            }
  347.          }else{
  348.            /* il parametro formale e' una classe ed anche il metodo richiede */
  349.            /* una classe : allora si vede  se type_needed (del metodo) e' in */
  350.            /* prec_list (precedenze del parametro formale) in coincidenza */
  351.            /* della prima classe marcata in precl */
  352.            /* NB: se trova una classe questa DEVE essere in coincidenza */
  353.            /* con la prima classe marcata , fatto garantito dalla */
  354.            /* passata precedente.*/
  355.            /* se non lo si trova in precl allora si esclude il metodo */
  356.  
  357.            /* cerca typel in precl e si ferma alla fine di precl */
  358.            /* o al primo elemento marcato */
  359.            tmp=prec_list;
  360.            while( IS_CONS(tmp) && !IS_REM(CONSLEFT(tmp)) ){
  361.              if(CONSLEFT(tmp)==type_needed)break;
  362.              tmp=CONSRIGHT(tmp);
  363.            }
  364.            if(IS_CONS(tmp)){
  365.              /* il while precedente si e' interrotto perche' si e' */
  366.              /* verificata l'uguaglianza e/o si e' trovato un nodo REM */
  367.              if(CONSLEFT(tmp)!=type_needed){
  368.                /* non e' stata trovata la classe: si esclude il metodo */
  369.                REM(current_method);
  370.                methods_number--;
  371.              }
  372.            }else{
  373.              /* qui' la classe non va bene */
  374.              REM(current_method);
  375.              methods_number--;
  376.            }
  377.          }/* else (type_needed==NIL) */
  378.        }/* if (prec_list!=NIL) */
  379.  
  380.        /* si passa al prossimo metodo */
  381.        mlist=CONSRIGHT(mlist);
  382.      }/* while   seconda passata */
  383.    }/* if (second_pass_needed) */
  384.  
  385.    /* ora si tolgono tutte le marcature da prec_list */
  386.    tmp=prec_list;
  387.    while(IS_CONS(tmp)){
  388.      UNREM(CONSLEFT(tmp));
  389.      tmp=CONSRIGHT(tmp);
  390.    }
  391.  
  392.    /* si continua a sfoltire */
  393.    /* la method-list servendosi del prossimo parametro */
  394.    current_parameter++;
  395.    parl=CONSRIGHT(parl);
  396.  } /* while (IS_CONS(parl)) */
  397.  
  398.  if(methods_number==1){
  399.    /* nella method-list e' rimasto un solo elemento ed e' proprio */
  400.    /* quello giusto (e non marcato) !!! */
  401.    /* lo si cerca e lo si valuta con lambda-eval */
  402.    /* intanto si smarca anche tutta la method_list */
  403.  
  404.    MethodFound: /* qui' va a finire un goto precedente */
  405.    tmp=method;
  406.    while(IS_CONS(tmp)){
  407.      if(IS_REM(CONSLEFT(tmp)))
  408.        UNREM(CONSLEFT(tmp));
  409.      else
  410.        type_needed=CONSLEFT(tmp);
  411.      tmp=CONSRIGHT(tmp);
  412.    }
  413.    lambda_eval(type_needed,parlist,nout,genv,lenv,eval_flags);
  414.    return;
  415.  }
  416.  
  417.  /*  si controlla il contatore methods_number */
  418.  if(!methods_number){
  419.    /* errore sono rimasti zero metodi */
  420.    /* si smarca tutta la method-list */
  421.    UnmatchError: /* qui' va a finire un goto precedente */
  422.    tmp=method;
  423.    while(IS_CONS(tmp)){
  424.      UNREM(CONSLEFT(tmp));
  425.      tmp=CONSRIGHT(tmp);
  426.    }
  427.    error(E_UNMATCHEDMETHOD,ERR_MERROR|ERR_TBLVL|ERR_PVOID,NULL);
  428.  }
  429.  
  430.  /* se si arriva fin qui' significa che piu' di un metodo va bene */
  431.  /* allora si genera l'errore di ambiguita' */
  432.  
  433.  /* si smarca tutta la method-list */
  434.  tmp=method;
  435.  while(IS_CONS(tmp)){
  436.    UNREM(CONSLEFT(tmp));
  437.    tmp=CONSRIGHT(tmp);
  438.  }
  439.  error(E_AMBIGUOUSMETHOD,ERR_MERROR|ERR_TBLVL|ERR_PNINT,&methods_number);
  440. }
  441.  
  442.  
  443.  
  444.  
  445.  
  446.  
  447. void accessor_eval(access,nin,nout,genv,lenv)
  448. node access;
  449. node nin;
  450. node_p *nout;
  451. node genv;
  452. node lenv;
  453. {
  454.  lsiz_t counter=0;
  455.  node supers;
  456.  
  457.  if(IS_CONS(nin)){
  458.    eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);
  459.    nin=calc_pointer(nout);
  460.    if(IS_VALUE(nin)&&GET_VTYPE(nin)==NT_CLASS){
  461.      /* nin e' una classe */
  462.      nin=CLASS_INSTANCE(nin);
  463.      /* si vede se ACCESSOR_NAME si trova nella prec-list della classe */
  464.      supers=CONSLEFT(nin);
  465.      nin=CONSRIGHT(nin);
  466.      while(IS_CONS(supers)){
  467.        if(CONSLEFT(supers)==ACCESSOR_NAME(access)){
  468.          /* posizionati sulla lista della classe scelta */
  469.          while(counter--)nin=CONSRIGHT(nin);
  470.          nin=CONSLEFT(nin);
  471.          counter=ACCESSOR_FIELD(access);
  472.          /* posizionati sull campo scelto della classe */
  473.          while(--counter)nin=CONSRIGHT(nin);
  474.          nout->node=nin;
  475.          nout->type=P_CONSLEFT;
  476.          return;
  477.        }
  478.        counter++;
  479.        supers=CONSRIGHT(supers);
  480.      }
  481.      error(E_UNMATCHCLASS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&ACCESSOR_NAME(access));
  482.    }
  483.    error(E_BADARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&nin);
  484.  }
  485.  error(E_FEWARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&nin);
  486. }
  487.  
  488.