[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 13/25: Convert emit-linear-dispatch to use match
From: |
Andy Wingo |
Subject: |
[Guile-commits] 13/25: Convert emit-linear-dispatch to use match |
Date: |
Mon, 19 Jan 2015 10:41:10 +0000 |
wingo pushed a commit to branch wip-goops-refactor
in repository guile.
commit feada76395cb7ea82539435ab23dc77ec6fc850e
Author: Andy Wingo <address@hidden>
Date: Wed Jan 14 20:43:35 2015 +0100
Convert emit-linear-dispatch to use match
* module/oop/goops.scm (emit-linear-dispatch): Convert to use `match'.
---
module/oop/goops.scm | 65 +++++++++++++++++++++++++------------------------
1 files changed, 33 insertions(+), 32 deletions(-)
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 75ce409..80bd115 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -950,44 +950,45 @@ followed by its associated value. If @var{l} does not
hold a value for
,(if rest?
`(cons* ,@args rest)
`(list ,@args)))))
- (cond
- ((null? methods)
+ (match methods
+ (()
(values `(,(if rest? `(,@args . rest) args)
(let ,(map (lambda (t a)
`(,t (class-of ,a)))
types args)
,exp))
free))
- (else
- ;; jeez
- (let preddy ((free free)
- (types types)
- (specs (vector-ref (car methods) 1))
- (checks '()))
- (if (null? types)
- (let ((m-sym (gensym "p")))
- (lp (cdr methods)
- (acons (vector-ref (car methods) 3)
- m-sym
- free)
- `(if (and . ,checks)
- ,(if rest?
- `(apply ,m-sym ,@args rest)
- `(,m-sym . ,args))
- ,exp)))
- (let ((var (assq-ref free (car specs))))
- (if var
- (preddy free
- (cdr types)
- (cdr specs)
- (cons `(eq? ,(car types) ,var)
- checks))
- (let ((var (gensym "c")))
- (preddy (acons (car specs) var free)
- (cdr types)
- (cdr specs)
- (cons `(eq? ,(car types) ,var)
- checks))))))))))))
+ ((#(_ specs _ cmethod) . methods)
+ (let build-dispatch ((free free)
+ (types types)
+ (specs specs)
+ (checks '()))
+ (match types
+ (()
+ (let ((m-sym (gensym "p")))
+ (lp methods
+ (acons cmethod m-sym free)
+ `(if (and . ,checks)
+ ,(if rest?
+ `(apply ,m-sym ,@args rest)
+ `(,m-sym . ,args))
+ ,exp))))
+ ((type . types)
+ (match specs
+ ((spec . specs)
+ (let ((var (assq-ref free spec)))
+ (if var
+ (build-dispatch free
+ types
+ specs
+ (cons `(eq? ,type ,var)
+ checks))
+ (let ((var (gensym "c")))
+ (build-dispatch (acons spec var free)
+ types
+ specs
+ (cons `(eq? ,type ,var)
+ checks)))))))))))))))
(define (compute-dispatch-procedure gf cache)
(define (scan)
- [Guile-commits] 01/25: GOOPS cleanup to use SRFI-1 better, (continued)
- [Guile-commits] 01/25: GOOPS cleanup to use SRFI-1 better, Andy Wingo, 2015/01/19
- [Guile-commits] 02/25: append-map rather than mapappend, Andy Wingo, 2015/01/19
- [Guile-commits] 03/25: GOOPS utils module cleanups, Andy Wingo, 2015/01/19
- [Guile-commits] 04/25: Fold (oop goops util) into (oop goops), Andy Wingo, 2015/01/19
- [Guile-commits] 05/25: Scheme GOOPS cleanups, Andy Wingo, 2015/01/19
- [Guile-commits] 07/25: scm_make cleanup, Andy Wingo, 2015/01/19
- [Guile-commits] 06/25: Add compute-cpl tests, Andy Wingo, 2015/01/19
- [Guile-commits] 09/25: Commenting in goops.scm, Andy Wingo, 2015/01/19
- [Guile-commits] 08/25: Narrative reordering in goops.scm, Andy Wingo, 2015/01/19
- [Guile-commits] 11/25: when and unless for one-armed ifs in goops.scm, Andy Wingo, 2015/01/19
- [Guile-commits] 13/25: Convert emit-linear-dispatch to use match,
Andy Wingo <=
- [Guile-commits] 14/25: `match' refactor in goops.scm, Andy Wingo, 2015/01/19
- [Guile-commits] 15/25: GOOPS class slot indices defined as inline values, Andy Wingo, 2015/01/19
- [Guile-commits] 10/25: More GOOPS comments, Andy Wingo, 2015/01/19
- [Guile-commits] 17/25: slot-ref, slot-set! et al bypass "using-class" variants, Andy Wingo, 2015/01/19
- [Guile-commits] 18/25: change-object-class refactor, Andy Wingo, 2015/01/19
- [Guile-commits] 19/25: GOOPS: Deprecate "using-class" procs like slot-ref-using-class, Andy Wingo, 2015/01/19
- [Guile-commits] 12/25: More GOOPS cleanups, Andy Wingo, 2015/01/19
- [Guile-commits] 20/25: The GOOPS "unbound" value is a unique pair, Andy Wingo, 2015/01/19
- [Guile-commits] 16/25: Manipulate GOOPS vtable flags from Scheme, for speed, Andy Wingo, 2015/01/19
- [Guile-commits] 21/25: Beginnings of <slot> slot definition class, Andy Wingo, 2015/01/19