參考sicp04核心過程evaleval以一個(gè)表達(dá)式exp環(huán)境env為

4. 一直用 基本求值過程的實(shí)現(xiàn)，apply SchemeSchemeScheme系統(tǒng)（的支持）但實(shí)際可行：Scheme表達(dá)式的求值也是一種計(jì)算。如果一個(gè)語言Scheme解釋器。SchemeScheme表達(dá)式求值也是一些符號(hào)操作，SchemeLisp方言都特別Scheme程序求值的狀態(tài) eval負(fù)責(zé)表達(dá)式求值，apply相互遞歸調(diào)用，evalevalapplyassignment-variableassignment-valuemake-procedure構(gòu)造復(fù)合過程（構(gòu)造過程對(duì)象lookup-variable-value取變量的值（在環(huán)境中檢索apply-primitive-procedureevalapply evalexpenvexpbegincondif過程和所有實(shí)參送給apply，要求執(zhí)行過程應(yīng)用 (define(evalexp(cond((self-evaluating?exp)((variable?exp)(lookup-variable-valueexpenv))((quoted?exp)(text-of-quotationexp))((assignment?exp)(eval-assignmentexpenv))((definition?exp)(eval-definitionexpenv))((if?exp)(eval-ifexp((lambda?(make-procedure(lambda-parameters(lambda-bodyexp)((begin?

(eval-sequence(begin-actionsexp)env))((coexp(eval(cond->ifexpenv))((applicatione工作更方便(apply(eval(operatorexp)env)

(list-of-values(operandsexp)

(error"Unknownexpressiontype--EVAL" apply-primitive-procedure(define(applyprocedurearguments)(cond((primitive-procedure?procedure)(apply-primitive-procedureprocedurearguments))((compound-procedure?procedure)(eval-(procedure-bodyprocedure)(procedure-parametersprocedure)(procedure-environment(error"Unknownproceduretype--APPLY" eval(define(list-of-valuesexpsenv)(if(no-operands?exps)(cons(eval(first-operandexps)(list-of-values(rest-operandsexps) eval-if(define(eval-ifexp(if(true?(eval(if-predicateexp)env))(eval(if-consequentexp)env)(eval(if-alternativeexp)env)))true?(Scheme)里 (define(eval-assignmentexp(set-variable-value!(assignment-variable(eval(assignment-valueexp)env)(define(eval-definitionexp(define-variable!(definition-variable(eval(definition-valueexp)env)分別由! lambda體（過程體begincond(define(eval-sequenceexps(cond((last-exp?exps)(eval(first-expexps)env))(else(eval(first-expexps)env)(eval-sequence(rest-expsexps) (define(self-evaluating?exp)(cond((number?exp)true)((string?exp)true)(elsefalse)))(define(variable?exp)(symbol? (define(tagged-list?exptag)(if(pair?exp)(eq?(carexp)tag)(quotetext-of-quotation的語法過程:(define(quoted?exp)(tagged-list?exp'quote))(define(text-of-quotationexp)(cadrexp))(setvarvalue的語法過程(define(assignment?exp)(tagged-list?exp'set!))(define(assignment-variableexp)(cadrexp))(define(assignment-valueexp)(caddrexp)) 定義表達(dá)式有兩種形式：(define<var><value>)(define(<var><parameter1>...<parametern>)(define<var>(lambda(<parameter1>...<parametern>)(define(definition?exp)(tagged-list?exp'define))(define(definition-variableexp)(if(symbol?(cadr(cadrexp)(caadrexp)))(define(definition-valueexp)(if(symbol?(cadrexp))(caddr(make-lambda(cdadr ;formal(cddrexp)))); (define(lambda?exp)(tagged-list?exp'lambda))(define(lambda-parametersexp)(cadrexp))(define(lambda-bodyexp)(cddrexp))(define(make-lambdaparametersbody)(cons'lambda(consparametersbody))) (define(if?exp)(tagged-list?exp'if))(define(if-predicateexp)(cadrexp))(define(if-consequentexp)(caddrexp))(define(if-alternativeexp)(if(not(null?(cdddrexp)))(cadddrexp)if表達(dá)式的構(gòu)造函數(shù)（cond時(shí)要用(define(make-ifpredicateconsequentalternative)(list'ifpredicateconsequentalternative)) begin包裝一系列表達(dá)式，要求對(duì)它們順序求值：(define(begin?exp)(tagged-list?expbegin))(define(begin-actionsexp)(cdrexp))(define(last-exp?seq)(null?(cdrseq)))(define(first-expseq)(carseq))(define(rest-expsseq)(cdrsequence->exp（cond->if里），它把包含多個(gè)表達(dá)式的序列包裝為一個(gè)begin表達(dá)式：(define(sequence->expseq)(cond((null?seq)seq)((last-exp?seq)(first-expseq))(else(make-beginseq))))(define(make-beginseq)(cons'begin (define(application?exp)(pair?exp))(define(operatorexp)(carexp))(define(operandsexp)(cdrexp))(define(no-operands?ops)(null?ops))(define(first-operandops)(carops))(define(rest-operandsops)(cdrops))cond等 condifcond(define(cond?exp)(tagged-list?exp'cond))(define(cond-clausesexp)(cdrexp))(define(cond-else-clause?clause)(eq?(cond-predicateclause)'else))(define(cond-predicateclause)(carclause)) ;noelse(let((first(carclauses))(if(null?rest)(sequence->exp(cond-actionsfirst))(error"ELSEclauseisn'tlast--COND->IF"(expand-clausesrest)))))) false對(duì)象都當(dāng)作邏輯真(define(true?x)(not(eq?xfalse)))(define(false?x)(eq?xfalse))(apply-primitive-procedureproc><args>)(primitive-procedure?proc>)(define(make-procedureparametersbodyenv)(list'procedureparametersbodyenv))(define(compound-procedure?p)(tagged-list?p'procedure))(define(procedure-parametersp)(cadrp))(define(procedure-bodyp)(caddr(define(procedure-environmentp)(cadddr (lookup-variable-value<var>>>(extend-environment<variables><values><base->>(define-variable!<var><value><env<var<value(set-variable-value!<var><value>>>> (define(first-frameenv)(car(define(enclosing-environmentenv)(cdrenv))(definethe-empty-environment'())car是變量表，cdr(define(make-framevariablesvalues)(consvariablesvalues))(define(frame-variablesframe)(carframe))(define(frame-valuesframe)(cdr(define(add-binding-to-frame!varvalframe)(set-car!frame(consvar(carframe)))(set-cdr!frame(consval(cdr (define(extend-environmentvarsvalsbase-env)(if(=(lengthvars)(lengthvals))(cons(make-framevarsvals)base-env)(if(<(lengthvars)(lengthvals))(error"Toomanyargumentssupplied"varsvals)(error"Toofewargumentssupplied"varsvals)))) (define(lookup-variable-valuevarenv0)(define(env-loopenv)(define(scanvarsvals)(cond((null?vars)(env-loop(enclosing-environmentenv)))((eq?var(carvars))(carvals))(else(scan(cdrvars)(cdrvals)))))(if(eq?envthe-empty-environment)(error"Unboundvariable"var)(let((frame(first-frameenv)))(scan(frame-variablesframe)(frame-values(env-loop (define(set-variable-value!varvalenv0)(define(env-loopenv)(define(scanvarsvals)(cond((null?vars)(env-loop(enclosing-environmentenv)))((eq?var(carvars))(set-car!valsval))(else(scan(cdrvars)(cdrvals)))))(if(eq?envthe-empty-environment)(error"Unboundvariable--SET!"var)(let((frame(first-frameenv)))(scan(frame-variablesframe)(frame-valuesframe)))))(env-loopenv0)) (define(define-variable!varvalenv)(let((frame(first-frameenv)))(define(scanvarsvals)(cond((null?(add-binding-to-frame!varvalframe))((eq?var(carvars))(set-car!valsval))(else(scan(cdrvars)(cdr(scan(frame-variablesframe)(frame-values Scheme求值模型的一個(gè)嚴(yán)格描述（Scheme語eval在求值中能找到相應(yīng)過程對(duì)象并把它傳給apply聯(lián)，還需要包含true和false等符號(hào)（名字）的約束 (define(setup-environment)(let((initial-env(extend-environment(primitive-procedure-(define-variable!'truetrueinitial-env)(define-variable!'falsefalseinitial-env)(definethe-global-environment(setup-apply能識(shí)別這一類別，而后 (define(primitive-procedure?proc)(tagged-list?proc'primitive))(define(primitive-implementationproc)(cadrproc))(defineprimitive-procedures(list(list'carcar)(list'cdrcdr)(list'conscons)(list'null?<more(define(primitive-procedure-names)(mapcarprimitive-procedures))(define(primitive-procedure-(map(lambda(proc)(list'primitive(cadrproc))) (define(apply-primitive-procedureprocargs)(primitive-implementationproc)apply-in-underlying-schemeScheme(defineapply-in-underlying-schemeapply-primitive-procedure就可以調(diào)用到基礎(chǔ)系統(tǒng)里原來的apply基本過程 Scheme系統(tǒng)，給元循環(huán)求值器定義一個(gè)基本(defineinput-prompt";;;M-Eval(defineoutput-prompt";;;M-Evalvalue:")(define(driver-loop)(prompt-for-inputinput-prompt)(let((input(read)))(let((output(evalinputthe-global-environment)))(announce-outputoutput-prompt)(user-printoutput)))(define(prompt-for-input(newline)(newline)(displaystring)(define(announce-outputstring)(newline)(displaystring)(newline