/[guile]/guile/guile-core/libguile/eval.c
ViewVC logotype

Diff of /guile/guile-core/libguile/eval.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.325 by dirk, Sun Oct 12 07:13:46 2003 UTC revision 1.326 by dirk, Sun Oct 12 09:22:52 2003 UTC
# Line 151  static const char s_missing_recipient[] Line 151  static const char s_missing_recipient[]
151   * detected, a 'Bad variable' error is signalled.  */   * detected, a 'Bad variable' error is signalled.  */
152  static const char s_bad_variable[] = "Bad variable";  static const char s_bad_variable[] = "Bad variable";
153    
154    /* Bindings for forms like 'let' and 'do' have to be given in a proper,
155     * possibly empty list.  If any other object is detected in a place where a
156     * list of bindings was required, a 'Bad bindings' error is signalled.  */
157    static const char s_bad_bindings[] = "Bad bindings";
158    
159    /* Depending on the syntactic context, a binding has to be in the format
160     * (<variable> <expression>) or (<variable> <expression1> <expression2>).
161     * If anything else is detected in a place where a binding was expected, a
162     * 'Bad binding' error is signalled.  */
163    static const char s_bad_binding[] = "Bad binding";
164    
165    /* If the exit form of a 'do' expression is not in the format
166     *   (<test> <expression> ...)
167     * a 'Bad exit clause' error is signalled.  */
168    static const char s_bad_exit_clause[] = "Bad exit clause";
169    
170    
171  /* Signal a syntax error.  We distinguish between the form that caused the  /* Signal a syntax error.  We distinguish between the form that caused the
172   * error and the enclosing expression.  The error message will print out as   * error and the enclosing expression.  The error message will print out as
# Line 966  scm_m_delay (SCM expr, SCM env) Line 982  scm_m_delay (SCM expr, SCM env)
982  }  }
983    
984    
985    SCM_SYNTAX(s_do, "do", scm_i_makbimacro, scm_m_do);
986    SCM_GLOBAL_SYMBOL(scm_sym_do, s_do);
987    
988  /* DO gets the most radically altered syntax.  The order of the vars is  /* DO gets the most radically altered syntax.  The order of the vars is
989   * reversed here.  In contrast, the order of the inits and steps is reversed   * reversed here.  In contrast, the order of the inits and steps is reversed
990   * during the evaluation:   * during the evaluation:
991    
992     (do ((<var1> <init1> <step1>)     (do ((<var1> <init1> <step1>)
993     (<var2> <init2>)          (<var2> <init2>)
994     ... )          ... )
995     (<test> <return>)         (<test> <return>)
996     <body>)       <body>)
997    
998     ;; becomes     ;; becomes
999    
1000     (#@do (<init1> <init2> ... <initn>)     (#@do (<init1> <init2> ... <initn>)
1001     (varn ... var2 var1)           (varn ... var2 var1)
1002     (<test> <return>)           (<test> <return>)
1003     (<body>)           (<body>)
1004     <step1> <step2> ... <stepn>) ;; missing steps replaced by var       <step1> <step2> ... <stepn>) ;; missing steps replaced by var
1005   */   */
   
 SCM_SYNTAX(s_do, "do", scm_i_makbimacro, scm_m_do);  
 SCM_GLOBAL_SYMBOL(scm_sym_do, s_do);  
   
1006  SCM  SCM
1007  scm_m_do (SCM xorig, SCM env SCM_UNUSED)  scm_m_do (SCM expr, SCM env SCM_UNUSED)
1008  {  {
1009    SCM bindings;    SCM variables = SCM_EOL;
1010    SCM x = SCM_CDR (xorig);    SCM init_forms = SCM_EOL;
1011    SCM vars = SCM_EOL;    SCM step_forms = SCM_EOL;
1012    SCM inits = SCM_EOL;    SCM binding_idx;
1013    SCM *initloc = &inits;    SCM cddr_expr;
1014    SCM steps = SCM_EOL;    SCM exit_clause;
1015    SCM *steploc = &steps;    SCM commands;
1016    SCM_ASSYNT (scm_ilength (x) >= 2, s_test, "do");    SCM tail;
1017    bindings = SCM_CAR (x);  
1018    SCM_ASSYNT (scm_ilength (bindings) >= 0, s_bindings, "do");    const SCM cdr_expr = SCM_CDR (expr);
1019    while (!SCM_NULLP (bindings))    ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
1020      {    ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 2, s_missing_expression, expr);
1021        SCM binding = SCM_CAR (bindings);  
1022        long len = scm_ilength (binding);    /* Collect variables, init and step forms. */
1023        SCM_ASSYNT (len == 2 || len == 3, s_bindings, "do");    binding_idx = SCM_CAR (cdr_expr);
1024      ASSERT_SYNTAX_2 (scm_ilength (binding_idx) >= 0,
1025                       s_bad_bindings, binding_idx, expr);
1026      for (; !SCM_NULLP (binding_idx); binding_idx = SCM_CDR (binding_idx))
1027        {
1028          const SCM binding = SCM_CAR (binding_idx);
1029          const long length = scm_ilength (binding);
1030          ASSERT_SYNTAX_2 (length == 2 || length == 3,
1031                           s_bad_binding, binding, expr);
1032    
1033        {        {
1034          SCM name = SCM_CAR (binding);          const SCM name = SCM_CAR (binding);
1035          SCM init = SCM_CADR (binding);          const SCM init = SCM_CADR (binding);
1036          SCM step = (len == 2) ? name : SCM_CADDR (binding);          const SCM step = (length == 2) ? name : SCM_CADDR (binding);
1037          SCM_ASSYNT (SCM_SYMBOLP (name), s_variable, "do");          ASSERT_SYNTAX_2 (SCM_SYMBOLP (name), s_bad_variable, name, expr);
1038          vars = scm_cons (name, vars);          variables = scm_cons (name, variables);
1039          *initloc = scm_list_1 (init);          init_forms = scm_cons (init, init_forms);
1040          initloc = SCM_CDRLOC (*initloc);          step_forms = scm_cons (step, step_forms);
         *steploc = scm_list_1 (step);  
         steploc = SCM_CDRLOC (*steploc);  
         bindings = SCM_CDR (bindings);  
1041        }        }
1042      }      }
1043    x = SCM_CDR (x);    init_forms = scm_reverse_x (init_forms, SCM_UNDEFINED);
1044    SCM_ASSYNT (scm_ilength (SCM_CAR (x)) >= 1, s_test, "do");    step_forms = scm_reverse_x (step_forms, SCM_UNDEFINED);
1045    x = scm_cons2 (SCM_CAR (x), SCM_CDR (x), steps);  
1046    x = scm_cons2 (inits, vars, x);    /* Memoize the test form and the exit sequence. */
1047    return scm_cons (SCM_IM_DO, x);    cddr_expr = SCM_CDR (cdr_expr);
1048      exit_clause = SCM_CAR (cddr_expr);
1049      ASSERT_SYNTAX_2 (scm_ilength (exit_clause) >= 1,
1050                       s_bad_exit_clause, exit_clause, expr);
1051    
1052      commands = SCM_CDR (cddr_expr);
1053      tail = scm_cons2 (exit_clause, commands, step_forms);
1054      tail = scm_cons2 (init_forms, variables, tail);
1055      SCM_SETCAR (expr, SCM_IM_DO);
1056      SCM_SETCDR (expr, tail);
1057      return expr;
1058  }  }
1059    
1060    

Legend:
Removed from v.1.325  
changed lines
  Added in v.1.326

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26