From c08daf0b459729d16ac60a565bd6fa974cb01f2e Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Wed, 17 Feb 2021 19:31:38 -0800 Subject: compiler: use pattern matching for function form * share/txr/stdlib/compiler.tl (compiler comp-fun-form): Rewritten more compactly and extensibly using match-case. --- share/txr/stdlib/compiler.tl | 18 +++++++----------- 1 file changed, 7 insertions(+), 11 deletions(-) diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index b283a0c8..3d69469b 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -1155,18 +1155,14 @@ me.(compile oreg env (expand qexp)))) (defmeth compiler comp-fun-form (me oreg env form) + (match-case form + ((@(@bin [%bin-op% @sym]) @a @b) + (set form ^(,bin ,a ,b))) + ((- @a) + (set form ^(neg ,a))) + ((@(or identity + * min max) @a) + (return-from comp-fun-form me.(compile oreg env a)))) (tree-bind (sym . args) form - (cond - ((= (len args) 2) - (iflet ((bin [%bin-op% sym])) - (set sym bin - form (cons sym args)))) - ((= (len args) 1) - (caseq sym - (- (set sym 'neg - form (cons sym args))) - ((identity + * min max) (return-from comp-fun-form - me.(compile oreg env (car args))))))) (let* ((fbind env.(lookup-fun sym t)) (cfrag me.(comp-call-impl oreg env (if fbind 'call 'gcall) (if fbind fbind.loc me.(get-sidx sym)) -- cgit v1.2.3