713 |
} |
} |
714 |
|
|
715 |
|
|
716 |
|
/* The function m_expand_body memoizes a proper list of expressions forming a |
717 |
|
* body. This function takes care of dealing with internal defines and |
718 |
|
* transforming them into an equivalent letrec expression. */ |
719 |
|
|
720 |
|
/* This is a helper function for m_expand_body. It helps to figure out whether |
721 |
|
* an expression denotes a syntactic keyword. */ |
722 |
|
static SCM |
723 |
|
try_macro_lookup (const SCM expr, const SCM env) |
724 |
|
{ |
725 |
|
if (SCM_SYMBOLP (expr)) |
726 |
|
{ |
727 |
|
const SCM tmp_pair = scm_list_1 (expr); |
728 |
|
const SCM value = *scm_lookupcar1 (tmp_pair, env, 0); |
729 |
|
return value; |
730 |
|
} |
731 |
|
else |
732 |
|
{ |
733 |
|
return SCM_UNDEFINED; |
734 |
|
} |
735 |
|
} |
736 |
|
|
737 |
|
/* This is a helper function for m_expand_body. It expands user macros, |
738 |
|
* because for the correct translation of a body we need to know whether they |
739 |
|
* expand to a definition. */ |
740 |
|
static SCM |
741 |
|
expand_user_macros (SCM expr, const SCM env) |
742 |
|
{ |
743 |
|
while (SCM_CONSP (expr)) |
744 |
|
{ |
745 |
|
const SCM car_expr = SCM_CAR (expr); |
746 |
|
const SCM new_car = expand_user_macros (car_expr, env); |
747 |
|
const SCM value = try_macro_lookup (new_car, env); |
748 |
|
|
749 |
|
if (SCM_MACROP (value) && SCM_MACRO_TYPE (value) == 2) |
750 |
|
{ |
751 |
|
/* User macros transform code into code. */ |
752 |
|
expr = scm_call_2 (SCM_MACRO_CODE (value), expr, env); |
753 |
|
/* We need to reiterate on the transformed code. */ |
754 |
|
} |
755 |
|
else |
756 |
|
{ |
757 |
|
/* No user macro: return. */ |
758 |
|
SCM_SETCAR (expr, new_car); |
759 |
|
return expr; |
760 |
|
} |
761 |
|
} |
762 |
|
|
763 |
|
return expr; |
764 |
|
} |
765 |
|
|
766 |
|
/* This is a helper function for m_expand_body. It determines if a given form |
767 |
|
* represents an application of a given built-in macro. The built-in macro to |
768 |
|
* check for is identified by its syntactic keyword. The form is an |
769 |
|
* application of the given macro if looking up the car of the form in the |
770 |
|
* given environment actually returns the built-in macro. */ |
771 |
|
static int |
772 |
|
is_system_macro_p (const SCM syntactic_keyword, const SCM form, const SCM env) |
773 |
|
{ |
774 |
|
if (SCM_CONSP (form)) |
775 |
|
{ |
776 |
|
const SCM car_form = SCM_CAR (form); |
777 |
|
const SCM value = try_macro_lookup (car_form, env); |
778 |
|
if (SCM_BUILTIN_MACRO_P (value)) |
779 |
|
{ |
780 |
|
const SCM macro_name = scm_macro_name (value); |
781 |
|
return SCM_EQ_P (macro_name, syntactic_keyword); |
782 |
|
} |
783 |
|
} |
784 |
|
|
785 |
|
return 0; |
786 |
|
} |
787 |
|
|
788 |
|
static SCM |
789 |
|
m_expand_body (const SCM forms, const SCM env) |
790 |
|
{ |
791 |
|
/* The first body form can be skipped since it is known to be the ISYM that |
792 |
|
* was prepended to the body by m_body. */ |
793 |
|
SCM cdr_forms = SCM_CDR (forms); |
794 |
|
SCM form_idx = cdr_forms; |
795 |
|
SCM definitions = SCM_EOL; |
796 |
|
SCM sequence = SCM_EOL; |
797 |
|
|
798 |
|
/* According to R5RS, the list of body forms consists of two parts: a number |
799 |
|
* (maybe zero) of definitions, followed by a non-empty sequence of |
800 |
|
* expressions. Each the definitions and the expressions may be grouped |
801 |
|
* arbitrarily with begin, but it is not allowed to mix definitions and |
802 |
|
* expressions. The task of the following loop therefore is to split the |
803 |
|
* list of body forms into the list of definitions and the sequence of |
804 |
|
* expressions. */ |
805 |
|
while (!SCM_NULLP (form_idx)) |
806 |
|
{ |
807 |
|
const SCM form = SCM_CAR (form_idx); |
808 |
|
const SCM new_form = expand_user_macros (form, env); |
809 |
|
if (is_system_macro_p (scm_sym_define, new_form, env)) |
810 |
|
{ |
811 |
|
definitions = scm_cons (new_form, definitions); |
812 |
|
form_idx = SCM_CDR (form_idx); |
813 |
|
} |
814 |
|
else if (is_system_macro_p (scm_sym_begin, new_form, env)) |
815 |
|
{ |
816 |
|
/* We have encountered a group of forms. This has to be either a |
817 |
|
* (possibly empty) group of (possibly further grouped) definitions, |
818 |
|
* or a non-empty group of (possibly further grouped) |
819 |
|
* expressions. */ |
820 |
|
const SCM grouped_forms = SCM_CDR (new_form); |
821 |
|
unsigned int found_definition = 0; |
822 |
|
unsigned int found_expression = 0; |
823 |
|
SCM grouped_form_idx = grouped_forms; |
824 |
|
while (!found_expression && !SCM_NULLP (grouped_form_idx)) |
825 |
|
{ |
826 |
|
const SCM inner_form = SCM_CAR (grouped_form_idx); |
827 |
|
const SCM new_inner_form = expand_user_macros (inner_form, env); |
828 |
|
if (is_system_macro_p (scm_sym_define, new_inner_form, env)) |
829 |
|
{ |
830 |
|
found_definition = 1; |
831 |
|
definitions = scm_cons (new_inner_form, definitions); |
832 |
|
grouped_form_idx = SCM_CDR (grouped_form_idx); |
833 |
|
} |
834 |
|
else if (is_system_macro_p (scm_sym_begin, new_inner_form, env)) |
835 |
|
{ |
836 |
|
const SCM inner_group = SCM_CDR (new_inner_form); |
837 |
|
grouped_form_idx |
838 |
|
= scm_append (scm_list_2 (inner_group, |
839 |
|
SCM_CDR (grouped_form_idx))); |
840 |
|
} |
841 |
|
else |
842 |
|
{ |
843 |
|
/* The group marks the start of the expressions of the body. |
844 |
|
* We have to make sure that within the same group we have |
845 |
|
* not encountered a definition before. */ |
846 |
|
ASSERT_SYNTAX (!found_definition, s_mixed_body_forms, form); |
847 |
|
found_expression = 1; |
848 |
|
grouped_form_idx = SCM_EOL; |
849 |
|
} |
850 |
|
} |
851 |
|
|
852 |
|
/* We have finished processing the group. If we have not yet |
853 |
|
* encountered an expression we continue processing the forms of the |
854 |
|
* body to collect further definition forms. Otherwise, the group |
855 |
|
* marks the start of the sequence of expressions of the body. */ |
856 |
|
if (!found_expression) |
857 |
|
{ |
858 |
|
form_idx = SCM_CDR (form_idx); |
859 |
|
} |
860 |
|
else |
861 |
|
{ |
862 |
|
sequence = form_idx; |
863 |
|
form_idx = SCM_EOL; |
864 |
|
} |
865 |
|
} |
866 |
|
else |
867 |
|
{ |
868 |
|
/* We have detected a form which is no definition. This marks the |
869 |
|
* start of the sequence of expressions of the body. */ |
870 |
|
sequence = form_idx; |
871 |
|
form_idx = SCM_EOL; |
872 |
|
} |
873 |
|
} |
874 |
|
|
875 |
|
/* FIXME: forms does not hold information about the file location. */ |
876 |
|
ASSERT_SYNTAX (SCM_CONSP (sequence), s_missing_body_expression, cdr_forms); |
877 |
|
|
878 |
|
if (!SCM_NULLP (definitions)) |
879 |
|
{ |
880 |
|
SCM definition_idx; |
881 |
|
SCM letrec_tail; |
882 |
|
SCM letrec_expression; |
883 |
|
SCM new_letrec_expression; |
884 |
|
SCM new_body; |
885 |
|
|
886 |
|
SCM bindings = SCM_EOL; |
887 |
|
for (definition_idx = definitions; |
888 |
|
!SCM_NULLP (definition_idx); |
889 |
|
definition_idx = SCM_CDR (definition_idx)) |
890 |
|
{ |
891 |
|
const SCM definition = SCM_CAR (definition_idx); |
892 |
|
const SCM canonical_definition = canonicalize_define (definition); |
893 |
|
const SCM binding = SCM_CDR (canonical_definition); |
894 |
|
bindings = scm_cons (binding, bindings); |
895 |
|
}; |
896 |
|
|
897 |
|
letrec_tail = scm_cons (bindings, sequence); |
898 |
|
/* FIXME: forms does not hold information about the file location. */ |
899 |
|
letrec_expression = scm_cons_source (forms, scm_sym_letrec, letrec_tail); |
900 |
|
new_letrec_expression = scm_m_letrec (letrec_expression, env); |
901 |
|
new_body = scm_list_1 (new_letrec_expression); |
902 |
|
return new_body; |
903 |
|
} |
904 |
|
else |
905 |
|
{ |
906 |
|
SCM_SETCAR (forms, SCM_CAR (sequence)); |
907 |
|
SCM_SETCDR (forms, SCM_CDR (sequence)); |
908 |
|
return forms; |
909 |
|
} |
910 |
|
} |
911 |
|
|
912 |
|
#if (SCM_ENABLE_DEPRECATED == 1) |
913 |
|
|
914 |
|
/* Deprecated in guile 1.7.0 on 2003-11-09. */ |
915 |
|
SCM |
916 |
|
scm_m_expand_body (SCM exprs, SCM env) |
917 |
|
{ |
918 |
|
scm_c_issue_deprecation_warning |
919 |
|
("`scm_m_expand_body' is deprecated."); |
920 |
|
return m_expand_body (exprs, env); |
921 |
|
} |
922 |
|
|
923 |
|
#endif |
924 |
|
|
925 |
|
|
926 |
/* Start of the memoizers for the standard R5RS builtin macros. */ |
/* Start of the memoizers for the standard R5RS builtin macros. */ |
927 |
|
|
928 |
|
|
2044 |
} |
} |
2045 |
|
|
2046 |
#endif |
#endif |
|
|
|
|
|
|
|
/* The function m_expand_body memoizes a proper list of expressions forming a |
|
|
* body. This function takes care of dealing with internal defines and |
|
|
* transforming them into an equivalent letrec expression. */ |
|
|
|
|
|
/* This is a helper function for m_expand_body. It helps to figure out whether |
|
|
* an expression denotes a syntactic keyword. */ |
|
|
static SCM |
|
|
try_macro_lookup (const SCM expr, const SCM env) |
|
|
{ |
|
|
if (SCM_SYMBOLP (expr)) |
|
|
{ |
|
|
const SCM tmp_pair = scm_list_1 (expr); |
|
|
const SCM value = *scm_lookupcar1 (tmp_pair, env, 0); |
|
|
return value; |
|
|
} |
|
|
else |
|
|
{ |
|
|
return SCM_UNDEFINED; |
|
|
} |
|
|
} |
|
|
|
|
|
/* This is a helper function for m_expand_body. It expands user macros, |
|
|
* because for the correct translation of a body we need to know whether they |
|
|
* expand to a definition. */ |
|
|
static SCM |
|
|
expand_user_macros (SCM expr, const SCM env) |
|
|
{ |
|
|
while (SCM_CONSP (expr)) |
|
|
{ |
|
|
const SCM car_expr = SCM_CAR (expr); |
|
|
const SCM new_car = expand_user_macros (car_expr, env); |
|
|
const SCM value = try_macro_lookup (new_car, env); |
|
|
|
|
|
if (SCM_MACROP (value) && SCM_MACRO_TYPE (value) == 2) |
|
|
{ |
|
|
/* User macros transform code into code. */ |
|
|
expr = scm_call_2 (SCM_MACRO_CODE (value), expr, env); |
|
|
/* We need to reiterate on the transformed code. */ |
|
|
} |
|
|
else |
|
|
{ |
|
|
/* No user macro: return. */ |
|
|
SCM_SETCAR (expr, new_car); |
|
|
return expr; |
|
|
} |
|
|
} |
|
|
|
|
|
return expr; |
|
|
} |
|
|
|
|
|
/* This is a helper function for m_expand_body. It determines if a given form |
|
|
* represents an application of a given built-in macro. The built-in macro to |
|
|
* check for is identified by its syntactic keyword. The form is an |
|
|
* application of the given macro if looking up the car of the form in the |
|
|
* given environment actually returns the built-in macro. */ |
|
|
static int |
|
|
is_system_macro_p (const SCM syntactic_keyword, const SCM form, const SCM env) |
|
|
{ |
|
|
if (SCM_CONSP (form)) |
|
|
{ |
|
|
const SCM car_form = SCM_CAR (form); |
|
|
const SCM value = try_macro_lookup (car_form, env); |
|
|
if (SCM_BUILTIN_MACRO_P (value)) |
|
|
{ |
|
|
const SCM macro_name = scm_macro_name (value); |
|
|
return SCM_EQ_P (macro_name, syntactic_keyword); |
|
|
} |
|
|
} |
|
|
|
|
|
return 0; |
|
|
} |
|
|
|
|
|
static SCM |
|
|
m_expand_body (const SCM forms, const SCM env) |
|
|
{ |
|
|
/* The first body form can be skipped since it is known to be the ISYM that |
|
|
* was prepended to the body by m_body. */ |
|
|
SCM cdr_forms = SCM_CDR (forms); |
|
|
SCM form_idx = cdr_forms; |
|
|
SCM definitions = SCM_EOL; |
|
|
SCM sequence = SCM_EOL; |
|
|
|
|
|
/* According to R5RS, the list of body forms consists of two parts: a number |
|
|
* (maybe zero) of definitions, followed by a non-empty sequence of |
|
|
* expressions. Each the definitions and the expressions may be grouped |
|
|
* arbitrarily with begin, but it is not allowed to mix definitions and |
|
|
* expressions. The task of the following loop therefore is to split the |
|
|
* list of body forms into the list of definitions and the sequence of |
|
|
* expressions. */ |
|
|
while (!SCM_NULLP (form_idx)) |
|
|
{ |
|
|
const SCM form = SCM_CAR (form_idx); |
|
|
const SCM new_form = expand_user_macros (form, env); |
|
|
if (is_system_macro_p (scm_sym_define, new_form, env)) |
|
|
{ |
|
|
definitions = scm_cons (new_form, definitions); |
|
|
form_idx = SCM_CDR (form_idx); |
|
|
} |
|
|
else if (is_system_macro_p (scm_sym_begin, new_form, env)) |
|
|
{ |
|
|
/* We have encountered a group of forms. This has to be either a |
|
|
* (possibly empty) group of (possibly further grouped) definitions, |
|
|
* or a non-empty group of (possibly further grouped) |
|
|
* expressions. */ |
|
|
const SCM grouped_forms = SCM_CDR (new_form); |
|
|
unsigned int found_definition = 0; |
|
|
unsigned int found_expression = 0; |
|
|
SCM grouped_form_idx = grouped_forms; |
|
|
while (!found_expression && !SCM_NULLP (grouped_form_idx)) |
|
|
{ |
|
|
const SCM inner_form = SCM_CAR (grouped_form_idx); |
|
|
const SCM new_inner_form = expand_user_macros (inner_form, env); |
|
|
if (is_system_macro_p (scm_sym_define, new_inner_form, env)) |
|
|
{ |
|
|
found_definition = 1; |
|
|
definitions = scm_cons (new_inner_form, definitions); |
|
|
grouped_form_idx = SCM_CDR (grouped_form_idx); |
|
|
} |
|
|
else if (is_system_macro_p (scm_sym_begin, new_inner_form, env)) |
|
|
{ |
|
|
const SCM inner_group = SCM_CDR (new_inner_form); |
|
|
grouped_form_idx |
|
|
= scm_append (scm_list_2 (inner_group, |
|
|
SCM_CDR (grouped_form_idx))); |
|
|
} |
|
|
else |
|
|
{ |
|
|
/* The group marks the start of the expressions of the body. |
|
|
* We have to make sure that within the same group we have |
|
|
* not encountered a definition before. */ |
|
|
ASSERT_SYNTAX (!found_definition, s_mixed_body_forms, form); |
|
|
found_expression = 1; |
|
|
grouped_form_idx = SCM_EOL; |
|
|
} |
|
|
} |
|
|
|
|
|
/* We have finished processing the group. If we have not yet |
|
|
* encountered an expression we continue processing the forms of the |
|
|
* body to collect further definition forms. Otherwise, the group |
|
|
* marks the start of the sequence of expressions of the body. */ |
|
|
if (!found_expression) |
|
|
{ |
|
|
form_idx = SCM_CDR (form_idx); |
|
|
} |
|
|
else |
|
|
{ |
|
|
sequence = form_idx; |
|
|
form_idx = SCM_EOL; |
|
|
} |
|
|
} |
|
|
else |
|
|
{ |
|
|
/* We have detected a form which is no definition. This marks the |
|
|
* start of the sequence of expressions of the body. */ |
|
|
sequence = form_idx; |
|
|
form_idx = SCM_EOL; |
|
|
} |
|
|
} |
|
|
|
|
|
/* FIXME: forms does not hold information about the file location. */ |
|
|
ASSERT_SYNTAX (SCM_CONSP (sequence), s_missing_body_expression, cdr_forms); |
|
|
|
|
|
if (!SCM_NULLP (definitions)) |
|
|
{ |
|
|
SCM definition_idx; |
|
|
SCM letrec_tail; |
|
|
SCM letrec_expression; |
|
|
SCM new_letrec_expression; |
|
|
SCM new_body; |
|
|
|
|
|
SCM bindings = SCM_EOL; |
|
|
for (definition_idx = definitions; |
|
|
!SCM_NULLP (definition_idx); |
|
|
definition_idx = SCM_CDR (definition_idx)) |
|
|
{ |
|
|
const SCM definition = SCM_CAR (definition_idx); |
|
|
const SCM canonical_definition = canonicalize_define (definition); |
|
|
const SCM binding = SCM_CDR (canonical_definition); |
|
|
bindings = scm_cons (binding, bindings); |
|
|
}; |
|
|
|
|
|
letrec_tail = scm_cons (bindings, sequence); |
|
|
/* FIXME: forms does not hold information about the file location. */ |
|
|
letrec_expression = scm_cons_source (forms, scm_sym_letrec, letrec_tail); |
|
|
new_letrec_expression = scm_m_letrec (letrec_expression, env); |
|
|
new_body = scm_list_1 (new_letrec_expression); |
|
|
return new_body; |
|
|
} |
|
|
else |
|
|
{ |
|
|
SCM_SETCAR (forms, SCM_CAR (sequence)); |
|
|
SCM_SETCDR (forms, SCM_CDR (sequence)); |
|
|
return forms; |
|
|
} |
|
|
} |
|
|
|
|
|
#if (SCM_ENABLE_DEPRECATED == 1) |
|
|
|
|
|
/* Deprecated in guile 1.7.0 on 2003-11-09. */ |
|
|
SCM |
|
|
scm_m_expand_body (SCM exprs, SCM env) |
|
|
{ |
|
|
scm_c_issue_deprecation_warning |
|
|
("`scm_m_expand_body' is deprecated."); |
|
|
return m_expand_body (exprs, env); |
|
|
} |
|
|
|
|
|
#endif |
|
2047 |
|
|
2048 |
|
|
2049 |
SCM |
SCM |