Changeset 35285 in project
 Timestamp:
 03/14/18 11:30:54 (20 months ago)
 Location:
 release/4/generics
 Files:

 2 edited
 4 copied
Legend:
 Unmodified
 Added
 Removed

release/4/generics/tags/0.2.1/generics.scm
r35271 r35285 542 542 ((exn) #f))))))) 543 543 544 ;;; (defineselector name?? parent?? pred)545 ;;;  544 ;;; (defineselector (name?? parent?? pred)) 545 ;;;  546 546 ;;; defines a special predicate, name??, 547 547 ;;; from its base predicate, pred, … … 696 696 "not enough arguments" 697 697 args) 698 ;; backtracking is organized by storing the 699 ;; backtrack trees in a vector and manipulating 700 ;; that vector 701 (let ((trees (makevector (1+ depth) #f)) 702 (vargs (makevector depth #f))) 703 ;; initialize trees and vargs 704 (vectorset! 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 (vectorset! vargs k args) 711 ;; store inner arg 712 (vectorset! 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 (vectorref trees k)) 721 (arg (vectorref vargs k)) 722 (k+ (1+ k))) 723 (and tree 724 (vectorset! 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 (vectorset! trees 732 k 733 (if (null? (cdr tree)) 734 #f 735 (cdr tree)))) 736 (if (vectorref 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 (vectorref 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 (makevector (1+ depth) #f)) 710 (vargs (makevector depth #f))) 711 ;; initialize trees and vargs 712 (vectorset! 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 (vectorset! vargs k args) 719 ;; store inner arg 720 (vectorset! 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 (vectorref trees k)) 729 (arg (vectorref vargs k)) 730 (k+ (1+ k))) 731 (and tree 732 (vectorset! 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 (vectorset! trees 740 k 741 (if (null? (cdr tree)) 742 #f 743 (cdr tree)))) 744 (if (vectorref 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 (vectorref trees k))) 754 )))))) 747 755 748 756 ;;; (methodtreeinsert tree item) … … 897 905 898 906 ) ; module generics 907 
release/4/generics/tags/0.2.1/generics.setup
r35271 r35285 10 10 "generics.import.so" 11 11 "generichelpers.import.so") 12 '((version "0.2 ")))12 '((version "0.2.1"))) 
release/4/generics/trunk/generics.scm
r35271 r35285 542 542 ((exn) #f))))))) 543 543 544 ;;; (defineselector name?? parent?? pred)545 ;;;  544 ;;; (defineselector (name?? parent?? pred)) 545 ;;;  546 546 ;;; defines a special predicate, name??, 547 547 ;;; from its base predicate, pred, … … 696 696 "not enough arguments" 697 697 args) 698 ;; backtracking is organized by storing the 699 ;; backtrack trees in a vector and manipulating 700 ;; that vector 701 (let ((trees (makevector (1+ depth) #f)) 702 (vargs (makevector depth #f))) 703 ;; initialize trees and vargs 704 (vectorset! 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 (vectorset! vargs k args) 711 ;; store inner arg 712 (vectorset! 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 (vectorref trees k)) 721 (arg (vectorref vargs k)) 722 (k+ (1+ k))) 723 (and tree 724 (vectorset! 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 (vectorset! trees 732 k 733 (if (null? (cdr tree)) 734 #f 735 (cdr tree)))) 736 (if (vectorref 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 (vectorref 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 (makevector (1+ depth) #f)) 710 (vargs (makevector depth #f))) 711 ;; initialize trees and vargs 712 (vectorset! 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 (vectorset! vargs k args) 719 ;; store inner arg 720 (vectorset! 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 (vectorref trees k)) 729 (arg (vectorref vargs k)) 730 (k+ (1+ k))) 731 (and tree 732 (vectorset! 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 (vectorset! trees 740 k 741 (if (null? (cdr tree)) 742 #f 743 (cdr tree)))) 744 (if (vectorref 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 (vectorref trees k))) 754 )))))) 747 755 748 756 ;;; (methodtreeinsert tree item) … … 897 905 898 906 ) ; module generics 907 
release/4/generics/trunk/generics.setup
r35271 r35285 10 10 "generics.import.so" 11 11 "generichelpers.import.so") 12 '((version "0.2 ")))12 '((version "0.2.1")))
Note: See TracChangeset
for help on using the changeset viewer.