/[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.343 by dirk, Sat Nov 15 12:27:53 2003 UTC revision 1.344 by dirk, Sat Nov 15 12:43:00 2003 UTC
# Line 713  m_body (SCM op, SCM exprs) Line 713  m_body (SCM op, SCM exprs)
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    
# Line 1834  scm_m_undefine (SCM expr, SCM env) Line 2044  scm_m_undefine (SCM expr, SCM env)
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

Legend:
Removed from v.1.343  
changed lines
  Added in v.1.344

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