Changeset 35285 in project


Ignore:
Timestamp:
03/14/18 11:30:54 (20 months ago)
Author:
juergen
Message:

generics 0.2.1 with simplyfied dispatcher for trees of depth one

Location:
release/4/generics
Files:
2 edited
4 copied

Legend:

Unmodified
Added
Removed
  • release/4/generics/tags/0.2.1/generics.scm

    r35271 r35285  
    542542               ((exn) #f)))))))
    543543
    544 ;;; (define-selector name?? parent?? pred)
    545 ;;; --------------------------------------
     544;;; (define-selector (name?? parent?? pred))
     545;;; ----------------------------------------
    546546;;; defines a special predicate, name??,
    547547;;; from its base predicate, pred,
     
    696696      "not enough arguments"
    697697      args)
    698     ;; backtracking is organized by storing the
    699     ;; backtrack trees in a vector and manipulating
    700     ;; that vector
    701     (let ((trees (make-vector (1+ depth) #f))
    702           (vargs (make-vector depth #f)))
    703       ;; initialize trees and vargs
    704       (vector-set! trees 0 tree)
    705       (do ((k 0 (1+ k))
    706            (args args (cdr args)))
    707         ((fx= k depth) vargs)
    708         (if (fx= k (1- depth))
    709           ;; store rest args
    710           (vector-set! vargs k args)
    711           ;; store inner arg
    712           (vector-set! vargs k (car args))))
    713       (letrec (
    714         (dispatch!
    715           ;; manipulate the trees vector
    716           ;; and return its index argument changed accordingly
    717           (lambda (k)
    718             ;; bounds will be checked by
    719             ;; the outer loop
    720             (let ((tree (vector-ref trees k))
    721                   (arg (vector-ref vargs k))
    722                   (k+ (1+ k)))
    723               (and tree
    724                    (vector-set! trees
    725                                 k+
    726                                 (if (fx= k (1- depth))
    727                                   (and (apply (caar tree) arg)
    728                                        (cdar tree))
    729                                   (and ((caar tree) arg)
    730                                        (cdar tree))))
    731                    (vector-set! trees
    732                                 k
    733                                 (if (null? (cdr tree))
    734                                   #f
    735                                   (cdr tree))))
    736               (if (vector-ref trees k+)
    737                 k+
    738                 (if tree k (1- k))))))
    739         )
    740         ;;; outer loop: populate trees with dispatch!
    741         (do ((k 0 (dispatch! k)))
    742           ((or (fx< k 0) (fx= k depth))
    743            (if (fx< k 0)
    744              #f
    745              (vector-ref trees k)))
    746           )))))
     698    (if (fx= depth 1)
     699      ;; no backtracking necessary
     700      (let loop ((tree tree))
     701        (cond
     702          ((null? tree) #f)
     703          ((apply (caar tree) args)
     704           (cdar tree))
     705          (else (loop (cdr tree)))))
     706      ;; backtracking is organized by storing the
     707      ;; backtrack trees in a vector and manipulating
     708      ;; that vector
     709      (let ((trees (make-vector (1+ depth) #f))
     710            (vargs (make-vector depth #f)))
     711        ;; initialize trees and vargs
     712        (vector-set! trees 0 tree)
     713        (do ((k 0 (1+ k))
     714             (args args (cdr args)))
     715          ((fx= k depth) vargs)
     716          (if (fx= k (1- depth))
     717            ;; store rest args
     718            (vector-set! vargs k args)
     719            ;; store inner arg
     720            (vector-set! vargs k (car args))))
     721        (letrec (
     722          (dispatch!
     723            ;; manipulate the trees vector
     724            ;; and return its index argument changed accordingly
     725            (lambda (k)
     726              ;; bounds will be checked by
     727              ;; the outer loop
     728              (let ((tree (vector-ref trees k))
     729                    (arg (vector-ref vargs k))
     730                    (k+ (1+ k)))
     731                (and tree
     732                     (vector-set! trees
     733                                  k+
     734                                  (if (fx= k (1- depth))
     735                                    (and (apply (caar tree) arg)
     736                                         (cdar tree))
     737                                    (and ((caar tree) arg)
     738                                         (cdar tree))))
     739                     (vector-set! trees
     740                                  k
     741                                  (if (null? (cdr tree))
     742                                    #f
     743                                    (cdr tree))))
     744                (if (vector-ref trees k+)
     745                  k+
     746                  (if tree k (1- k))))))
     747          )
     748          ;;; outer loop: populate trees with dispatch!
     749          (do ((k 0 (dispatch! k)))
     750            ((or (fx< k 0) (fx= k depth))
     751             (if (fx< k 0)
     752               #f
     753               (vector-ref trees k)))
     754            ))))))
    747755
    748756;;; (method-tree-insert tree item)
     
    897905
    898906) ; module generics
     907
  • release/4/generics/tags/0.2.1/generics.setup

    r35271 r35285  
    1010   "generics.import.so"
    1111   "generic-helpers.import.so")
    12  '((version "0.2")))
     12 '((version "0.2.1")))
  • release/4/generics/trunk/generics.scm

    r35271 r35285  
    542542               ((exn) #f)))))))
    543543
    544 ;;; (define-selector name?? parent?? pred)
    545 ;;; --------------------------------------
     544;;; (define-selector (name?? parent?? pred))
     545;;; ----------------------------------------
    546546;;; defines a special predicate, name??,
    547547;;; from its base predicate, pred,
     
    696696      "not enough arguments"
    697697      args)
    698     ;; backtracking is organized by storing the
    699     ;; backtrack trees in a vector and manipulating
    700     ;; that vector
    701     (let ((trees (make-vector (1+ depth) #f))
    702           (vargs (make-vector depth #f)))
    703       ;; initialize trees and vargs
    704       (vector-set! trees 0 tree)
    705       (do ((k 0 (1+ k))
    706            (args args (cdr args)))
    707         ((fx= k depth) vargs)
    708         (if (fx= k (1- depth))
    709           ;; store rest args
    710           (vector-set! vargs k args)
    711           ;; store inner arg
    712           (vector-set! vargs k (car args))))
    713       (letrec (
    714         (dispatch!
    715           ;; manipulate the trees vector
    716           ;; and return its index argument changed accordingly
    717           (lambda (k)
    718             ;; bounds will be checked by
    719             ;; the outer loop
    720             (let ((tree (vector-ref trees k))
    721                   (arg (vector-ref vargs k))
    722                   (k+ (1+ k)))
    723               (and tree
    724                    (vector-set! trees
    725                                 k+
    726                                 (if (fx= k (1- depth))
    727                                   (and (apply (caar tree) arg)
    728                                        (cdar tree))
    729                                   (and ((caar tree) arg)
    730                                        (cdar tree))))
    731                    (vector-set! trees
    732                                 k
    733                                 (if (null? (cdr tree))
    734                                   #f
    735                                   (cdr tree))))
    736               (if (vector-ref trees k+)
    737                 k+
    738                 (if tree k (1- k))))))
    739         )
    740         ;;; outer loop: populate trees with dispatch!
    741         (do ((k 0 (dispatch! k)))
    742           ((or (fx< k 0) (fx= k depth))
    743            (if (fx< k 0)
    744              #f
    745              (vector-ref trees k)))
    746           )))))
     698    (if (fx= depth 1)
     699      ;; no backtracking necessary
     700      (let loop ((tree tree))
     701        (cond
     702          ((null? tree) #f)
     703          ((apply (caar tree) args)
     704           (cdar tree))
     705          (else (loop (cdr tree)))))
     706      ;; backtracking is organized by storing the
     707      ;; backtrack trees in a vector and manipulating
     708      ;; that vector
     709      (let ((trees (make-vector (1+ depth) #f))
     710            (vargs (make-vector depth #f)))
     711        ;; initialize trees and vargs
     712        (vector-set! trees 0 tree)
     713        (do ((k 0 (1+ k))
     714             (args args (cdr args)))
     715          ((fx= k depth) vargs)
     716          (if (fx= k (1- depth))
     717            ;; store rest args
     718            (vector-set! vargs k args)
     719            ;; store inner arg
     720            (vector-set! vargs k (car args))))
     721        (letrec (
     722          (dispatch!
     723            ;; manipulate the trees vector
     724            ;; and return its index argument changed accordingly
     725            (lambda (k)
     726              ;; bounds will be checked by
     727              ;; the outer loop
     728              (let ((tree (vector-ref trees k))
     729                    (arg (vector-ref vargs k))
     730                    (k+ (1+ k)))
     731                (and tree
     732                     (vector-set! trees
     733                                  k+
     734                                  (if (fx= k (1- depth))
     735                                    (and (apply (caar tree) arg)
     736                                         (cdar tree))
     737                                    (and ((caar tree) arg)
     738                                         (cdar tree))))
     739                     (vector-set! trees
     740                                  k
     741                                  (if (null? (cdr tree))
     742                                    #f
     743                                    (cdr tree))))
     744                (if (vector-ref trees k+)
     745                  k+
     746                  (if tree k (1- k))))))
     747          )
     748          ;;; outer loop: populate trees with dispatch!
     749          (do ((k 0 (dispatch! k)))
     750            ((or (fx< k 0) (fx= k depth))
     751             (if (fx< k 0)
     752               #f
     753               (vector-ref trees k)))
     754            ))))))
    747755
    748756;;; (method-tree-insert tree item)
     
    897905
    898906) ; module generics
     907
  • release/4/generics/trunk/generics.setup

    r35271 r35285  
    1010   "generics.import.so"
    1111   "generic-helpers.import.so")
    12  '((version "0.2")))
     12 '((version "0.2.1")))
Note: See TracChangeset for help on using the changeset viewer.