87 |
|
|
88 |
|
|
89 |
|
|
90 |
|
static SCM canonicalize_define (SCM expr); |
91 |
|
|
92 |
|
|
93 |
|
|
94 |
/* {Syntax Errors} |
/* {Syntax Errors} |
95 |
* |
* |
96 |
* This section defines the message strings for the syntax errors that can be |
* This section defines the message strings for the syntax errors that can be |
861 |
} |
} |
862 |
|
|
863 |
|
|
864 |
SCM_SYNTAX(s_define, "define", scm_i_makbimacro, scm_m_define); |
SCM_SYNTAX (s_define, "define", scm_i_makbimacro, scm_m_define); |
865 |
SCM_GLOBAL_SYMBOL(scm_sym_define, s_define); |
SCM_GLOBAL_SYMBOL (scm_sym_define, s_define); |
866 |
|
|
867 |
/* Guile provides an extension to R5RS' define syntax to represent function |
/* Guile provides an extension to R5RS' define syntax to represent function |
868 |
* currying in a compact way. With this extension, it is allowed to write |
* currying in a compact way. With this extension, it is allowed to write |
883 |
*/ |
*/ |
884 |
/* Dirk:FIXME:: We should provide an implementation for 'define' in the R5RS |
/* Dirk:FIXME:: We should provide an implementation for 'define' in the R5RS |
885 |
* module that does not implement this extension. */ |
* module that does not implement this extension. */ |
886 |
SCM |
static SCM |
887 |
scm_m_define (SCM expr, SCM env) |
canonicalize_define (const SCM expr) |
888 |
{ |
{ |
889 |
SCM body; |
SCM body; |
890 |
SCM variable; |
SCM variable; |
891 |
|
|
892 |
const SCM cdr_expr = SCM_CDR (expr); |
const SCM cdr_expr = SCM_CDR (expr); |
|
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr); |
|
893 |
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 2, s_missing_expression, expr); |
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 2, s_missing_expression, expr); |
894 |
|
|
895 |
body = SCM_CDR (cdr_expr); |
body = SCM_CDR (cdr_expr); |
913 |
ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable), s_bad_variable, variable, expr); |
ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable), s_bad_variable, variable, expr); |
914 |
ASSERT_SYNTAX (scm_ilength (body) == 1, s_expression, expr); |
ASSERT_SYNTAX (scm_ilength (body) == 1, s_expression, expr); |
915 |
|
|
916 |
|
SCM_SETCAR (cdr_expr, variable); |
917 |
|
SCM_SETCDR (cdr_expr, body); |
918 |
|
return expr; |
919 |
|
} |
920 |
|
|
921 |
|
SCM |
922 |
|
scm_m_define (SCM expr, SCM env) |
923 |
|
{ |
924 |
|
SCM canonical_definition; |
925 |
|
SCM cdr_canonical_definition; |
926 |
|
SCM body; |
927 |
|
|
928 |
|
ASSERT_SYNTAX (scm_ilength (expr) >= 0, s_bad_expression, expr); |
929 |
|
|
930 |
|
canonical_definition = canonicalize_define (expr); |
931 |
|
cdr_canonical_definition = SCM_CDR (canonical_definition); |
932 |
|
body = SCM_CDR (cdr_canonical_definition); |
933 |
|
|
934 |
if (SCM_TOP_LEVEL (env)) |
if (SCM_TOP_LEVEL (env)) |
935 |
{ |
{ |
936 |
SCM var; |
SCM var; |
937 |
|
const SCM variable = SCM_CAR (cdr_canonical_definition); |
938 |
const SCM value = scm_eval_car (body, env); |
const SCM value = scm_eval_car (body, env); |
939 |
if (SCM_REC_PROCNAMES_P) |
if (SCM_REC_PROCNAMES_P) |
940 |
{ |
{ |
952 |
} |
} |
953 |
else |
else |
954 |
{ |
{ |
955 |
SCM_SETCAR (expr, SCM_IM_DEFINE); |
SCM_SETCAR (canonical_definition, SCM_IM_DEFINE); |
956 |
SCM_SETCAR (cdr_expr, variable); |
return canonical_definition; |
|
SCM_SETCDR (cdr_expr, body); |
|
|
return expr; |
|
957 |
} |
} |
958 |
} |
} |
959 |
|
|