view af.c @ 0:e0bbaa717f41 draft default tip

lol J
author Jordi Gutiérrez Hermoso <jordigh@octave.org>
date Mon, 25 Nov 2013 11:56:30 -0500
parents
children
line wrap: on
line source

/* Copyright 1990-2011, Jsoftware Inc.  All rights reserved. */
/* License in license.txt.                                   */
/*                                                                         */
/* Adverbs: Fix                                                            */

#include "j.h"


F1(jtunname){A x;V*v;
 RZ(w); 
 v=VAV(w);
 if(CTILDE==v->id&&!jt->glock&&!(VLOCK&v->flag)){x=v->f; if(NAME&AT(x))R symbrd(x);}
 R w;
}

static B jtselfq(J jt,A w){A hs,*u;V*v;
 RZ(w);
 if(AT(w)&NOUN+NAME)R 0;
 v=VAV(w);
 switch(v->id){
  case CSELF:  
   R 1;
  case CATDOT:
  case CGRCO:
   if(hs=v->h){u=AAV(hs); DO(AN(hs), if(selfq(u[i]))R 1;);}
   R 0;
  default:     
   if(v->f&&selfq(v->f))R 1;
   if(v->g&&selfq(v->g))R 1;
   if(v->h&&selfq(v->h))R 1;
 }
 R 0;
}    /* 1 iff w contains $: */

static F2(jtfixa){A aa,f,g,h,wf,x,y,z=w;V*v;
 RZ(a&&w);
 if(NOUN&AT(w)||VFIX&VAV(w)->flag)R w;
 v=VAV(w); f=v->f; g=v->g; h=v->h; wf=ds(v->id); aa=a==zero?num[3]:a;
 if(!(f||g))R w;
 switch(v->id){
  case CSLASH: 
   R df1(fixa(num[2],f),wf);
  case CSLDOT: case CBSLASH: case CBSDOT:
   R df1(fixa(one,f),wf);
  case CAT: case CATCO: case CCUT:
   R df2(fixa(one,f),fixa(aa,g),wf);
  case CAMP: case CAMPCO: case CUNDER: case CUNDCO:
   R df2(fixa(aa,f),fixa(one,g),wf);
  case CCOLON:
   R df2(fixa(one,f),fixa(num[2],g),wf);
  case CADVF:
   R hook(fixa(num[3],f),fixa(num[3],g));
  case CHOOK:
   R hook(fixa(num[2],f),fixa(one,g));
  case CFORK:
   f=fixa(aa,f); g=fixa(num[ID(f)==CCAP?1:2],g); h=fixa(aa,h); R folk(f,g,h);
  case CATDOT:
  case CGRCO:
   RZ(f=every(every2(aa,h,0L,jtfixa),0L,jtaro)); 
   RZ(g=fixa(aa,g));
   R df2(f,g,wf);
  case CIBEAM:
   if(f)RZ(f=fixa(aa,f));
   if(g)RZ(g=fixa(aa,g));
   R f&&g ? (VDDOP&v->flag?df2(f,g,df2(head(h),tail(h),wf)):df2(f,g,wf)) : 
            (VDDOP&v->flag?df1(f,  df2(head(h),tail(h),wf)):df1(f,  wf)) ;
  case CTILDE:
   if(f&&NAME&AT(f)){
    RZ(y=sfn(0,f));
    if(all1(eps(box(y),jt->fxpath)))R w;
    ASSERT(jt->fxi,EVLIMIT);
    jt->fxpv[--jt->fxi]=y; 
    if(x=symbrdlock(f)){
     RZ(z=fixa(aa,x));
     if(a!=zero&&selfq(x))RZ(z=fixrecursive(a,z));
    }
    jt->fxpv[jt->fxi++]=mtv;
    RE(z);
    ASSERT(AT(w)==AT(z)||AT(w)&NOUN&&AT(z)&NOUN,EVDOMAIN);
    R z;
   }else R df1(fixa(num[2],f),wf);
  default:
   if(f)RZ(f=fixa(aa,f));
   if(g)RZ(g=fixa(aa,g));
   R f&&g?df2(f,g,wf):f?df1(f,wf):w;
}}   /* 0=a if fix names; 1=a if fix names only if does not contain $: */


F1(jtfix){PROLOG;A z;I*rv=jt->rank;
 RZ(w);
 jt->rank=0;
 RZ(jt->fxpath=reshape(sc(jt->fxi=(I)255),ace)); jt->fxpv=AAV(jt->fxpath);
 if(LIT&AT(w)){ASSERT(1>=AR(w),EVRANK); RZ(w=nfs(AN(w),CAV(w)));}
 ASSERT(AT(w)&NAME+VERB,EVDOMAIN);
 RZ(z=fixa(zero,AT(w)&VERB?w:symbrdlock(w)));
 if(AT(z)&VERB+ADV+CONJ){V*v=VAV(z); if(v->f){v->flag|=VFIX+VNAMED; v->flag^=VNAMED;}}
 jt->rank=rv; jt->fxpath=0;
 EPILOG(z);
}