Changeset 11772


Ignore:
Timestamp:
04/20/09 20:21:37 (15 years ago)
Author:
ehuelsmann
Message:

Factor out functions to separate declarations, the body and optionally the
documentation as well as to determine which variables have been declared
special.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • trunk/abcl/src/org/armedbear/lisp/Closure.java

    r11771 r11772  
    6363  private Parameter[] auxVars = emptyParameterArray;
    6464  private final LispObject body;
     65  private final LispObject executionBody;
    6566  private final Environment environment;
    6667  private final boolean andKey;
    … …  
    7980    }
    8081  private Symbol[] variables = emptySymbolArray;
    81   private Symbol[] specials = emptySymbolArray;
     82  private LispObject specials = NIL;
    8283
    8384  private boolean bindInitForms;
    … …  
    293294      }
    294295    this.body = lambdaExpression.cddr();
     296    LispObject bodyAndDecls = parseBody(this.body, false);
     297    this.executionBody = bodyAndDecls.car();
     298    this.specials = parseSpecials(bodyAndDecls.NTH(1));
     299
    295300    this.environment = env;
    296301    this.andKey = _andKey;
    … …  
    300305      Debug.assertTrue(arity == minArgs);
    301306    variables = processVariables();
    302     specials = processDeclarations();
    303307  }
    304308
    … …  
    334338  }
    335339
    336   private final Symbol[] processDeclarations() throws ConditionThrowable
    337   {
    338     ArrayList<Symbol> arrayList = null;
    339     LispObject forms = body;
    340     while (forms != NIL)
    341       {
    342         LispObject obj = forms.car();
    343         if (obj instanceof Cons && obj.car() == Symbol.DECLARE)
    344           {
    345             LispObject decls = obj.cdr();
    346             while (decls != NIL)
    347               {
    348                 LispObject decl = decls.car();
    349                 if (decl instanceof Cons && decl.car() == Symbol.SPECIAL)
    350                   {
    351                     LispObject vars = decl.cdr();
    352                     while (vars != NIL)
    353                       {
    354                         Symbol var = checkSymbol(vars.car());
    355                         if (arrayList == null)
    356                           arrayList = new ArrayList<Symbol>();
    357                         arrayList.add(var);
    358                         vars = vars.cdr();
    359                       }
    360                   }
    361                 decls = decls.cdr();
    362               }
    363             forms = forms.cdr();
    364           }
    365         else
    366           break;
    367       }
    368     if (arrayList == null)
    369       return emptySymbolArray;
    370     Symbol[] array = new Symbol[arrayList.size()];
    371     arrayList.toArray(array);
    372     return array;
    373   }
    374 
    375340  private static final void invalidParameter(LispObject obj)
    376341    throws ConditionThrowable
    … …  
    412377    if (arity == 0)
    413378      {
    414         return progn(body, environment,
     379        return progn(executionBody, environment,
    415380                     LispThread.currentThread());
    416381      }
    … …  
    436401    try
    437402      {
    438         return progn(body, ext, thread);
     403        return progn(executionBody, ext, thread);
    439404      }
    440405    finally
    … …  
    615580      }
    616581    bindAuxVars(ext, thread);
     582    LispObject s = specials;
    617583    special:
    618     for (Symbol special : specials) {
     584    while (s != NIL) {
     585      Symbol special = (Symbol)s.car();
     586      s = s.cdr();
    619587      for (Symbol var : variables)
    620588        if (special == var)
    … …  
    627595    try
    628596      {
    629         return progn(body, ext, thread);
     597        return progn(executionBody, ext, thread);
    630598      }
    631599    finally

  • trunk/abcl/src/org/armedbear/lisp/Do.java

    r11488 r11772  
    9797    final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
    9898    // Process declarations.
    99     LispObject specials = NIL;
    100     while (body != NIL)
    101       {
    102         LispObject obj = body.car();
    103         if (obj instanceof Cons && obj.car() == Symbol.DECLARE)
    104           {
    105             LispObject decls = obj.cdr();
    106             while (decls != NIL)
    107               {
    108                 LispObject decl = decls.car();
    109                 if (decl instanceof Cons && decl.car() == Symbol.SPECIAL)
    110                   {
    111                     LispObject names = decl.cdr();
    112                     while (names != NIL)
    113                       {
    114                         specials = new Cons(names.car(), specials);
    115                         names = names.cdr();
    116                       }
    117                   }
    118                 decls = decls.cdr();
    119               }
    120             body = body.cdr();
    121           }
    122         else
    123           break;
    124       }
     99
     100    final LispObject bodyAndDecls = parseBody(body, false);
     101    LispObject specials = parseSpecials(bodyAndDecls.NTH(1));
     102    body = bodyAndDecls.car();
     103
    125104    final Environment ext = new Environment(env);
    126105    for (int i = 0; i < numvars; i++)

  • trunk/abcl/src/org/armedbear/lisp/Environment.java

    r11770 r11772  
    204204    throws ConditionThrowable
    205205  {
    206     while (body != NIL)
    207       {
    208         LispObject obj = body.car();
    209         if (obj instanceof Cons && ((Cons)obj).car == Symbol.DECLARE)
    210           {
    211             LispObject decls = ((Cons)obj).cdr;
    212             while (decls != NIL)
    213               {
    214                 LispObject decl = decls.car();
    215                 if (decl instanceof Cons && ((Cons)decl).car == Symbol.SPECIAL)
    216                   {
    217                     LispObject names = ((Cons)decl).cdr;
    218                     while (names != NIL)
    219                       {
    220                         Symbol var = checkSymbol(names.car());
    221                         declareSpecial(var);
    222                         names = ((Cons)names).cdr;
    223                       }
    224                   }
    225                 decls = ((Cons)decls).cdr;
    226               }
    227             body = ((Cons)body).cdr;
    228           }
    229         else
    230           break;
    231       }
    232     return body;
     206    LispObject bodyAndDecls = parseBody(body, false);
     207    LispObject specials = parseSpecials(bodyAndDecls.NTH(1));
     208    for (; specials != NIL; specials = specials.cdr())
     209      declareSpecial(checkSymbol(specials.car()));
     210
     211    return bodyAndDecls.car();
    233212  }
    234213

  • trunk/abcl/src/org/armedbear/lisp/Lisp.java

    r11760 r11772  
    547547  }
    548548
     549  public static final LispObject parseBody(LispObject body,
     550                                           boolean documentationAllowed)
     551    throws ConditionThrowable
     552  {
     553      LispObject decls = NIL;
     554      LispObject doc = NIL;
     555
     556      while (body != NIL) {
     557        LispObject form = body.car();
     558        if (documentationAllowed && form instanceof AbstractString
     559            && body.cdr() != NIL) {
     560          doc = body.car();
     561          documentationAllowed = false;
     562        } else if (form instanceof Cons && form.car() == Symbol.DECLARE)
     563          decls = new Cons(form, decls);
     564        else
     565          break;
     566
     567        body = body.cdr();
     568      }
     569      return list(body, decls.nreverse(), doc);
     570  }
     571
     572  public static final LispObject parseSpecials(LispObject forms)
     573    throws ConditionThrowable
     574  {
     575    LispObject specials = NIL;
     576    while (forms != NIL) {
     577      LispObject decls = forms.car();
     578
     579      Debug.assertTrue(decls instanceof Cons);
     580      Debug.assertTrue(decls.car() == Symbol.DECLARE);
     581      decls = decls.cdr();
     582      while (decls != NIL) {
     583        LispObject decl = decls.car();
     584
     585        if (decl instanceof Cons && decl.car() == Symbol.SPECIAL) {
     586            decl = decl.cdr();
     587            while (decl != NIL) {
     588              specials = new Cons(checkSymbol(decl.car()), specials);
     589              decl = decl.cdr();
     590            }
     591        }
     592
     593        decls = decls.cdr();
     594      }
     595
     596      forms = forms.cdr();
     597    }
     598
     599    return specials;
     600  }
     601
    549602  public static final LispObject progn(LispObject body, Environment env,
    550603                                       LispThread thread)
    … …  
    561614
    562615  // Environment wrappers.
    563   private static final boolean isSpecial(Symbol sym, Symbol[] ownSpecials,
     616  private static final boolean isSpecial(Symbol sym, LispObject ownSpecials,
    564617                                         Environment env)
     618    throws ConditionThrowable
    565619  {
    566620    if (ownSpecials != null)
    … …  
    568622        if (sym.isSpecialVariable())
    569623          return true;
    570         for (Symbol special : ownSpecials)
    571           {
    572             if (sym == special)
     624        for (; ownSpecials != NIL; ownSpecials = ownSpecials.cdr())
     625          {
     626            if (sym == ownSpecials.car())
    573627              return true;
    574628          }
    … …  
    576630    return false;
    577631  }
    578   protected static final void bindArg(Symbol[] ownSpecials,
     632
     633  protected static final void bindArg(LispObject ownSpecials,
    579634                                      Symbol sym, LispObject value,
    580635                                      Environment env, LispThread thread)

  • trunk/abcl/src/org/armedbear/lisp/Primitives.java

    r11754 r11772  
    37473747          }
    37483748        // Process declarations.
    3749         LispObject specials = NIL;
    3750         while (body != NIL)
    3751           {
    3752             LispObject obj = body.car();
    3753             if (obj instanceof Cons && ((Cons)obj).car == Symbol.DECLARE)
    3754               {
    3755                 LispObject decls = ((Cons)obj).cdr;
    3756                 while (decls != NIL)
    3757                   {
    3758                     LispObject decl = decls.car();
    3759                     if (decl instanceof Cons && ((Cons)decl).car == Symbol.SPECIAL)
    3760                       {
    3761                         LispObject declvars = ((Cons)decl).cdr;
    3762                         while (declvars != NIL)
    3763                           {
    3764                             specials = new Cons(declvars.car(), specials);
    3765                             declvars = ((Cons)declvars).cdr;
    3766                           }
    3767                       }
    3768                     decls = ((Cons)decls).cdr;
    3769                   }
    3770                 body = ((Cons)body).cdr;
    3771               }
    3772             else
    3773               break;
    3774           }
     3749        LispObject bodyAndDecls = parseBody(body, false);
     3750        LispObject specials = parseSpecials(bodyAndDecls.NTH(1));
     3751        body = bodyAndDecls.car();
     3752
    37753753        final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
    37763754        final Environment ext = new Environment(env);

  • trunk/abcl/src/org/armedbear/lisp/SpecialOperators.java

    r11769 r11772  
    119119      {
    120120        LispObject varList = checkList(args.car());
    121         LispObject body = args.cdr();
    122         // Process declarations.
    123         ArrayList<Symbol> specials = new ArrayList<Symbol>();
    124         while (body != NIL)
    125           {
    126             LispObject obj = body.car();
    127             if (obj instanceof Cons && ((Cons)obj).car == Symbol.DECLARE)
    128               {
    129                 LispObject decls = ((Cons)obj).cdr;
    130                 while (decls != NIL)
    131                   {
    132                     LispObject decl = decls.car();
    133                     if (decl instanceof Cons && ((Cons)decl).car == Symbol.SPECIAL)
    134                       {
    135                         LispObject vars = ((Cons)decl).cdr;
    136                         while (vars != NIL)
    137                           {
    138                             specials.add(0, (Symbol) vars.car());
    139                             vars = ((Cons)vars).cdr;
    140                           }
    141                       }
    142                     decls = ((Cons)decls).cdr;
    143                   }
    144                 body = ((Cons)body).cdr;
    145               }
    146             else
    147               break;
    148           }
     121        LispObject bodyAndDecls = parseBody(args.cdr(), false);
     122        LispObject specials = parseSpecials(bodyAndDecls.NTH(1));
     123        LispObject body = bodyAndDecls.car();
     124
    149125        Environment ext = new Environment(env);
    150126        LinkedList<Cons> nonSequentialVars = new LinkedList<Cons>();
    151         Symbol[] arrayToUseForSpecials = new Symbol[0];
    152127        while (varList != NIL)
    153128          {
    … …  
    170145              }
    171146            if (sequential)
    172                 bindArg(specials.toArray(arrayToUseForSpecials),
    173                         symbol, value, ext, thread);
     147              bindArg(specials, symbol, value, ext, thread);
    174148            else
    175149                nonSequentialVars.add(new Cons(symbol, value));
    … …  
    177151          }
    178152        if (!sequential)
    179           {
    180             for (Cons x : nonSequentialVars)
    181               {
    182                 bindArg(specials.toArray(arrayToUseForSpecials),
    183                         (Symbol)x.car(), x.cdr(), ext, thread);
    184               }
    185           }
     153          for (Cons x : nonSequentialVars)
     154            bindArg(specials, (Symbol)x.car(), x.cdr(), ext, thread);
     155
    186156        // Make sure free special declarations are visible in the body.
    187157        // "The scope of free declarations specifically does not include
    188158        // initialization forms for bindings established by the form
    189159        // containing the declarations." (3.3.4)
    190         for (Symbol symbol : specials)
    191           {
    192             ext.declareSpecial(symbol);
    193           }
     160        for (; specials != NIL; specials = specials.cdr())
     161          ext.declareSpecial((Symbol)specials.car());
     162
    194163        return progn(body, ext, thread);
    195164      }

  • trunk/abcl/src/org/armedbear/lisp/dolist.java

    r11488 r11772  
    5555    final LispObject stack = thread.getStack();
    5656    // Process declarations.
    57     LispObject specials = NIL;
    58     while (bodyForm != NIL)
    59       {
    60         LispObject obj = bodyForm.car();
    61         if (obj instanceof Cons && obj.car() == Symbol.DECLARE)
    62           {
    63             LispObject decls = obj.cdr();
    64             while (decls != NIL)
    65               {
    66                 LispObject decl = decls.car();
    67                 if (decl instanceof Cons && decl.car() == Symbol.SPECIAL)
    68                   {
    69                     LispObject vars = decl.cdr();
    70                     while (vars != NIL)
    71                       {
    72                         specials = new Cons(vars.car(), specials);
    73                         vars = vars.cdr();
    74                       }
    75                   }
    76                 decls = decls.cdr();
    77               }
    78             bodyForm = bodyForm.cdr();
    79           }
    80         else
    81           break;
    82       }
     57    LispObject bodyAndDecls = parseBody(bodyForm, false);
     58    LispObject specials = parseSpecials(bodyAndDecls.NTH(1));
     59    bodyForm = bodyAndDecls.car();
     60
    8361    try
    8462      {

  • trunk/abcl/src/org/armedbear/lisp/dotimes.java

    r11714 r11772  
    5353    SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
    5454    final LispObject stack = thread.getStack();
    55     // Process declarations.
    56     LispObject specials = NIL;
    57     while (bodyForm != NIL)
    58       {
    59         LispObject obj = bodyForm.car();
    60         if (obj instanceof Cons && obj.car() == Symbol.DECLARE)
    61           {
    62             LispObject decls = obj.cdr();
    63             while (decls != NIL)
    64               {
    65                 LispObject decl = decls.car();
    66                 if (decl instanceof Cons && decl.car() == Symbol.SPECIAL)
    67                   {
    68                     LispObject vars = decl.cdr();
    69                     while (vars != NIL)
    70                       {
    71                         specials = new Cons(vars.car(), specials);
    72                         vars = vars.cdr();
    73                       }
    74                   }
    75                 decls = decls.cdr();
    76               }
    77             bodyForm = bodyForm.cdr();
    78           }
    79         else
    80           break;
    81       }
     55
     56    LispObject bodyAndDecls = parseBody(bodyForm, false);
     57    LispObject specials = parseSpecials(bodyAndDecls.NTH(1));
     58    bodyForm = bodyAndDecls.car();
     59
    8260    try
    8361      {
Note: See TracChangeset for help on using the changeset viewer.