Changeset 34337 in project


Ignore:
Timestamp:
08/24/17 18:03:45 (4 weeks ago)
Author:
kon
Message:

expose more

Location:
release/4/amb
Files:
6 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/amb/tags/2.3.0/amb-extras.scm

    r34138 r34337  
    22;;;; Kon Lovett, Mar '09
    33;;;; Kon Lovett, Mar '17
     4;;;; Kon Lovett, Aug '17
    45
    56(module amb-extras
    67
    78(;export
    8   (amb1 list-thunkify)
    9   (choose random list-thunkify)
     9  amb1
     10  choose
    1011  one-of
    1112  all-of
     
    1415  distinct?
    1516  ;
    16   count-member)
     17  count-member
     18  list-constantly)
    1719
    1820(import scheme)
    1921
    2022(import chicken)
     23
    2124(import
    2225  (only extras random)
    23   (only data-structures sort!))
     26  (only data-structures sort! constantly))
     27(require-library extras data-structures)
    2428
    25 (import (only (srfi 1) count))
     29(import (only (srfi 1) count every))
    2630(require-library (srfi 1))
    2731
     
    4044     ((amb-failure-continuation)) )
    4145    ((_ ?ls)
    42      (amb-thunks (list-thunkify ?ls)) ) ) )
     46     (amb-thunks (list-constantly ?ls)) ) ) )
    4347
    4448(define-syntax choose
    4549  (syntax-rules ()
    46      ((_)
     50    ((_)
    4751     ((amb-failure-continuation)) )
    48    ((_ ?ls)
    49       (amb-thunks-shuffled (list-thunkify ?ls) random) ) ) )
     52    ((_ ?ls)
     53      (amb-thunks-shuffled (list-constantly ?ls) (amb-random-function)) ) ) )
    5054
    5155(define-syntax one-of
     
    7074
    7175(define (distinct? xs #!optional (eql? equal?))
    72   (check-list 'distinct? xs 'list)
    7376  (check-procedure 'distinct? eql? '=?)
    74   (let loop ((txs xs))
    75     (or
    76       (null? txs)
    77       (and
    78         (= 1 (count-member (car txs) xs eql?))
    79         (loop (cdr txs)))) ) )
     77  (every
     78    (lambda (t) (fx= 1 (count-member t xs eql?)))
     79    (check-list 'distinct? xs 'list)) )
    8080
    8181;;;
     
    8686  (count (cut eql? x <>) xs) )
    8787
    88 (define (list-thunkify ls)
    89   (map (lambda (x) (lambda () x)) ls) )
     88(define (list-constantly ls)
     89  (map constantly ls) )
    9090
    9191) ;module amb-extras
  • release/4/amb/tags/2.3.0/amb.scm

    r34138 r34337  
    44;;;; Chicken 4 Port: Kon Lovett, Mar '09
    55;;;; Kon Lovett, May '17
     6;;;; Kon Lovett, Aug '17
    67
    78(module amb
     
    1718  amb-find-thunk
    1819  amb-collect-thunk
    19   amb-random-function)
     20  amb-random-function
     21  ;
     22  shuffle)
    2023
    2124(import scheme)
    2225
    2326(import chicken)
     27
    2428(import
    2529  (only data-structures sort!)
    2630  (only extras random) )
     31(require-library extras data-structures)
    2732
    2833(import (only (srfi 1) map!))
     
    4550(define make-amb-exhausted-condition
    4651  (let ((+cached-amb-exhausted-condition+
    47          (make-exn-condition+ 'amb "expression tree exhausted" '() 'amb)))
    48     (lambda ()
    49       +cached-amb-exhausted-condition+ ) ) )
     52          (make-exn-condition+ 'amb "expression tree exhausted" '() 'amb)))
     53    (lambda () +cached-amb-exhausted-condition+) ) )
    5054
    5155;;
     
    5660      x
    5761      (begin
    58         (warning 'amb-random-function "not a procedure" x)
     62        (warning 'amb-random-function "not a procedure" x)
    5963        (amb-random-function) ) ) ) )
    6064
     
    119123(define (amb-find-thunk thunk #!optional (failure amb-exhausted))
    120124  (let/cc return
    121     (parameterize ((amb-failure-continuation (lambda () (return (failure)))))
    122       (thunk) ) ) )
     125    (let ((fail-k (lambda () (return (failure)))))
     126      (parameterize ((amb-failure-continuation fail-k))
     127        (thunk) ) ) ) )
    123128
    124129(define (amb-collect-thunk thunk)
  • release/4/amb/tags/2.3.0/amb.setup

    r34138 r34337  
    55(verify-extension-name "amb")
    66
    7 (setup-shared-extension-module 'amb (extension-version "2.2.0")
     7(setup-shared+static-extension-module 'amb (extension-version "2.3.0")
    88  #:inline? #t
    99  #:types? #t
     
    1111  #:install-options '((examples "amb-dwelling.scm" "amb-kalotan.scm" "amb-money.scm")))
    1212
    13 (setup-shared-extension-module 'amb-extras (extension-version "2.2.0")
     13(setup-shared+static-extension-module 'amb-extras (extension-version "2.3.0")
    1414  #:inline? #t
    1515  #:types? #t
  • release/4/amb/trunk/amb-extras.scm

    r34138 r34337  
    22;;;; Kon Lovett, Mar '09
    33;;;; Kon Lovett, Mar '17
     4;;;; Kon Lovett, Aug '17
    45
    56(module amb-extras
    67
    78(;export
    8   (amb1 list-thunkify)
    9   (choose random list-thunkify)
     9  amb1
     10  choose
    1011  one-of
    1112  all-of
     
    1415  distinct?
    1516  ;
    16   count-member)
     17  count-member
     18  list-constantly)
    1719
    1820(import scheme)
    1921
    2022(import chicken)
     23
    2124(import
    2225  (only extras random)
    23   (only data-structures sort!))
     26  (only data-structures sort! constantly))
     27(require-library extras data-structures)
    2428
    25 (import (only (srfi 1) count))
     29(import (only (srfi 1) count every))
    2630(require-library (srfi 1))
    2731
     
    4044     ((amb-failure-continuation)) )
    4145    ((_ ?ls)
    42      (amb-thunks (list-thunkify ?ls)) ) ) )
     46     (amb-thunks (list-constantly ?ls)) ) ) )
    4347
    4448(define-syntax choose
    4549  (syntax-rules ()
    46      ((_)
     50    ((_)
    4751     ((amb-failure-continuation)) )
    48    ((_ ?ls)
    49       (amb-thunks-shuffled (list-thunkify ?ls) random) ) ) )
     52    ((_ ?ls)
     53      (amb-thunks-shuffled (list-constantly ?ls) (amb-random-function)) ) ) )
    5054
    5155(define-syntax one-of
     
    7074
    7175(define (distinct? xs #!optional (eql? equal?))
    72   (check-list 'distinct? xs 'list)
    7376  (check-procedure 'distinct? eql? '=?)
    74   (let loop ((txs xs))
    75     (or
    76       (null? txs)
    77       (and
    78         (= 1 (count-member (car txs) xs eql?))
    79         (loop (cdr txs)))) ) )
     77  (every
     78    (lambda (t) (fx= 1 (count-member t xs eql?)))
     79    (check-list 'distinct? xs 'list)) )
    8080
    8181;;;
     
    8686  (count (cut eql? x <>) xs) )
    8787
    88 (define (list-thunkify ls)
    89   (map (lambda (x) (lambda () x)) ls) )
     88(define (list-constantly ls)
     89  (map constantly ls) )
    9090
    9191) ;module amb-extras
  • release/4/amb/trunk/amb.scm

    r34138 r34337  
    44;;;; Chicken 4 Port: Kon Lovett, Mar '09
    55;;;; Kon Lovett, May '17
     6;;;; Kon Lovett, Aug '17
    67
    78(module amb
     
    1718  amb-find-thunk
    1819  amb-collect-thunk
    19   amb-random-function)
     20  amb-random-function
     21  ;
     22  shuffle)
    2023
    2124(import scheme)
    2225
    2326(import chicken)
     27
    2428(import
    2529  (only data-structures sort!)
    2630  (only extras random) )
     31(require-library extras data-structures)
    2732
    2833(import (only (srfi 1) map!))
     
    4550(define make-amb-exhausted-condition
    4651  (let ((+cached-amb-exhausted-condition+
    47          (make-exn-condition+ 'amb "expression tree exhausted" '() 'amb)))
    48     (lambda ()
    49       +cached-amb-exhausted-condition+ ) ) )
     52          (make-exn-condition+ 'amb "expression tree exhausted" '() 'amb)))
     53    (lambda () +cached-amb-exhausted-condition+) ) )
    5054
    5155;;
     
    5660      x
    5761      (begin
    58         (warning 'amb-random-function "not a procedure" x)
     62        (warning 'amb-random-function "not a procedure" x)
    5963        (amb-random-function) ) ) ) )
    6064
     
    119123(define (amb-find-thunk thunk #!optional (failure amb-exhausted))
    120124  (let/cc return
    121     (parameterize ((amb-failure-continuation (lambda () (return (failure)))))
    122       (thunk) ) ) )
     125    (let ((fail-k (lambda () (return (failure)))))
     126      (parameterize ((amb-failure-continuation fail-k))
     127        (thunk) ) ) ) )
    123128
    124129(define (amb-collect-thunk thunk)
  • release/4/amb/trunk/amb.setup

    r34138 r34337  
    55(verify-extension-name "amb")
    66
    7 (setup-shared-extension-module 'amb (extension-version "2.2.0")
     7(setup-shared+static-extension-module 'amb (extension-version "2.3.0")
    88  #:inline? #t
    99  #:types? #t
     
    1111  #:install-options '((examples "amb-dwelling.scm" "amb-kalotan.scm" "amb-money.scm")))
    1212
    13 (setup-shared-extension-module 'amb-extras (extension-version "2.2.0")
     13(setup-shared+static-extension-module 'amb-extras (extension-version "2.3.0")
    1414  #:inline? #t
    1515  #:types? #t
Note: See TracChangeset for help on using the changeset viewer.