/[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.322 by dirk, Sat Oct 11 01:52:24 2003 UTC revision 1.323 by dirk, Sat Oct 11 10:40:17 2003 UTC
# Line 100  char *alloca (); Line 100  char *alloca ();
100   * expression is expected, a 'Bad expression' error is signalled.  */   * expression is expected, a 'Bad expression' error is signalled.  */
101  static const char s_bad_expression[] = "Bad expression";  static const char s_bad_expression[] = "Bad expression";
102    
103    /* If a form is detected that holds more expressions than are allowed in that
104     * contect, an 'Extra expression' error is signalled.  */
105    static const char s_extra_expression[] = "Extra expression in";
106    
107  /* Case or cond expressions must have at least one clause.  If a case or cond  /* Case or cond expressions must have at least one clause.  If a case or cond
108   * expression without any clauses is detected, a 'Missing clauses' error is   * expression without any clauses is detected, a 'Missing clauses' error is
109   * signalled.  */   * signalled.  */
110  static const char s_missing_clauses[] = "Missing clauses";  static const char s_missing_clauses[] = "Missing clauses";
111    
112    /* If there is an 'else' clause in a case or a cond statement, it must be the
113     * last clause.  If after the 'else' case clause further clauses are detected,
114     * a 'Misplaced else clause' error is signalled.  */
115    static const char s_misplaced_else_clause[] = "Misplaced else clause";
116    
117  /* If a case clause is detected that is not in the format  /* If a case clause is detected that is not in the format
118   *   (<label(s)> <expression1> <expression2> ...)   *   (<label(s)> <expression1> <expression2> ...)
119   * a 'Bad case clause' error is signalled.  */   * a 'Bad case clause' error is signalled.  */
120  static const char s_bad_case_clause[] = "Bad case clause";  static const char s_bad_case_clause[] = "Bad case clause";
121    
 /* If there is an 'else' clause in a case statement, it must be the last  
  * clause.  If after the 'else' case clause further clauses are detected, an  
  * 'Extra case clause' error is signalled.  */  
 static const char s_extra_case_clause[] = "Extra case clause";  
   
122  /* If a case clause is detected where the <label(s)> element is neither a  /* If a case clause is detected where the <label(s)> element is neither a
123   * proper list nor (in case of the last clause) the syntactic keyword 'else',   * proper list nor (in case of the last clause) the syntactic keyword 'else',
124   * a 'Bad case labels' error is signalled.  Note: If you encounter this error   * a 'Bad case labels' error is signalled.  Note: If you encounter this error
# Line 129  static const char s_bad_case_labels[] = Line 133  static const char s_bad_case_labels[] =
133   * signalled.  */   * signalled.  */
134  static const char s_duplicate_case_label[] = "Duplicate case label";  static const char s_duplicate_case_label[] = "Duplicate case label";
135    
136    /* If a cond clause is detected that is not in one of the formats
137     *   (<test> <expression1> ...) or (else <expression1> <expression2> ...)
138     * a 'Bad cond clause' error is signalled.  */
139    static const char s_bad_cond_clause[] = "Bad cond clause";
140    
141    /* If a cond clause is detected that uses the alternate '=>' form, but does
142     * not hold a recipient element for the test result, a 'Missing recipient'
143     * error is signalled.  */
144    static const char s_missing_recipient[] = "Missing recipient in";
145    
146    
147  /* Signal a syntax error.  We distinguish between the form that caused the  /* Signal a syntax error.  We distinguish between the form that caused the
148   * 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 621  scm_eval_car (SCM pair, SCM env) Line 635  scm_eval_car (SCM pair, SCM env)
635   * some memoized forms have different syntax   * some memoized forms have different syntax
636   */   */
637    
 SCM_GLOBAL_SYMBOL (scm_sym_arrow, "=>");  
638  SCM_GLOBAL_SYMBOL (scm_sym_else, "else");  SCM_GLOBAL_SYMBOL (scm_sym_else, "else");
639  SCM_GLOBAL_SYMBOL (scm_sym_unquote, "unquote");  SCM_GLOBAL_SYMBOL (scm_sym_unquote, "unquote");
640  SCM_GLOBAL_SYMBOL (scm_sym_uq_splicing, "unquote-splicing");  SCM_GLOBAL_SYMBOL (scm_sym_uq_splicing, "unquote-splicing");
# Line 753  scm_m_case (SCM expr, SCM env) Line 766  scm_m_case (SCM expr, SCM env)
766            ASSERT_SYNTAX_2 (SCM_EQ_P (labels, scm_sym_else) && else_literal_p,            ASSERT_SYNTAX_2 (SCM_EQ_P (labels, scm_sym_else) && else_literal_p,
767                             s_bad_case_labels, labels, expr);                             s_bad_case_labels, labels, expr);
768            ASSERT_SYNTAX_2 (SCM_NULLP (SCM_CDR (clauses)),            ASSERT_SYNTAX_2 (SCM_NULLP (SCM_CDR (clauses)),
769                             s_extra_case_clause, SCM_CDR (clauses), expr);                             s_misplaced_else_clause, clause, expr);
770          }          }
771    
772        /* build the new clause */        /* build the new clause */
# Line 782  scm_m_case (SCM expr, SCM env) Line 795  scm_m_case (SCM expr, SCM env)
795    
796  SCM_SYNTAX (s_cond, "cond", scm_i_makbimacro, scm_m_cond);  SCM_SYNTAX (s_cond, "cond", scm_i_makbimacro, scm_m_cond);
797  SCM_GLOBAL_SYMBOL (scm_sym_cond, s_cond);  SCM_GLOBAL_SYMBOL (scm_sym_cond, s_cond);
798    SCM_GLOBAL_SYMBOL (scm_sym_arrow, "=>");
799    
800  SCM  SCM
801  scm_m_cond (SCM xorig, SCM env SCM_UNUSED)  scm_m_cond (SCM expr, SCM env)
802  {  {
803    SCM cdrx = SCM_CDR (xorig);    /* Check, whether 'else or '=> is a literal, i. e. not bound to a value. */
804    SCM clauses = cdrx;    const int else_literal_p = literal_p (scm_sym_else, env);
805    SCM_ASSYNT (scm_ilength (clauses) >= 1, s_clauses, s_cond);    const int arrow_literal_p = literal_p (scm_sym_arrow, env);
806    while (!SCM_NULLP (clauses))  
807      const SCM clauses = SCM_CDR (expr);
808      SCM clause_idx;
809    
810      ASSERT_SYNTAX (scm_ilength (clauses) >= 0, s_bad_expression, expr);
811      ASSERT_SYNTAX (scm_ilength (clauses) >= 1, s_missing_clauses, expr);
812    
813      for (clause_idx = clauses;
814           !SCM_NULLP (clause_idx);
815           clause_idx = SCM_CDR (clause_idx))
816      {      {
817        SCM clause = SCM_CAR (clauses);        SCM test;
818        long len = scm_ilength (clause);  
819        SCM_ASSYNT (len >= 1, s_clauses, s_cond);        const SCM clause = SCM_CAR (clause_idx);
820        if (SCM_EQ_P (scm_sym_else, SCM_CAR (clause)))        const long length = scm_ilength (clause);
821          ASSERT_SYNTAX_2 (length >= 1, s_bad_cond_clause, clause, expr);
822    
823          test = SCM_CAR (clause);
824          if (SCM_EQ_P (test, scm_sym_else) && else_literal_p)
825          {          {
826            int last_clause_p = SCM_NULLP (SCM_CDR (clauses));            const int last_clause_p = SCM_NULLP (SCM_CDR (clause_idx));
827            SCM_ASSYNT (len >= 2 && last_clause_p, "bad ELSE clause", s_cond);            ASSERT_SYNTAX_2 (length >= 2,
828                               s_bad_cond_clause, clause, expr);
829              ASSERT_SYNTAX_2 (last_clause_p,
830                               s_misplaced_else_clause, clause, expr);
831              SCM_SETCAR (clause, SCM_IM_ELSE);
832          }          }
833        else if (len >= 2 && SCM_EQ_P (scm_sym_arrow, SCM_CADR (clause)))        else if (length >= 2
834          {                 && SCM_EQ_P (SCM_CADR (clause), scm_sym_arrow)
835            SCM_ASSYNT (len > 2, "missing recipient", s_cond);                 && arrow_literal_p)
836            SCM_ASSYNT (len == 3, "bad recipient", s_cond);          {
837              ASSERT_SYNTAX_2 (length > 2, s_missing_recipient, clause, expr);
838              ASSERT_SYNTAX_2 (length == 3, s_extra_expression, clause, expr);
839              SCM_SETCAR (SCM_CDR (clause), SCM_IM_ARROW);
840          }          }
       clauses = SCM_CDR (clauses);  
841      }      }
842    return scm_cons (SCM_IM_COND, cdrx);  
843      SCM_SETCAR (expr, SCM_IM_COND);
844      return expr;
845  }  }
846    
847    
# Line 1880  loop: Line 1915  loop:
1915            SCM_SETCDR (z, unmemocar (copy, env));            SCM_SETCDR (z, unmemocar (copy, env));
1916            z = SCM_CDR (z);            z = SCM_CDR (z);
1917          }          }
1918          else if (SCM_EQ_P (form, SCM_IM_ARROW))
1919            {
1920              SCM_SETCDR (z, scm_cons (scm_sym_arrow, SCM_UNSPECIFIED));
1921              z = SCM_CDR (z);
1922            }
1923        x = SCM_CDR (x);        x = SCM_CDR (x);
1924      }      }
1925    SCM_SETCDR (z, x);    SCM_SETCDR (z, x);
# Line 2424  dispatch: Line 2464  dispatch:
2464        while (!SCM_NULLP (x))        while (!SCM_NULLP (x))
2465          {          {
2466            SCM clause = SCM_CAR (x);            SCM clause = SCM_CAR (x);
2467            if (SCM_EQ_P (SCM_CAR (clause), scm_sym_else))            if (SCM_EQ_P (SCM_CAR (clause), SCM_IM_ELSE))
2468              {              {
2469                x = SCM_CDR (clause);                x = SCM_CDR (clause);
2470                PREP_APPLY (SCM_UNDEFINED, SCM_EOL);                PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
# Line 2438  dispatch: Line 2478  dispatch:
2478                    x = SCM_CDR (clause);                    x = SCM_CDR (clause);
2479                    if (SCM_NULLP (x))                    if (SCM_NULLP (x))
2480                      RETURN (arg1);                      RETURN (arg1);
2481                    else if (!SCM_EQ_P (SCM_CAR (x), scm_sym_arrow))                    else if (!SCM_EQ_P (SCM_CAR (x), SCM_IM_ARROW))
2482                      {                      {
2483                        PREP_APPLY (SCM_UNDEFINED, SCM_EOL);                        PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
2484                        goto begin;                        goto begin;

Legend:
Removed from v.1.322  
changed lines
  Added in v.1.323

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