diff options
| -rw-r--r-- | gcc/ChangeLog.MELT | 8 | ||||
| -rw-r--r-- | gcc/melt/warmelt-genobj.melt | 16 | ||||
| -rw-r--r-- | gcc/melt/warmelt-macro.melt | 32 | ||||
| -rw-r--r-- | gcc/melt/warmelt-normal.melt | 4 | ||||
| -rw-r--r-- | gcc/testsuite/melt/tfunmatch-1.melt | 11 |
5 files changed, 66 insertions, 5 deletions
diff --git a/gcc/ChangeLog.MELT b/gcc/ChangeLog.MELT index 7ee2d15bfd4..3389a2a2062 100644 --- a/gcc/ChangeLog.MELT +++ b/gcc/ChangeLog.MELT @@ -1,5 +1,13 @@ 2009-05-15 Basile Starynkevitch <basile@starynkevitch.net> + [funmatcher-s still incomplete] + * testsuite/melt/tfunmatch-1.melt: more and better debug messages. + * melt/warmelt-macro.melt: still incomplete patternexpand_expr for + funmatchers + * melt/warmelt-normal.melt: more in normexp_defunmatcher. + * melt/warmelt-genobj.melt: unimplemented compilmatcher_funmatcher. + +2009-05-15 Basile Starynkevitch <basile@starynkevitch.net> * basilys.h (basilysgc_new_subseq_multiple): added declaration. * basilys.c (basilysgc_new_subseq_multiple): added function. * melt/warmelt-first.melt: added subseq_multiple primitive. diff --git a/gcc/melt/warmelt-genobj.melt b/gcc/melt/warmelt-genobj.melt index 6dd6a8a233a..3dd5715c053 100644 --- a/gcc/melt/warmelt-genobj.melt +++ b/gcc/melt/warmelt-genobj.melt @@ -4575,6 +4575,22 @@ ))) (install_method class_cmatcher compile_matcher compilmatcher_cmatcher) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun compilmatcher_funmatcher (fmat mcx gcx) + (debug_msg fmat "compilmatcher_funmatcher cmat") + (debug_msg mcx "compilmatcher_funmatcher mcx") + (assert_msg "check fmat" (is_a fmat class_funmatcher)) + (assert_msg "check mcx" (is_a mcx class_matchcompilcontext)) + (assert_msg "check gcx" (is_a gcx class_genercontext)) + (let ( + (fmins (unsafe_get_field :amatch_in fmat)) + (fmbind (unsafe_get_field :amatch_matchbind fmat)) + (fmouts (unsafe_get_field :amatch_out fmat)) + ) + (assert_msg "@$@unimplemented compilmatcher_funmatcher" ()) + (compile_warning "@$@unimplemented compilmatcher_funmatcher" ()) + )) +(install_method class_funmatcher compile_matcher compilmatcher_funmatcher) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; eof warmelt-genobj.melt diff --git a/gcc/melt/warmelt-macro.melt b/gcc/melt/warmelt-macro.melt index 46cd985e67d..4fd004c1c27 100644 --- a/gcc/melt/warmelt-macro.melt +++ b/gcc/melt/warmelt-macro.melt @@ -1015,6 +1015,33 @@ (debug_msg pcomp "patternexpand_expr cmatcher return pcomp") (return pcomp) )))) + ;; funmatcher binding + ( (is_a opbind class_funmatcher_binding) + (let ( (fmat (unsafe_get_field :fmbind_funmatcher opbind)) + (defm (unsafe_get_field :fmbind_defunmatcher opbind)) + ) + (debug_msg fmat "patternexpand_expr funmatcher fmat") + (debug_msg defm "patternexpand_expr funmatcher defm") + (debug_msg opbind "patternexpand_expr funmatcher opbind") + (assert_msg "check fmat-cher" (is_a fmat class_funmatcher)) + (multicall + (args pats) + (patmacexpand_for_matcher (pair_tail curpair) fmat env sloc pctx) + (debug_msg args "patternexpand_expr funmatcher args") + (debug_msg pats "patternexpand_expr funmatcher pats") + ;; maybe we should transmit to the pcomp something from + ;; the defunmatcher, eg the name or expression of the + ;; matching function + (compile_warning "patternexpand_expr funmatcher perhaps we should have more of the defunmatcher..." ()) + (let ( (pcomp (instance class_srcpattern_funmatch + :src_loc sloc + :spac_operator fmat + :spac_inargs args + :spac_outargs pats + )) ) + (debug_msg pcomp "patternexpand_expr funmatcher return pcomp") + (return pcomp) + )))) ;; imported values ( (is_a opbind class_value_binding) (let ( (opval (unsafe_get_field :vbind_value opbind)) ) @@ -1035,6 +1062,11 @@ (debug_msg pcomp "patternexpand_expr cmatcher value pcomp") (return pcomp) ))) + ( (is_a opval class_funmatcher) + (debug_msg opval "patternexpand_expr funmatcher value opval") + (compile_warning "@$@unimplemented patternexpand_expr imported funmatcher" ()) + (assert_msg "@$@unimplemented patternexpand_expr imported funmatcher" ()) + ) (:else (error_strv sloc "invalid pattern operator value" opnam) (return))))) diff --git a/gcc/melt/warmelt-normal.melt b/gcc/melt/warmelt-normal.melt index 77c41569efd..abf40ff4d3d 100644 --- a/gcc/melt/warmelt-normal.melt +++ b/gcc/melt/warmelt-normal.melt @@ -3962,6 +3962,10 @@ :fmatch_applyf () :fmatch_data () )) + (fmbind (let ( (b (find_env env sname)) ) + (debug_msg b "normexp_defunmatcher fmbind") + (assert_msg "check fmbind" (is_a b class_funmatcher_binding)) + b)) ) (assert_msg "check smatched" (is_a smatched class_formal_binding)) (assert_msg "check sins" (is_multiple sins)) diff --git a/gcc/testsuite/melt/tfunmatch-1.melt b/gcc/testsuite/melt/tfunmatch-1.melt index bb427645a7d..21f7c8536c0 100644 --- a/gcc/testsuite/melt/tfunmatch-1.melt +++ b/gcc/testsuite/melt/tfunmatch-1.melt @@ -15,7 +15,7 @@ ;; n is the input ;; result is non-nil when matching, and secondary result is the submatched (defun matchbiggereven (fmat :long m :long n) - (debug_msg fmat "matchbiggereven start") + (debug_msg fmat "matchbiggereven start fmat=") (messagenum_dbg "matchbiggereven m=" m) (messagenum_dbg "matchbiggereven n=" n) (if (== (%iraw m 2) 0) @@ -25,7 +25,7 @@ (debug_msg fmat "matchbiggereven success") (return fmat h) ))) - (debug_msg fmat "matchbiggereven fail") + (debug_msg fmat "matchbiggereven fail fmat=") (return) ) @@ -45,11 +45,12 @@ (defun tfunmatch (o :long x) - (debug_msg o "start tfunmatch") + (debug_msg o "start tfunmatch o=") + (messagenum_dbg "start tfunmatch x=" x) (match x (?(isbiggereven 2 ?u) - (debug_msg o "tfunmatch isbiggereven 2") - (messagenum_dbg "tfunmatch isbiggereven u" u) + (debug_msg o "tfunmatch isbiggereven matched 2 o=") + (messagenum_dbg "tfunmatch isbiggereven matched u=" u) ) (?_ (debug_msg o "tfunmatch not isbiggereven 2"))) |