/[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.333 by dirk, Sat Oct 18 19:03:24 2003 UTC revision 1.334 by dirk, Wed Oct 22 20:16:41 2003 UTC
# Line 1704  scm_m_atslot_set_x (SCM expr, SCM env SC Line 1704  scm_m_atslot_set_x (SCM expr, SCM env SC
1704    
1705  #if SCM_ENABLE_ELISP  #if SCM_ENABLE_ELISP
1706    
1707    static const char s_defun[] = "Symbol's function definition is void";
1708    
1709  SCM_SYNTAX (s_nil_cond, "nil-cond", scm_i_makbimacro, scm_m_nil_cond);  SCM_SYNTAX (s_nil_cond, "nil-cond", scm_i_makbimacro, scm_m_nil_cond);
1710    
1711    /* nil-cond expressions have the form
1712     *   (nil-cond COND VAL COND VAL ... ELSEVAL)  */
1713  SCM  SCM
1714  scm_m_nil_cond (SCM xorig, SCM env SCM_UNUSED)  scm_m_nil_cond (SCM expr, SCM env SCM_UNUSED)
1715  {  {
1716    long len = scm_ilength (SCM_CDR (xorig));    const long length = scm_ilength (SCM_CDR (expr));
1717    SCM_ASSYNT (len >= 1 && (len & 1) == 1, s_expression, "nil-cond");    ASSERT_SYNTAX (length >= 0, s_bad_expression, expr);
1718    return scm_cons (SCM_IM_NIL_COND, SCM_CDR (xorig));    ASSERT_SYNTAX (length >= 1 && (length % 2) == 1, s_expression, expr);
1719    
1720      SCM_SETCAR (expr, SCM_IM_NIL_COND);
1721      return expr;
1722  }  }
1723    
1724    
1725  SCM_SYNTAX (s_atfop, "@fop", scm_i_makbimacro, scm_m_atfop);  SCM_SYNTAX (s_atfop, "@fop", scm_i_makbimacro, scm_m_atfop);
1726    
1727    /* The @fop-macro handles procedure and macro applications for elisp.  The
1728     * input expression must have the form
1729     *    (@fop <var> (transformer-macro <expr> ...))
1730     * where <var> must be a symbol.  The expression is transformed into the
1731     * memoized form of either
1732     *    (apply <un-aliased var> (transformer-macro <expr> ...))
1733     * if the value of var (across all aliasing) is not a macro, or
1734     *    (<un-aliased var> <expr> ...)
1735     * if var is a macro. */
1736  SCM  SCM
1737  scm_m_atfop (SCM xorig, SCM env SCM_UNUSED)  scm_m_atfop (SCM expr, SCM env SCM_UNUSED)
1738  {  {
1739    SCM x = SCM_CDR (xorig), var;    SCM location;
1740    SCM_ASSYNT (scm_ilength (x) >= 1, s_expression, "@fop");    SCM symbol;
1741    var = scm_symbol_fref (SCM_CAR (x));  
1742    /* Passing the symbol name as the `subr' arg here isn't really    const SCM cdr_expr = SCM_CDR (expr);
1743       right, but without it it can be very difficult to work out from    ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
1744       the error message which function definition was missing.  In any    ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 1, s_missing_expression, expr);
1745       case, we shouldn't really use SCM_ASSYNT here at all, but instead  
1746       something equivalent to (signal void-function (list SYM)) in    symbol = SCM_CAR (cdr_expr);
1747       Elisp. */    ASSERT_SYNTAX_2 (SCM_SYMBOLP (symbol), s_bad_variable, symbol, expr);
1748    SCM_ASSYNT (SCM_VARIABLEP (var),  
1749                "Symbol's function definition is void",    location = scm_symbol_fref (symbol);
1750                SCM_SYMBOL_CHARS (SCM_CAR (x)));    ASSERT_SYNTAX_2 (SCM_VARIABLEP (location), s_defun, symbol, expr);
1751    /* Support `defalias'. */  
1752    while (SCM_SYMBOLP (SCM_VARIABLE_REF (var)))    /* The elisp function `defalias' allows to define aliases for symbols.  To
1753       * look up such definitions, the chain of symbol definitions has to be
1754       * followed up to the terminal symbol.  */
1755      while (SCM_SYMBOLP (SCM_VARIABLE_REF (location)))
1756      {      {
1757        var = scm_symbol_fref (SCM_VARIABLE_REF (var));        const SCM alias = SCM_VARIABLE_REF (location);
1758        SCM_ASSYNT (SCM_VARIABLEP (var),        location = scm_symbol_fref (alias);
1759                    "Symbol's function definition is void",        ASSERT_SYNTAX_2 (SCM_VARIABLEP (location), s_defun, symbol, expr);
                   SCM_SYMBOL_CHARS (SCM_CAR (x)));  
1760      }      }
1761    /* Use `var' here rather than `SCM_VARIABLE_REF (var)' because the  
1762       former allows for automatically picking up redefinitions of the    /* Memoize the value location belonging to the terminal symbol.  */
1763       corresponding symbol. */    SCM_SETCAR (cdr_expr, location);
1764    SCM_SETCAR (x, var);  
1765    /* If the variable contains a procedure, leave the    if (!SCM_MACROP (SCM_VARIABLE_REF (location)))
      `transformer-macro' in place so that the procedure's arguments  
      get properly transformed, and change the initial @fop to  
      SCM_IM_APPLY. */  
   if (!SCM_MACROP (SCM_VARIABLE_REF (var)))  
1766      {      {
1767        SCM_SETCAR (xorig, SCM_IM_APPLY);        /* Since the location does not contain a macro, the form is a procedure
1768        return xorig;         * application.  Replace `@fop' by `@apply' and transform the expression
1769           * including the `transformer-macro'.  */
1770          SCM_SETCAR (expr, SCM_IM_APPLY);
1771          return expr;
1772        }
1773      else
1774        {
1775          /* Since the location contains a macro, the arguments should not be
1776           * transformed, so the `transformer-macro' is cut out.  The resulting
1777           * expression starts with the memoized variable, that is at the cdr of
1778           * the input expression.  */
1779          SCM_SETCDR (cdr_expr, SCM_CDADR (cdr_expr));
1780          return cdr_expr;
1781      }      }
   /* Otherwise (the variable contains a macro), the arguments should  
      not be transformed, so cut the `transformer-macro' out and return  
      the resulting expression starting with the variable. */  
   SCM_SETCDR (x, SCM_CDADR (x));  
   return x;  
1782  }  }
1783    
1784  #endif /* SCM_ENABLE_ELISP */  #endif /* SCM_ENABLE_ELISP */
# Line 1771  scm_m_atfop (SCM xorig, SCM env SCM_UNUS Line 1792  scm_m_atfop (SCM xorig, SCM env SCM_UNUS
1792  SCM_SYNTAX (s_undefine, "undefine", scm_makacro, scm_m_undefine);  SCM_SYNTAX (s_undefine, "undefine", scm_makacro, scm_m_undefine);
1793    
1794  SCM  SCM
1795  scm_m_undefine (SCM x, SCM env)  scm_m_undefine (SCM expr, SCM env)
1796  {  {
1797    SCM arg1 = x;    SCM variable;
1798    x = SCM_CDR (x);    SCM location;
1799    SCM_ASSYNT (SCM_TOP_LEVEL (env), "bad placement ", s_undefine);  
1800    SCM_ASSYNT (SCM_CONSP (x) && SCM_NULLP (SCM_CDR (x)),    const SCM cdr_expr = SCM_CDR (expr);
1801                s_expression, s_undefine);    ASSERT_SYNTAX (SCM_TOP_LEVEL (env), "Bad undefine placement in", expr);
1802    x = SCM_CAR (x);    ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
1803    SCM_ASSYNT (SCM_SYMBOLP (x), s_variable, s_undefine);    ASSERT_SYNTAX (scm_ilength (cdr_expr) == 1, s_expression, expr);
1804    arg1 = scm_sym2var (x, scm_env_top_level (env), SCM_BOOL_F);  
1805    SCM_ASSYNT (!SCM_FALSEP (arg1) && !SCM_UNBNDP (SCM_VARIABLE_REF (arg1)),    variable = SCM_CAR (cdr_expr);
1806                "variable already unbound ", s_undefine);    ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable), s_bad_variable, variable, expr);
1807    SCM_VARIABLE_SET (arg1, SCM_UNDEFINED);    location = scm_sym2var (variable, scm_env_top_level (env), SCM_BOOL_F);
1808  #ifdef SICP    ASSERT_SYNTAX_2 (!SCM_FALSEP (location)
1809    return x;                     && !SCM_UNBNDP (SCM_VARIABLE_REF (location)),
1810  #else                     "variable already unbound ", variable, expr);
1811      SCM_VARIABLE_SET (location, SCM_UNDEFINED);
1812    return SCM_UNSPECIFIED;    return SCM_UNSPECIFIED;
 #endif  
1813  }  }
1814    
1815  #endif  #endif

Legend:
Removed from v.1.333  
changed lines
  Added in v.1.334

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