name:: (incomplete)

Author: HenryHRich

jsrc/cx.c

@@ -794,7 +794,7 @@ static A jtsent12b(J jt,A w){A t,*wv,y,*yv;I j,*v;
 // a valid hash of a locative name
 // actstv points to the chain headers, actstn is the number of chains
 // all the chains have had the non-PERMANENT flag cleared in the pointers
-// recur is set if *t is part of a recursive noun
+// recur is set if *t is part of a recursive noun.
 static A jtcalclocalbuckets(J jt, A *t, LX *actstv, I actstn, I dobuckets, I recur){LX k;
  A tv=*t;  // the actual NAME block
  L *sympv=JT(jt,sympv);  // base of symbol table
@@ -809,10 +809,13 @@ static A jtcalclocalbuckets(J jt, A *t, LX *actstv, I actstn, I dobuckets, I rec
   for(k=actstv[bucket];k;++compcount,k=sympv[k].next){  // k chases the chain of symbols in selected bucket
    if(NAV(tv)->m==NAV(sympv[k].name)->m&&!memcmpne(NAV(tv)->s,NAV(sympv[k].name)->s,NAV(tv)->m)){
     // match found.  this is a local name.  Replace it with the shared copy, flag as shared, set negative bucket#
+    // suppress this step if the type is ornamented, i. e. if it is name:: - then we need a flagged copy
     A oldtv=tv;
-    *t=tv=sympv[k].name;  // use shared copy
-    if(recur){ras(tv); fa(oldtv);} // if we are installing into a recursive box, increment/decr usecount new/old
-    NAV(tv)->flag|=NMSHARED;  // tag the shared copy as shared
+    if(likely(!(AT(tv)&NAMEABANDON))){  // not name::
+     *t=tv=sympv[k].name;  // use shared copy
+     if(recur){ras(tv); fa(oldtv);} // if we are installing into a recursive box, increment/decr usecount new/old
+     NAV(tv)->flag|=NMSHARED;  // tag the shared copy as shared
+    }
     // Remember the exact location of the symbol.  It will not move as long as this symbol table is alive.  We can
     // use it only when we are in this primary symbol table
     NAV(tv)->symx=k;  // keep index of the allocated symbol
@@ -869,7 +872,7 @@ A jtcrelocalsyms(J jt, A l, A c,I type, I dyad, I flags){A actst,*lv,pfst,t,wds;
  ln=AN(l); lv=AAV(l);  // Get # words, address of first box
  for(j=1;j<ln;++j) {   // start at 1 because we look at previous word
   t=lv[j-1];  // t is the previous word
-  // look for 'names' =./=: .  If found (and the names do not begin with `, replace the string with a special form: a list of boxes where each box contains a name.
+  // look for 'names' =./=: .  If found (and the names do not begin with `), replace the string with a special form: a list of boxes where each box contains a name.
   // This form can appear only in compiled definitions
   if(AT(lv[j])&ASGN&&AT(t)&LIT&&AN(t)&&CAV(t)[0]!=CGRAVE){
    A neww=words(t);
@@ -882,7 +885,13 @@ A jtcrelocalsyms(J jt, A l, A c,I type, I dyad, I flags){A actst,*lv,pfst,t,wds;
   if((AT(lv[j])&ASGN+ASGNLOCAL)==(ASGN+ASGNLOCAL)) {  // local assignment
    if(AT(lv[j])&ASGNTONAME){    // preceded by name?
     // Lookup the name, which will create the symbol-table entry for it
-    RZ(probeis(t,pfst));
+    // name:: causes a little trouble.  The name carries with it the :: flag, but we will eventually replace all refs with the srade ref from
+    // this table.  That means we have to remove the :: flag from the stored value, lest every reference appear flagged just because the last one was.
+    // Note that we are here looking only before =., so we are specifically checking for name:: =. ... .  This should be an error, and we might catch
+    // it when executed; but we are just making sure that it doesn't make the refs invalid.  name:: also sets NAMEXY, and we have to leave that because
+    // any valid ref to mnuvxy will need that set; so there is a chance that name:: =. will result in an ordinary reference to the name's having the NAMEXY
+    // flag.  That won't hurt anything significant.
+    L *nml; RZ(nml=probeis(t,pfst)); AT(nml->name)&=~NAMEABANDON;   // put name in symbol table, with ABANDON flag cleared
    } else if(AT(t)&LIT) {
     // LIT followed by =.  Probe each word.  Now that we support lists of NAMEs, this is used only for AR assignments
     // First, convert string to words
@@ -892,13 +901,13 @@ A jtcrelocalsyms(J jt, A l, A c,I type, I dyad, I flags){A actst,*lv,pfst,t,wds;
      for(kk=0;kk<wdsn;++kk) {
       // Convert word to NAME; if local name, add to symbol table
       if((wnm=onm(wdsv[kk]))) {
-       if(!(NAV(wnm)->flag&(NMLOC|NMILOC)))RZ(probeis(wnm,pfst));
+       if(!(NAV(wnm)->flag&(NMLOC|NMILOC))){L *nml; RZ(nml=probeis(wnm,pfst)); AT(nml->name)&=~NAMEABANDON;}  // see above
       } else RESETERR
      }
     } else RESETERR  // if invalid words, ignore - we don't catch it here
    }else if((AT(t)&BOX+BOXMULTIASSIGN)==BOX+BOXMULTIASSIGN){  // not NAME, not LIT; is it NAMEs box?
     // the special form created above.  Add each non-global name to the symbol table
-    A *tv=AAV(t); DO(AN(t), if(!(NAV(tv[i])->flag&(NMLOC|NMILOC)))RZ(probeis(tv[i],pfst));)
+    A *tv=AAV(t); DO(AN(t), if(!(NAV(tv[i])->flag&(NMLOC|NMILOC))){L *nml; RZ(nml=probeis(tv[i],pfst)); AT(nml->name)&=~NAMEABANDON;})
    }
   } // end 'local assignment'
  }  // for each word in sentence

jsrc/d.c

@@ -113,7 +113,7 @@ static I jtdisp(J jt,A w,I nflag){B b=1&&AT(w)&NAME+NUMERIC;
   // If this is an array of names, turn it back into a character string with spaces between
   else{w=curtail(raze(every2(every(w,(A)&sfn0overself),chrspace,(A)&sfn0overself)));}  // }: (string&.> names) ,&.> ' '  then fall through to display it
  case LITX:  eputq(w,(nflag&1));                break;
- case NAMEX: ep(AN(w),NAV(w)->s);     break;
+ case NAMEX: ep(AN(w),NAV(w)->s); if(unlikely((AT(w)&NAMEABANDON)!=0)){ep(2,"::");}     break;
  case LPARX: eputc('(');              break;
  case RPARX: eputc(')');              break;
  case ASGNX: dspell(CAV(w)[0],w,(nflag&1));       break;

jsrc/ja.h

@@ -1204,10 +1204,11 @@
 // Handle top level of tpush().  push the current block, and recur if it is traversible and does not have recursive usecount
 // We can have an inplaceable but recursible block, if it was gc'd.  We never push a PERMANENT block, so that we won't try to free it
 // NOTE that PERMANENT blocks are always marked traversible if they are of traversible type, so we will not recur on them internally
-#define tpushcommon(x,suffix) {if(likely(!ACISPERM(AC(x)))){I tt=AT(x); A *pushp=jt->tnextpushp; *pushp++=(x); \
-                              if(unlikely(!((I)pushp&(NTSTACKBLOCK-1)))){RZ(pushp=tg(pushp));} if(unlikely(((tt^AFLAG(x))&TRAVERSIBLE)!=0))RZ(pushp=jttpush(jt,(x),tt,pushp)); jt->tnextpushp=pushp; suffix}}
-#define tpush(x)              tpushcommon(x,if(MEMAUDIT&2)audittstack(jt);)
-#define tpushna(x)            tpushcommon(x,)   // suppress audit
+#define tpushcommon(x,tmask,suffix) {if(likely(!ACISPERM(AC(x)))){I tt=AT(x); A *pushp=jt->tnextpushp; *pushp++=(x); \
+                              if(unlikely(!((I)pushp&(NTSTACKBLOCK-1)))){RZ(pushp=tg(pushp));} if(unlikely(((tt^AFLAG(x))&(tmask))!=0))RZ(pushp=jttpush(jt,(x),tt,pushp)); jt->tnextpushp=pushp; suffix}}
+#define tpush(x)              tpushcommon(x,TRAVERSIBLE,if(MEMAUDIT&2)audittstack(jt);)
+#define tpushna(x)            tpushcommon(x,TRAVERSIBLE,)   // suppress audit
+#define tpushnr(x)            tpushcommon(x,0,if(MEMAUDIT&2)audittstack(jt);)   // suppress recursion
 // Internal version, used when the local name pushp is known to hold jt->tnextpushp
 #define tpushi(x)                   {if(likely(!ACISPERM(AC(x)))){I tt=AT(x); *pushp++=(x); if(unlikely(!((I)pushp&(NTSTACKBLOCK-1)))){RZ(pushp=tg(pushp));} if((unlikely((tt^AFLAG(x))&TRAVERSIBLE)!=0))RZ(pushp=jttpush(jt,(x),tt,pushp)); }}
 // tpush1 is like tpush, but it does not recur to lower levels.  Used only for virtual block (which cannot be PERMANENT)

jsrc/jtype.h

@@ -323,6 +323,7 @@ typedef I SI;
 #define NAMEX 23
 #define NAME            ((I)1L<<NAMEX)    /* NM name                         */
 #define NAMESIZE sizeof(C)   // when we allocate a NAME type, the length is the length of the name string
+// NOTE: VERB, SYMB, and LPAR are used as flags in names
 #define SYMBX 24
 #define SYMB            ((I)1L<<SYMBX)     /* I  locale (symbol table)        */
 #define SYMBSIZE sizeof(LX)
@@ -341,15 +342,13 @@ typedef I SI;
 #define LPAR            ((I)1L<<LPARX)    /* I  left  parenthesis            */
 // note: LPAR used as flag to cvt() see below; also as modifier to ADV type
 #define LPARSIZE sizeof(I)
-// CONJ must be 1 bit below RPAR, with no parsable type (including any flags that might be set, see below) higher than RPAR
+// CONJ must be 1 bit below RPAR, with no parsable type (including any flags that might be set, see below) in CONJ or RPAR
 #define CONJX 29
 #define CONJ            ((I)1L<<CONJX)     /* V  conjunction                  */
 #define CONJSIZE sizeof(V)
 #define RPARX 30
 #define RPAR            ((I)1L<<RPARX)   /* I  right parenthesis            */
 #define RPARSIZE sizeof(I)
-#define SPARSEX 31  // NOTE this extends to the sign bit
-#define SPARSE            (-((I)1L<<SPARSEX))       /* P  sparse boxed                 */
 
 #define ASGNX 21
 #define ASGN            ((I)1L<<ASGNX)     /* I  assignment                   */
@@ -361,8 +360,13 @@ typedef I SI;
 // NOTE: The parser assumes that CONW always means ASGNTONAME, so don't use it in any parseable type (such as NAME, NOUN)
 // ** NOUN types can have the following informational bits set
 #define NOUNCVTVALIDCT  ((I)1L<<SYMBX)     // Flag for jtcvt arg only: if set, convert only the #atoms given in the parameter   Aliases with SYMB
+#define SPARSEX 31  // NOTE this extends to the sign bit
+#define SPARSE            (-((I)1L<<SPARSEX))       /* P  sparse boxed                 */
 // ** NAME type can have the following information flags set
 #define NAMEBYVALUE     ((I)1L<<SYMBX)     // set if the name is one of x x. m m. etc that is always passed by value, never by name   Aliases with SYMB
+#define NAMEABANDONX LPARX
+#define NAMEABANDON            ((I)1L<<NAMEABANDONX)     // name is name::, which will be deassigned after the value is stacked.  NAMEBYVALUE must also be set
+// in the parser VERB is set in a NAME type to indicate use of global symbol table
 // ** BOX type can have the following informational flags set
 #define BOXMULTIASSIGN  ((I)1L<<MARKX)     // set for the target of a direct multiple assignment (i. e. 'x y' =.), which is stored as a boxed list whose contents are NAMEs    aliases with MARK
 // Restriction: CONW must be reserved for use as ASGNTONAME because of how parser tests for it
@@ -477,7 +481,7 @@ typedef I SI;
 #define ACINCR(a)       ACINCRLOCAL(a)
 #define ACDECR(a)       ACDECRLOCAL(a)
 #define ACINIT(a,v)     AC(a)=(v);  // used when it is known that a has just been allocated & is not shared
-#define ACRESET(a,v)    AC(a)=(v);  // used when it is known that a has is not shared (perhaps it's UNINCORPABLE)
+#define ACRESET(a,v)    AC(a)=(v);  // used when it is known that a is not shared (perhaps it's UNINCORPABLE)
 #define ACSET(a,v)      AC(a)=(v);  // used when a might be shared, but atomic not needed
 #define ACFAUX(a,v)     AC(a)=(v);  // used when a is known to be a faux block
 #define ACINITZAP(a)    {*AZAPLOC(a)=0; ACINIT(a,ACUC1)}  // effect ra() immediately after allocation, by zapping
@@ -562,6 +566,7 @@ typedef I SI;
 #define AMNVRDECR(a,am) (am=AM(a),AM(a)-=AMNVRCT,am)  // save count, decrement, return old value
 #define AMNVRSET(a,x) (AM(a)=(x))
 #define AMNVRAND(a,x) (AM(a)&=(x));  // AND, no return
+#define AMNVROR(a,x) (AM(a)|=(x));  // OR, no return
 // decide action and new AM value to free a
 // nvrct!=0, !free -> set free
 // nvrct!=0, free -> no chg, fa

jsrc/m.c

@@ -767,6 +767,7 @@ static A raonlys(AD * RESTRICT w) { RZQ(w);
 
 // This routine handles the recursion for ra().  ra() itself does the top level, this routine handles the contents
 I jtra(AD* RESTRICT wd,I t){I n=AN(wd);
+ // we use if rather than switch because the first leg is most likely and the first two legs get almost everything
  if(t&BOX){AD* np;
   // boxed.  Loop through each box, recurring if called for.  Two passes are intertwined in the loop
   A* RESTRICT wv=AAV(wd);  // pointer to box pointers