From 93cbd81f0fb5242bb93062848826bf5b6b5e9d46 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Wed, 18 Apr 2018 06:18:02 -0700 Subject: compiler: de-duplicate switch. * share/txr/stdlib/compiler.tl (compiler comp-switch): Identify duplicate cases and don't generate code for these; patch their table entries to point to one case. The case macros generate such code when the keys are integers, and multiple integer keys are associated with the same case: (caseq x ((1 2 3 4 5) ...) ((6 7) ...)). --- share/txr/stdlib/compiler.tl | 29 ++++++++++++++++++----------- 1 file changed, 18 insertions(+), 11 deletions(-) (limited to 'share') diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index 8b705835..5d68e0f5 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -480,21 +480,28 @@ (clabels (mapcar (ret (gensym "l")) cases)) (treg me.(maybe-alloc-treg oreg)) (ifrag me.(compile treg env idx-form)) + (seen (unless shared (hash :eql-based))) last-cfrag (cfrags (collect-each ((cs cases) (lb clabels) (i (range 1))) - (let ((cfrag me.(comp-progn oreg env cs))) - (when (eq i ncases) - (set last-cfrag cfrag)) - (new (frag oreg - ^(,lb - ,*cfrag.code - ,*(unless shared - ^(,*(maybe-mov oreg cfrag.oreg) - ,*(unless (= i ncases) - ^((jmp ,lend)))))) - cfrag.fvars cfrag.ffuns)))))) + (iflet ((seen-lb (and seen [seen cs]))) + (progn + (set [clabels (pred i)] seen-lb) + (new (frag oreg nil))) + (let ((cfrag me.(comp-progn oreg env cs))) + (when (eq i ncases) + (set last-cfrag cfrag)) + (unless shared + (set [seen cs] lb)) + (new (frag oreg + ^(,lb + ,*cfrag.code + ,*(unless shared + ^(,*(maybe-mov oreg cfrag.oreg) + ,*(unless (= i ncases) + ^((jmp ,lend)))))) + cfrag.fvars cfrag.ffuns))))))) me.(maybe-free-treg treg oreg) (new (frag oreg ^(,*ifrag.code -- cgit v1.2.3