From b056872535dd339fc9f8080f902fd318756d8849 Mon Sep 17 00:00:00 2001 From: bstarynk Date: Fri, 10 Oct 2014 14:14:02 +0000 Subject: 2014-10-10 Basile Starynkevitch {{t-treecode does not work yet}} * testsuite/melt/t-treecode.melt: Improved, but does not work. * melt/warmelt-macro.melt (check_c_expansion): Accepts a message argument. (mexpand_defciterator, mexpand_defcmatcher): Gives a reason. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@216085 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/melt/warmelt-macro.melt | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) (limited to 'gcc/melt/warmelt-macro.melt') diff --git a/gcc/melt/warmelt-macro.melt b/gcc/melt/warmelt-macro.melt index d21d4433093..0d3aeefbfe9 100644 --- a/gcc/melt/warmelt-macro.melt +++ b/gcc/melt/warmelt-macro.melt @@ -2909,26 +2909,30 @@ the object-map for pattern variables. $PCTX_MODCTX is the module context.}# ;; utility to check that a C expansion has good symbols; every symbol ;; should be in the substitution map -(defun check_c_expansion (etuple loc substmap) - (debug "check_c_expansion etuple" etuple) - (debug "check_c_expansion loc" loc) +(defun check_c_expansion (etuple loc substmap :cstring msg) + (debug "check_c_expansion" " etuple=" etuple " loc=" loc " substmap=" substmap " msg=" msg) + (shortbacktrace_dbg "check_c_expansion" 15) (foreach_in_multiple (etuple) (ecomp :long ix) + (debug "check_c_expansion" " ecomp=" ecomp " #ix=" ix) (cond ( (null ecomp) - (error_at loc "null component in C expansion")) + (error_at loc "null component in C expansion") + (void) + ) ( (is_a ecomp class_keyword) - (debug "check_c_expansion keyword ecomp" ecomp) - (error_at loc "unexpected keyword $1 in C expansion" - (unsafe_get_field :named_name ecomp)) + (debug "check_c_expansion" " keyword ecomp" ecomp) + (error_at loc "unexpected keyword $1 in C expansion, $2" + (unsafe_get_field :named_name ecomp) msg) ) ( (is_a ecomp class_symbol) (if (null (mapobject_get substmap ecomp)) (progn - (debug "check_c_expansion ecomp" ecomp) - (error_at loc "unexpected symbol $1 in C expansion" - (unsafe_get_field :named_name ecomp)))) + (debug "check_c_expansion" " ecomp" ecomp) + (error_at loc "unexpected symbol $1 in C expansion, $2" + (unsafe_get_field :named_name ecomp) msg) + )) () ) ( (is_string ecomp) @@ -3234,8 +3238,8 @@ $CLASS_PRIMITIVE_BINDING and the $CODE_CHUNK macro.}# ) (assert_msg "check local curlbind" (is_a curlbind class_any_binding) curlbind) (mapobject_put substmap (get_field :binder curlbind) curlbind)) ;;; check the expansions - (check_c_expansion expbef loc substmap) - (check_c_expansion expaft loc substmap) + (check_c_expansion expbef loc substmap "DEFCITERATOR before") + (check_c_expansion expaft loc substmap "DEFCITERATOR after") ;; fill the citerator binding (unsafe_put_fields citbind :cbind_citerdef srcit) (put_env env citbind) @@ -3428,9 +3432,9 @@ $EXPORT_VALUES. See also $CLASS_CITERATOR. }#) (assert_msg "check output curbind" (is_a curobind class_formal_binding) curobind) (mapobject_put substmap (get_field :binder curobind) curobind)) ;; check the expansions - (check_c_expansion exptest loc substmap) - (check_c_expansion expfill loc substmap) - (check_c_expansion expoper loc substmap) + (check_c_expansion exptest loc substmap "DEFCMATCHER test") + (check_c_expansion expfill loc substmap "DEFCMATCHER fill") + (check_c_expansion expoper loc substmap "DEFCMATCHER operation") (debug "mexpand_defcmatcher sdefcmatch" sdefcmatch) (put_env env cmbind) (debug "mexpand_defcmatcher registering device sdefcmatch=" sdefcmatch " cmatch=" cmatch) -- cgit v1.2.1