You can edit this page using wiki syntax for markup.

Article contents:== Outdated egg! This is an egg for CHICKEN 4, the unsupported old release. You're almost certainly looking for [[/eggref/5/sicp|the CHICKEN 5 version of this egg]], if it exists. If it does not exist, there may be equivalent functionality provided by another egg; have a look at the [[https://wiki.call-cc.org/chicken-projects/egg-index-5.html|egg index]]. Otherwise, please consider porting this egg to the current version of CHICKEN. == sicp Support for SICP [[toc:]] === SICP ==== {{sicp}} '''[module]''' {{sicp}} SICP is a grab-bag of different procedures from sections 1 through 3.3.4, before we started modularizing them (starting from 3.3.5: Constraints). * [[#=number?]] * [[#accumulate]] * [[#add]] * [[#add-action!]] * [[#add-to-agenda!]] * [[#add-vect]] * [[#addend]] * [[#adjoin-set]] * [[#after-delay]] * [[#and-gate]] * [[#and-gate-delay]] * [[#angle]] * [[#apply-generic]] * [[#attach-tag]] * [[#augend]] * [[#average]] * [[#below]] * [[#beside]] * [[#call-each]] * [[#choose-branch]] * [[#contents]] * [[#corner-split]] * [[#dec]] * [[#decode]] * [[#default-timeout]] * [[#delete-queue!]] * [[#deriv]] * [[#dispatch-table]] * [[#div]] * [[#draw-painter-as-svg]] * [[#edge1-frame]] * [[#edge2-frame]] * [[#element-of-set?]] * [[#empty-queue?]] * [[#encode]] * [[#encode-symbol]] * [[#end-segment]] * [[#enumerate-interval]] * [[#epsilon]] * [[#fast-prime?]] * [[#first-agenda-item]] * [[#flatmap]] * [[#flip-horiz]] * [[#flip-vert]] * [[#frame-coord-map]] * [[#front-ptr]] * [[#front-queue]] * [[#full-adder]] * [[#get]] * [[#get-signal]] * [[#half-adder]] * [[#huffman-adjoin-set]] * [[#image->painter]] * [[#image-frame]] * [[#image-height]] * [[#image-width]] * [[#imag-part]] * [[#inc]] * [[#insert-queue!]] * [[#install-complex-package]] * [[#install-polar-package]] * [[#install-rational-package]] * [[#install-rectangular-package]] * [[#install-scheme-number-package]] * [[#intersection-set]] * [[#inverter]] * [[#inverter-delay]] * [[#good-enough?]] * [[#leaf?]] * [[#left-branch]] * [[#logical-not]] * [[#magnitude]] * [[#make-agenda]] * [[#make-code-tree]] * [[#make-complex-from-mag-ang]] * [[#make-complex-from-real-imag]] * [[#make-from-mag-ang]] * [[#make-from-real-imag]] * [[#make-frame]] * [[#make-leaf]] * [[#make-leaf-set]] * [[#make-product]] * [[#make-queue]] * [[#make-rational]] * [[#make-scheme-number]] * [[#make-sum]] * [[#make-segment]] * [[#make-vect]] * [[#make-wire]] * [[#mul]] * [[#multiplicand]] * [[#multiplier]] * [[#nil]] * [[#or-gate]] * [[#or-gate-delay]] * [[#origin-frame]] * [[#outline]] * [[#prime?]] * [[#probe]] * [[#product?]] * [[#propagate]] * [[#put]] * [[#real-part]] * [[#rear-ptr]] * [[#remove-first-agenda-item!]] * [[#right-branch]] * [[#right-split]] * [[#rotate90]] * [[#rotate180]] * [[#rotate270]] * [[#same-variable?]] * [[#scale-vect]] * [[#segments->painter]] * [[#set-front-ptr!]] * [[#set-rear-ptr!]] * [[#set-signal!]] * [[#shrink-to-upper-right]] * [[#square]] * [[#square-limit]] * [[#start-segment]] * [[#sub]] * [[#sub-vect]] * [[#sum?]] * [[#symbol-leaf]] * [[#symbols]] * [[#terminates?]] * [[#the-agenda]] * [[#time+values]] * [[#timeout-value?]] * [[#transform-painter]] * [[#type-tag]] * [[#up-split]] * [[#variable?]] * [[#weight]] * [[#weight-leaf]] * [[#write-painter-to-svg]] * [[#write-painter-to-png]] * [[#xcor-vect]] * [[#xor]] * [[#ycor-vect]] === sicp-constraints ==== {{sicp-constraints}} '''[module]''' {{sicp-constraints}} Constraint satisfaction from section 3.3.5 * [[#adder]] * [[#connect]] * [[#constant]] * [[#for-each-except]] * [[#forget-value!]] * [[#get-value]] * [[#has-value?]] * [[#set-value!]] * [[#inform-about-no-value]] * [[#inform-about-value]] * [[#make-connector]] * [[#multiplier]] * [[#probe]] ==== {{has-value?}} <procedure>(has-value? connector) → boolean</procedure> Does this connector have a value? ; {{connector}} : The connector to test <enscript highlight="scheme">(define (has-value? connector) (connector 'has-value?)) </enscript> ==== {{get-value}} <procedure>(get-value connector) → object</procedure> Gets this connector's value. ; {{connector}} : The connector to test <enscript highlight="scheme">(define (get-value connector) (connector 'value)) </enscript> ==== {{set-value!}} <procedure>(set-value! connector new-value informant) → unspecified</procedure> Sets this connector's value. ; {{connector}} : The connector to set <enscript highlight="scheme">(define (set-value! connector new-value informant) ((connector 'set-value!) new-value informant)) </enscript> ==== {{forget-value!}} <procedure>(forget-value! connector retractor) → unspecified</procedure> Forgets this connector's value. ; {{connector}} : The connector to forget <enscript highlight="scheme">(define (forget-value! connector retractor) ((connector 'forget) retractor)) </enscript> ==== {{connect}} <procedure>(connect connector new-constraint) → unspecified</procedure> Connects a connector to a new constraint. ; {{connector}} : The connector to connect ; {{new-constraint}} : The constraint to add <enscript highlight="scheme">(define (connect connector new-constraint) ((connector 'connect) new-constraint)) </enscript> ==== {{inform-about-value}} <procedure>(inform-about-value constraint) → unspecified</procedure> Informs the constraint about a new value ; {{constraint}} : The constraint to inform <enscript highlight="scheme">(define (inform-about-value constraint) (constraint 'I-have-a-value)) </enscript> ==== {{inform-about-no-value}} <procedure>(inform-about-no-value constraint) → unspecified</procedure> Informs the constraint about forgetting. ; {{constraint}} : The consraint to inform <enscript highlight="scheme">(define (inform-about-no-value constraint) (constraint 'I-lost-my-value)) </enscript> ==== {{adder}} <procedure>(adder a1 a2 sum) → constraint</procedure> A constraint that adds two numbers ; {{a1}} : Addend ; {{a2}} : Augend ; {{sum}} : Sum <enscript highlight="scheme">(define (adder a1 a2 sum) (define (process-new-value) (cond ((and (has-value? a1) (has-value? a2)) (set-value! sum (+ (get-value a1) (get-value a2)) me)) ((and (has-value? a1) (has-value? sum)) (set-value! a2 (- (get-value sum) (get-value a1)) me)) ((and (has-value? a2) (has-value? sum)) (set-value! a1 (- (get-value sum) (get-value a2)) me)))) (define (process-forget-value) (forget-value! sum me) (forget-value! a1 me) (forget-value! a2 me) (process-new-value)) (define (me request) (case request ((I-have-a-value) (process-new-value)) ((I-lost-my-value) (process-forget-value)) (else (error "Unknown request: ADDER" request)))) (connect a1 me) (connect a2 me) (connect sum me) me) </enscript> ==== {{multiplier}} <procedure>(multiplier m1 m2 product) → constraint</procedure> A constraint that multiplies two numbers ; {{a1}} : Multiplier ; {{a2}} : Multiplicand ; {{sum}} : Product <enscript highlight="scheme">(define (multiplier m1 m2 product) (define (process-new-value) (cond ((or (and (has-value? m1) (= (get-value m1) 0)) (and (has-value? m2) (= (get-value m2) 0))) (set-value! product 0 me)) ((and (has-value? m1) (has-value? m2)) (set-value! product (* (get-value m1) (get-value m2)) me)) ((and (has-value? product) (has-value? m1)) (set-value! m2 (/ (get-value product) (get-value m1)) me)) ((and (has-value? product) (has-value? m2)) (set-value! m1 (/ (get-value product) (get-value m2)) me)))) (define (process-forget-value) (forget-value! product me) (forget-value! m1 me) (forget-value! m2 me) (process-new-value)) (define (me request) (case request ((I-have-a-value) (process-new-value)) ((I-lost-my-value) (process-forget-value)) (else (error "Unknown request: MULTIPLIER" request)))) (connect m1 me) (connect m2 me) (connect product me) me) </enscript> ==== {{constant}} <procedure>(constant value connector) → constraint</procedure> A constant constraint ; {{value}} : The value to constantly be ; {{connector}} : The relevant connector <enscript highlight="scheme">(define (constant value connector) (define (me request) (error "Unknown request: CONSTANT" request)) (connect connector me) (set-value! connector value me) me) </enscript> ==== {{probe}} <procedure>(probe name connector) → constraint</procedure> Probes a connector and informs upon value-change. ; {{name}} : Name of the connector ; {{connector}} : The connector to probe <enscript highlight="scheme">(define (probe name connector) (define (print-probe value) (format #t "Probe: ~a = ~a~%" name value)) (define (process-new-value) (print-probe (get-value connector))) (define (process-forget-value) (print-probe "?")) (define (me request) (case request ((I-have-a-value) (process-new-value)) ((I-lost-my-value) (process-forget-value)) (else (error "Unknown request: PROBE" request)))) (connect connector me) me) </enscript> ==== {{make-connector}} <procedure>(make-connector) → connector</procedure> Makes a connector. <enscript highlight="scheme">(define (make-connector) (let ((value #f) (informant #f) (constraints '())) (define (set-my-value newval setter) (cond ((not (has-value? me)) (set! value newval) (set! informant setter) (for-each-except setter inform-about-value constraints)) ((not (= value newval)) (error "Contradiction" (list value newval))) (else 'ignored))) (define (forget-my-value retractor) (if (eq? retractor informant) (begin (set! informant #f) (for-each-except retractor inform-about-no-value constraints)) 'ignored)) (define (connect new-constraint) (if (not (memq new-constraint constraints)) (set! constraints (cons new-constraint constraints))) (if (has-value? me) (inform-about-value new-constraint)) 'done) (define (me request) (case request ((has-value?) (and informant #t)) ((value) value) ((set-value!) set-my-value) ((forget) forget-my-value) ((connect) connect) (else (error "Unknown operation: CONNECTOR" request)))) me)) </enscript> ==== {{for-each-except}} <procedure>(for-each-except exception procedure list) → unspecified</procedure> Applies a procedure to every item in ''list'' except ones {{eq?}} to ''exception''. ; {{exception}} : An element not to apply ''procedure'' to ; {{procedure}} : The procedure to apply ; {{list}} : The list to iterate over <enscript highlight="scheme">(define (for-each-except exception procedure list) (define (loop items) (cond ((null? items) 'done) ((eq? (car items) exception) (loop (cdr items))) (else (procedure (car items)) (loop (cdr items))))) (loop list)) </enscript> === sicp-concurrency ==== {{sicp-concurrency}} '''[module]''' {{sicp-concurrency}} Concurrency procedures from section 3.4 * [[#make-serializer]] * [[#parallel-execute]] * [[#with-mutex-locked]] ==== {{thunk->thread}} <procedure>(thunk->thread thunk) → thread</procedure> Creates a thread from {{thunk}} and start the thread. ; {{thunk}} : The thunk to threadify <enscript highlight="scheme">(define (thunk->thread thunk) (let ((thread (make-thread thunk))) (thread-start! thread) thread)) </enscript> ==== {{parallel-execute}} <procedure>(parallel-execute . thunks) → thunk</procedure> Executes thunks in parallel; returns a thunk which can be executed to terminate the threads. ; {{thunks}} : The thunks to execute in parallel <enscript highlight="scheme">(define (parallel-execute . thunks) (let ((threads (map thunk->thread thunks))) (lambda () (for-each thread-terminate! threads)))) </enscript> ==== {{with-mutex-locked}} <procedure>(with-mutex-locked mutex thunk) → object</procedure> <procedure>(with-mutex-locked mutex thunk conditional-variable) → object</procedure> Evaluates the thunk having locked the mutex, unlocking it thereafter. ; {{mutex}} : The mutex to lock and unlock ; {{thunk}} : The thunk to evaluate ; {{conditional-variable}} : An optional conditional-variable to block on at unlock <enscript highlight="scheme">(define with-mutex-locked (case-lambda ((mutex thunk) (with-mutex-locked mutex thunk #f)) ((mutex thunk conditional-variable) (dynamic-wind (lambda () (mutex-lock! mutex)) thunk (lambda () (mutex-unlock! mutex conditional-variable)))))) </enscript> ==== {{make-serializer}} <procedure>(make-serializer) → procedure</procedure> Creates a serializer which returns serialized procedures in a common set; returns a procedure taking {{f}}, the procedure to serialize. <enscript highlight="scheme">(define (make-serializer) (let ((mutex (make-mutex))) (lambda (f) (lambda args (with-mutex-locked mutex (lambda () (apply f args))))))) </enscript> ===== Examples Create a serializer and run some thunks. (let ((s (make-serializer)) (x 10)) (parallel-execute (s (lambda () (set! x (* x x)))) (s (lambda () (set! x (+ x 1)))))) => #<procedure (f_307)> === sicp-streams ==== {{sicp-streams}} '''[module]''' {{sicp-streams}} Stream procedures from section 3.5 * [[#accelerated-sequence]] * [[#cons-stream]] * [[#display-line]] * [[#display-stream]] * [[#euler-transform]] * [[#integers]] * [[#interleave]] * [[#list->stream]] * [[#make-tableau]] * [[#merge]] * [[#pairs]] * [[#scale-stream]] * [[#stream-car]] * [[#stream-cdr]] * [[#stream-enumerate-interval]] * [[#stream-filter]] * [[#stream-for-each]] * [[#stream->list]] * [[#stream-map]] * [[#stream-null]] * [[#stream-null?]] * [[#stream-ref]] * [[#the-empty-stream]] ==== {{stream-null}} <constant>stream-null → (quote ())</constant> The empty stream <enscript highlight="scheme">(define stream-null '()) </enscript> ==== {{the-empty-stream}} <constant>the-empty-stream → stream-null</constant> A synonym for {{stream-null}} <enscript highlight="scheme">(define the-empty-stream stream-null) </enscript> ==== {{stream-null?}} <procedure>(stream-null? stream) → boolean</procedure> Is this stream null? ; {{stream}} : The stream to test <enscript highlight="scheme">(define stream-null? null?) </enscript> ==== {{cons-stream}} <syntax>(cons-stream a d) → stream</syntax> Constructs a stream; returns a stream whose {{stream-car}} is {{a}} and whose {{stream-cdr}} is a delayed {{d}}. ; {{a}} : The address part ; {{d}} : The decrement part <enscript highlight="scheme">(define-syntax cons-stream (ir-macro-transformer (lambda (expression rename inject) (match expression ((_ a b) `(cons ,a (delay ,b))))))) </enscript> ==== {{stream-ref}} <procedure>(stream-ref s n) → object</procedure> Returns the nth element of the stream, consuming any non-memoized elements. ; {{s}} : The stream to consume ; {{n}} : The nth element <enscript highlight="scheme">(define (stream-ref s n) (if (= n 0) (stream-car s) (stream-ref (stream-cdr s) (- n 1)))) </enscript> ==== {{stream-map}} <procedure>(stream-map proc s) → stream</procedure> Constructs a stream which is a {{proc}}-mapped {{s}}. ; {{proc}} : The procedure to apply ; {{s}} : The stream to apply to <enscript highlight="scheme">(define (stream-map proc s) (if (stream-null? s) stream-null (cons-stream (proc (stream-car s)) (stream-map proc (stream-cdr s))))) </enscript> ==== {{stream-for-each}} <procedure>(stream-for-each proc s) → unspecified</procedure> Applies {{proc}} to every element of {{s}}, consuming it. ; {{proc}} : The procedure to apply ; {{s}} : The stream to apply to <enscript highlight="scheme">(define (stream-for-each proc s) (if (stream-null? s) 'done (begin (proc (stream-car s)) (stream-for-each proc (stream-cdr s))))) </enscript> ==== {{display-stream}} <procedure>(display-stream s) → unspecified</procedure> Displays every element of the stream. ; {{s}} : The stream to display <enscript highlight="scheme">(define (display-stream s) (stream-for-each display-line s)) </enscript> ==== {{stream-car}} <procedure>(stream-car stream) → object</procedure> Takes the first element of the stream. ; {{stream}} : The stream to take <enscript highlight="scheme">(define (stream-car stream) (car stream)) </enscript> ==== {{stream-cdr}} <procedure>(stream-cdr stream) → stream</procedure> Forces and returns the cdr of the stream. ; {{stream}} : The stream whose cdr to force <enscript highlight="scheme">(define (stream-cdr stream) (force (cdr stream))) </enscript> ==== {{stream-enumerate-interval}} <procedure>(stream-enumerate-interval low high) → stream</procedure> Enumerates the interval between {{low}} and {{high}} streamingly. ; {{low}} : The lower bound ; {{high}} : The upper bound <enscript highlight="scheme">(define (stream-enumerate-interval low high) (if (> low high) stream-null (cons-stream low (stream-enumerate-interval (+ low 1) high)))) </enscript> ==== {{stream-filter}} <procedure>(stream-filter pred stream) → stream</procedure> Filters a stream, applying {{pred}}. ; {{pred}} : The predicate upon which to filter. ; {{stream}} : The stream to filter <enscript highlight="scheme">(define (stream-filter pred stream) (cond ((stream-null? stream) stream-null) ((pred (stream-car stream)) (cons-stream (stream-car stream) (stream-filter pred (stream-cdr stream)))) (else (stream-filter pred (stream-cdr stream))))) </enscript> ==== {{stream->list}} <procedure>(stream->list stream) → stream</procedure> <procedure>(stream->list stream n) → stream</procedure> Converts a stream to a list, consuming it (or up to n elements). ; {{stream}} : The stream to convert to a list ; {{n}} : Optionally, the maximum number of elements to consume; otherwise: all elements <enscript highlight="scheme">(define stream->list (case-lambda ((stream) (stream->list stream +inf.0)) ((stream n) (if (or (stream-null? stream) (zero? n)) '() (cons (stream-car stream) (stream->list (stream-cdr stream) (- n 1))))))) </enscript> ==== {{scale-stream}} <procedure>(scale-stream stream factor) → stream</procedure> Scales the stream by a constant factor. ; {{stream}} : The stream to scale ; {{factor}} : The factor by which to scale it <enscript highlight="scheme">(define (scale-stream stream factor) (stream-map (lambda (x) (* x factor)) stream)) </enscript> ==== {{euler-transform}} <procedure>(euler-transform s) → stream</procedure> Applies [[http://en.wikipedia.org/wiki/Series_acceleration#Euler.27s_transform|Euler's transform]], i.e. a linear sequence transformation for improved convergence, to a stream. ; {{s}} : The stream to which to apply Euler's transform <enscript highlight="scheme">(define (euler-transform s) (let ((s0 (stream-ref s 0)) (s1 (stream-ref s 1)) (s2 (stream-ref s 2))) (cons-stream (- s2 (/ (square (- s2 s1)) (+ s0 (* -2 s1) s2))) (euler-transform (stream-cdr s))))) </enscript> ==== {{make-tableau}} <procedure>(make-tableau transform s) → stream</procedure> Makes a tableau (i.e., a stream of streams) compounded from some transformation. ; {{transform}} : The compounding transformation ; {{s}} : The stream to transformatively compound <enscript highlight="scheme">(define (make-tableau transform s) (cons-stream s (make-tableau transform (transform s)))) </enscript> ==== {{accelerated-sequence}} <procedure>(accelerated-sequence transform s) → stream</procedure> Accelerates some converging sequence. ; {{transform}} : The transformation to apply ; {{s}} : The sequence to accelerate, e.g. [[euler-transform]] <enscript highlight="scheme">(define (accelerated-sequence transform s) (stream-map stream-car (make-tableau transform s))) </enscript> ==== {{integers-starting-from}} <procedure>(integers-starting-from n) → stream</procedure> Enumerates the integers starting from n streamingly. ; {{n}} : The number to start from <enscript highlight="scheme">(define (integers-starting-from n) (cons-stream n (integers-starting-from (+ n 1)))) </enscript> ==== {{integers}} <constant>integers → (integers-starting-from 1)</constant> Enumerates the positive integers streamingly. <enscript highlight="scheme">(define integers (integers-starting-from 1)) </enscript> ==== {{interleave}} <procedure>(interleave s1 s2) → stream</procedure> Interleaves two streams. ; {{s1}} : The interleavened stream ; {{s1}} : The interleaving stream <enscript highlight="scheme">(define (interleave s1 s2) (if (stream-null? s1) s2 (cons-stream (stream-car s1) (interleave s2 (stream-cdr s1))))) </enscript> ==== {{pairs}} <procedure>(pairs s t) → stream</procedure> Generates the stream of pairs (S_i, T_j), where i <= j. ; {{s}} : The first stream to pair ; {{t}} : The second stream to pair <enscript highlight="scheme">(define (pairs s t) (cons-stream (list (stream-car s) (stream-car t)) (interleave (stream-map (lambda (x) (list (stream-car s) x)) (stream-cdr t)) (pairs (stream-cdr s) (stream-cdr t))))) </enscript> ==== {{merge}} <procedure>(merge s1 s2) → stream</procedure> Merges two ordered streams into one ordered result stream, eliminating repetitions. ; {{s1}} : Mergend ; {{s2}} : Merger <enscript highlight="scheme">(define (merge s1 s2) (cond ((stream-null? s1) s2) ((stream-null? s2) s1) (else (let ((s1car (stream-car s1)) (s2car (stream-car s2))) (cond ((< s1car s2car) (cons-stream s1car (merge (stream-cdr s1) s2))) ((> s1car s2car) (cons-stream s2car (merge s1 (stream-cdr s2)))) (else (cons-stream s1car (merge (stream-cdr s1) (stream-cdr s2))))))))) </enscript> ==== {{list->stream}} <procedure>(list->stream list) → stream</procedure> Takes a list and streamifies it. ; {{list}} : The list to streamify <enscript highlight="scheme">(define (list->stream list) (if (null? list) stream-null (cons-stream (car list) (list->stream (cdr list))))) </enscript> === sicp-eval ==== {{sicp-eval}} '''[module]''' {{sicp-eval}} Evaluation procedures from section 4.1 * [[#add-binding-to-frame!]] * [[#announce-output]] * [[#application?]] * [[#apply*]] * [[#apply-primitive-procedure]] * [[#assignment?]] * [[#assignment-value]] * [[#assignment-variable]] * [[#begin-actions]] * [[#begin?]] * [[#compound-procedure?]] * [[#cond?]] * [[#cond->if]] * [[#cond-actions]] * [[#cond-clauses]] * [[#cond-else-clause?]] * [[#cond-predicate]] * [[#define-variable!]] * [[#definition?]] * [[#definition-variable]] * [[#definition-value]] * [[#driver-loop]] * [[#enclosing-environment]] * [[#eval*]] * [[#eval-assignment]] * [[#eval-definition]] * [[#eval-if]] * [[#eval-sequence]] * [[#extend-environment]] * [[#false?]] * [[#first-exp]] * [[#first-frame]] * [[#frame-values]] * [[#frame-variables]] * [[#if?]] * [[#if-alternative]] * [[#if-consequent]] * [[#if-predicate]] * [[#first-operand]] * [[#lambda?]] * [[#lambda-body]] * [[#lambda-parameters]] * [[#last-exp?]] * [[#list-of-values]] * [[#lookup-variable-value]] * [[#make-if]] * [[#make-frame]] * [[#make-lambda]] * [[#make-procedure]] * [[#no-operands?]] * [[#operands]] * [[#operator]] * [[#primitive-procedure?]] * [[#primitive-procedures]] * [[#procedure-body]] * [[#procedure-environment]] * [[#procedure-parameters]] * [[#prompt-for-input]] * [[#quoted?]] * [[#rest-exps]] * [[#rest-operands]] * [[#self-evaluating?]] * [[#sequence->exp]] * [[#set-variable-value!]] * [[#setup-environment]] * [[#tagged-list?]] * [[#text-of-quotation]] * [[#the-empty-environment]] * [[#the-global-environment]] * [[#true?]] * [[#user-print]] * [[#variable?]] * [[#with-primitive-procedures]] ==== {{apply*}} <procedure>(apply* procedure arguments) → object</procedure> The SICP definition of {{apply}}; had to rename it {{apply*}}, because the redefinition of {{apply}} wrought havok on the module-system. ; {{procedure}} : The procedure to apply ; {{arguments}} : The arguments to which to apply it <enscript highlight="scheme">(define (apply* procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type: APPLY*" procedure)))) </enscript> ==== {{eval*}} <procedure>(eval* exp env) → object</procedure> The SICP implementation of {{eval}}; had to rename it {{eval*}}, because the redefinition of {{eval}} wrought havok on the module-system. ; {{exp}} : The expression to evaluate ; {{env}} : The environment to evaluate it in <enscript highlight="scheme">(define (eval* exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (eval* (cond->if exp) env)) ((application? exp) (apply* (eval* (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type: EVAL" exp)))) </enscript> ==== {{with-primitive-procedures}} <procedure>(with-primitive-procedures procedures receive-env) → object</procedure> Installs {{procedures}}, creates a default environment and calls {{receive-env}} with the default environment; this is useful for testing new syntax, etc. ; {{procedures}} : A key-value list of procedure-names and their primitive counter-part ; {{receive-env}} : A procedure which takes a fresh environment <enscript highlight="scheme">(define (with-primitive-procedures procedures receive-env) (parameterize ((primitive-procedures (append procedures (primitive-procedures)))) (let ((env (setup-environment))) (receive-env env)))) </enscript> ===== Examples Applying primitive addition (with-primitive-procedures `((+ ,+)) (lambda (env) (eval* '(+ 2 3) env))) => 5 === sicp-eval-anal ==== {{sicp-eval-anal}} '''[module]''' {{sicp-eval-anal}} The analyzing evaluator from section 4.1.7 * [[#anal-eval*]] * [[#analyze]] * [[#analyze-application]] * [[#analyze-assignment]] * [[#analyze-definition]] * [[#analyze-if]] * [[#analyze-lambda]] * [[#analyze-quoted]] * [[#analyze-self-evaluating]] * [[#analyze-sequence]] * [[#analyze-variable]] * [[#execute-application]] ==== {{anal-eval*}} <procedure>(anal-eval* exp env) → object</procedure> Anal-eval* analyzes an expression before evaluating it, storing the syntactic analysis in a thunk for re-use. ; {{exp}} : The expression to analyze and evaluate ; {{env}} : The environment to analyze and evaluate it in <enscript highlight="scheme">(define (anal-eval* exp env) ((analyze exp) env)) </enscript> ==== {{analyze}} <procedure>(analyze exp) → thunk</procedure> Analyze analyzes the expression, returning a thunk that represents the work to be done. ; {{exp}} : The expression to analyze <enscript highlight="scheme">(define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((assignment? exp) (analyze-assignment exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((cond? exp) (analyze (cond->if exp))) ((application? exp) (analyze-application exp)) (else (error "Unknown expression type: ANALYZE" exp)))) </enscript> === sicp-eval-lazy ==== {{sicp-eval-lazy}} '''[module]''' {{sicp-eval-lazy}} The lazy evaluator from section 4.2.2 * [[#actual-value]] * [[#apply*]] * [[#delay-it]] * [[#driver-loop]] * [[#eval*]] * [[#eval-if]] * [[#evaluated-thunk?]] * [[#force-it]] * [[#input-prompt]] * [[#list-of-arg-values]] * [[#list-of-delayed-args]] * [[#output-prompt]] * [[#thunk-env]] * [[#thunk-exp]] * [[#thunk-value]] * [[#thunk?]] * [[#with-lazy-lists]] ==== {{eval*}} <procedure>(eval* exp env) → object</procedure> Evaluates an expression lazily, given an environment. ; {{exp}} : The expression to evaluate ; {{env}} : The environment to evaluate it in <enscript highlight="scheme">(define (eval* exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (eval* (cond->if exp) env)) ((application? exp) (apply* (actual-value (operator exp) env) (operands exp) env)) (else (error "Unknown expression type: EVAL*" exp)))) </enscript> ==== {{with-lazy-lists}} <procedure>(with-lazy-lists procedures receive-env) → object</procedure> Sets up an environment where lazy {{cons}}, {{car}} and {{cdr}} have been defined. {{With-lazy-lists}} is a wrapper around {{with-primitive-procedures}}. ; {{procedures}} : A key-value list of names and their primitive procedures in the underlying Scheme. ; {{receive-env}} : A lambda of one value that takes the prepared environment <enscript highlight="scheme">(define (with-lazy-lists procedures receive-env) (with-primitive-procedures (append procedures `((= ,=) (- ,-))) (lambda (env) (eval* '(define (cons x y) (lambda (m) (m x y))) env) (eval* '(define (car z) (z (lambda (p q) p))) env) (eval* '(define (cdr z) (z (lambda (p q) q))) env) (eval* '(define (list-ref items n) (if (= n 0) (car items) (list-ref (cdr items) (- n 1)))) env) (eval* '(define (map proc items) (if (null? items) '() (cons (proc (car items)) (map proc (cdr items))))) env) (receive-env env)))) </enscript> === sicp-eval-amb ==== {{sicp-eval-amb}} '''[module]''' {{sicp-eval-amb}} The non-deterministic backtracking evaluator from section 4.3.3 * [[#amb-choices]] * [[#amb?]] * [[#ambeval*]] * [[#ambeval-fold]] * [[#ambeval-map]] * [[#ambeval-n]] * [[#analyze]] * [[#analyze-amb]] * [[#analyze-application]] * [[#analyze-assignment]] * [[#analyze-definition]] * [[#analyze-if]] * [[#analyze-lambda]] * [[#analyze-let]] * [[#analyze-quoted]] * [[#analyze-self-evaluating]] * [[#analyze-sequence]] * [[#analyze-variable]] * [[#driver-loop]] * [[#execute-application]] * [[#failure]] * [[#failure?]] * [[#get-args]] * [[#input-prompt]] * [[#let->combination]] * [[#let-body]] * [[#let-clause-expression]] * [[#let-clause-variable]] * [[#let-clause?]] * [[#let-clauses]] * [[#output-prompt]] * [[#success?]] * [[#with-require]] ==== {{ambeval}} <procedure>(ambeval exp env succeed fail) → object</procedure> Evaluates the expression using backtracking search. ; {{exp}} : The expression to evaluate ; {{env}} : The environment to evaluate it in ; {{succeed}} : The success-continuation ; {{fail}} : The failure-continuation <enscript highlight="scheme">(define (ambeval exp env succeed fail) ((analyze exp) env succeed fail)) </enscript> ==== {{ambeval-n}} <procedure>(ambeval-n exp env n) → object</procedure> Amb-evaluates the expression, invoking the success-continuation {{n}} times or until failure. ; {{exp}} : The expression to evaluate ; {{env}} : The environment to evaluate it in ; {{n}} : The maximum number of times to invoke the success continuation <enscript highlight="scheme">(define (ambeval-n exp env n) (ambeval exp env (lambda (val next-alternative) (set! n (- n 1)) (if (zero? n) val (next-alternative))) (lambda () failure))) </enscript> ==== {{ambeval-fold}} <procedure>(ambeval-fold exp env cons nil) → list</procedure> <procedure>(ambeval-fold exp env cons nil n) → list</procedure> Folds over the results of up to {{n}} successful executions of {{exp}}; if {{n}} is missing, folds over all successful executions until failure. ; {{exp}} : The expression to execute ; {{env}} : The environment to execute it in ; {{cons}} : The aggregator ; {{nil}} : The initial value ; {{n}} : The number of results to gather <enscript highlight="scheme">(define ambeval-fold (case-lambda ((exp env cons nil) (ambeval-fold exp env cons nil +inf.0)) ((exp env cons nil n) (let ((result nil)) (ambeval exp env (lambda (val next-alternative) (set! n (- n 1)) (if (negative? n) result (begin (set! result (cons val result)) (next-alternative)))) (lambda () result)))))) </enscript> ==== {{ambeval-map}} <procedure>(ambeval-map exp env f) → list</procedure> <procedure>(ambeval-map exp env f n) → list</procedure> Maps over the results of up to {{n}} successful executions of {{exp}}; if {{n}} is missing, maps over all successful executions until failure. ; {{exp}} : The expression to execute ; {{env}} : The environment to execute it in ; {{f}} : The function to apply to the results ; {{n}} : The number of results to gather <enscript highlight="scheme">(define ambeval-map (case-lambda ((exp env f) (ambeval-map exp env f +inf.0)) ((exp env f n) (ambeval exp env (lambda (val next-alternative) (set! n (- n 1)) (if (negative? n) '() (cons val (next-alternative)))) (lambda () '()))))) </enscript> ==== {{ambeval*}} <procedure>(ambeval* exp env) → list</procedure> <procedure>(ambeval* exp env n) → list</procedure> Gathers the results of up to {{n}} successful executions of {{exp}}; if {{n}} is missing, gathers all successful executions until failure. ; {{exp}} : The expression to execute ; {{env}} : The environment to execute it in ; {{n}} : The number of results to gather <enscript highlight="scheme">(define ambeval* (case-lambda ((exp env) (ambeval* exp env +inf.0)) ((exp env n) (ambeval-map exp env values n)))) </enscript> ==== {{with-require}} <procedure>(with-require procedures receive-env) → object</procedure> Installs {{require}}, {{an-element-of}}, {{an-integer-starting-from}} in the environment in addition to the primitive procedures enumerated in {{procedures}}; then calls {{receive-env}} with the configured environment. ; {{procedures}} : A key-value list of primitive procedure-names and their definitions ; {{receive-env}} : A lambda of one value that is called with the prepared environment <enscript highlight="scheme">(define (with-require procedures receive-env) (with-primitive-procedures (append procedures `((member ,member) (not ,not))) (lambda (env) (ambeval* '(define (require p) (if (not p) (amb) 'success)) env) (ambeval* '(define (an-element-of items) (require (not (null? items))) (amb (car items) (an-element-of (cdr items)))) env) (ambeval* '(define (an-integer-starting-from n) (amb n (an-integer-starting-from (+ n 1)))) env) (ambeval* '(define (distinct? items) (cond ((null? items) true) ((null? (cdr items)) true) ((member (car items) (cdr items)) false) (else (distinct? (cdr items))))) env) (receive-env env)))) </enscript> === About this egg ==== Author [[/users/klutometis|Peter Danenberg]] ==== Repository [[https://github.com/klutometis/sicp-chicken]] ==== License BSD ==== Dependencies * [[debug]] * [[hahn]] * [[htmlprag]] * [[matchable]] * [[setup-helper]] * [[shell]] * [[token-substitution]] ==== Versions ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.0|0.0]] : Initial commit ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.0.1|0.0.1]] : Add release-info. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.0.2|0.0.2]] : Change the repo and uri. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.0.3|0.0.3]] : Remove 0.0. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.1|0.1]] : Some actual code. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.1.1|0.1.1]] : Nil, etc. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.1.2|0.1.2]] : Remove SRFI-18. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.1.3|0.1.3]] : Add accumulate. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.1.4|0.1.4]] : Enumerate interval ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.1.5|0.1.5]] : Add flatmap. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.1.6|0.1.6]] : Add `prime?'. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.2|0.2]] : Add picture language. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.2.12|0.2.12]] : Add ambeval-fold, ambeval-map; change ambeval*. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.2.13|0.2.13]] : Remove redundant ambeval*. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.3|0.3]] : Add the outline-painter. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.4|0.4]] : Add differentation. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.4.1|0.4.1]] : Add images to picture-language. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.4.2|0.4.2]] : Add write-painter-to-png. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.5|0.5]] : Add sets. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.5.1|0.5.1]] : Add Huffman trees. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.5.2|0.5.2]] : Add abstract data. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.5.3|0.5.3]] : Add arithmetic. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.5.4|0.5.4]] : Add queues and circuits. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.6|0.6]] : Add constraints, documentation. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.7|0.7]] : Add concurrency. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.7.1|0.7.1]] : Remove the dependency on setup-helper-cock. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.7.2|0.7.2]] : Update sxml to work with `at'. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.7.3|0.7.3]] : Drop setup-helper-cock. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.8|0.8]] : Add streams. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.8.1|0.8.1]] : Use match instead of match-let. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.8.2|0.8.2]] : Add a limit to stream-consumption on stream->list. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.8.3|0.8.3]] : Use +inf.0 instead of +inf. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.8.4|0.8.4]] : Evaluate examples; update docs. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.8.5|0.8.5]] : Add scale-stream. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.8.6|0.8.6]] : Add accelerated sequences. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.8.7|0.8.7]] : Add integers. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.8.8|0.8.8]] : Add interleave and pairs. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.8.9|0.8.9]] : Add merge. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.8.10|0.8.10]] : Add list->stream. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.9|0.9]] : Add the evaluator. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.9.1|0.9.1]] : Actually add the eval-files. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.9.2|0.9.2]] : Add with-primitive-procedures. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.9.3|0.9.3]] : Export some functions. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.9.4|0.9.4]] : Export `compound-procedure?'. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.9.5|0.9.5]] : Export functions required for analysis. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.9.6|0.9.6]] : Also export these for analysis. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.9.7|0.9.7]] : Export a few more things. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.9.8|0.9.8]] : Export more procedures. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.9.9|0.9.9]] : Add time+values. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.9.10|0.9.10]] : Export procedures. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.9.11|0.9.11]] : Export make-lambda. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.9.12|0.9.12]] : Use hahn. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.10|0.10]] : Add the analyzing evaluator. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.11|0.11]] : Add the lazy evaluator. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.12|0.12]] : Add the amb-evaluator. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.12.1|0.12.1]] : Export with-lazy-lists. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.12.4|0.12.4]] : Add debug to the dependencies. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.12.5|0.12.5]] : Add `distinct?' to amb-eval. ; [[https://github.com/klutometis/sicp-chicken/releases/tag/0.12.6|0.12.6]] : Add member to the list of imported functions. ==== Colophon Documented by [[/egg/hahn|hahn]].Description of your changes:

I would like to authenticate

Spam control

What do you get when you add 2 to 24?