diff --git a/books/bookvol10.4.pamphlet b/books/bookvol10.4.pamphlet index 4537e98..885f2c7 100644 --- a/books/bookvol10.4.pamphlet +++ b/books/bookvol10.4.pamphlet @@ -5341,17 +5341,17 @@ Bezier(R:Ring): with ++X [n(t/10.0) for t in 0..10 by 1] == add linearBezier(a,b) == - [(1-#1)*(a.1) + #1*(b.1), (1-#1)*(a.2) + #1*(b.2)] + t +-> [(1-t)*(a.1) + t*(b.1), (1-t)*(a.2) + t*(b.2)] quadraticBezier(a,b,c) == - [(1-#1)**2*(a.1) + 2*#1*(1-#1)*(b.1) + (#1)**2*(c.1), - (1-#1)**2*(a.2) + 2*#1*(1-#1)*(b.2) + (#1)**2*(c.2)] + t +-> [(1-t)**2*(a.1) + 2*t*(1-t)*(b.1) + t**2*(c.1), + (1-t)**2*(a.2) + 2*t*(1-t)*(b.2) + t**2*(c.2)] cubicBezier(a,b,c,d) == - [(1-#1)**3*(a.1) + 3*(#1)*(1-#1)**2*(b.1) - + 3*(#1)**2*(1-#1)*(c.1) + (#1)**3*(d.1), - (1-#1)**3*(a.2) + 3*(#1)*(1-#1)**2*(b.2) - + 3*(#1)**2*(1-#1)*(c.2) + (#1)**3*(d.2)] + t +-> [(1-t)**3*(a.1) + 3*t*(1-t)**2*(b.1) + + 3*t**2*(1-t)*(c.1) + t**3*(d.1), + (1-t)**3*(a.2) + 3*t*(1-t)**2*(b.2) + + 3*t**2*(1-t)*(c.2) + t**3*(d.2)] @ <>= diff --git a/changelog b/changelog index fed1b33..6a34a9a 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,9 @@ +20090417 tpd src/axiom-website/patches.html 20090417.02.tpd.patch +20090417 tpd books/bookvol10.4 add +-> handling +20090417 wxh src/interp/define.boot add +-> handling +20090417 wxh src/interp/newaux.lisp add +-> handling +20090417 wxh src/interp/property.lisp add +-> handling +20090417 wxh src/interp/compiler.boot add +-> handling 20090417 tpd src/axiom-website/patches.html 20090417.01.tpd.patch 20090417 tpd src/algebra/Makefile add help, regression tests 20090417 tpd books/bookvol10.4 document binomial diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index d8cd037..1adb0e9 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1094,7 +1094,9 @@ regress.lisp tighten checks on regression tests
bookvol5 move more interpreter code
20090416.03.tpd.patch bookvol10.4 update bezier documentation
-20090416.03.tpd.patch +20090417.01.tpd.patch bookvol10.4, 10.2 document binomial
+20090417.02.tpd.patch +compiler use waldek +-> syntax
diff --git a/src/interp/compiler.boot.pamphlet b/src/interp/compiler.boot.pamphlet index d1be1e7..fbf3c53 100644 --- a/src/interp/compiler.boot.pamphlet +++ b/src/interp/compiler.boot.pamphlet @@ -257,19 +257,77 @@ hasFormalMapVariable(x, vl) == hasone? x == MEMQ(x,$formalMapVariables) @ +\subsection{argsToSig} +<<*>>= +argsToSig(args) == + args is [":",v,t] => [[v],[t]] + sig1:=[] + arg1:=[] + bad:=false + for arg in args repeat + arg is [":",v,t] => + sig1:=[t,:sig1] + arg1:=[v,:arg1] + bad:=true + bad=>[nil,nil] + [REVERSE(arg1),REVERSE(sig1)] + +@ +\subsection{compLambda} +<<*>>= +compLambda(x is ["+->",vl,body],m,e) == + vl is [":",args,target] => + args:= + args is ["Tuple",:a1] => a1 + args + LISTP(args) => + [arg1,sig1]:=argsToSig(args) + sig1 => + ress:=compAtSign(["@",["+->",arg1,body],["Mapping",target,:sig1]],m,e) + ress + stackAndThrow["compLambda",x] + stackAndThrow["compLambda",x] + stackAndThrow["compLambda",x] + +@ \subsection{compWithMappingMode} <<*>>= -compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) == +compWithMappingMode(x,m,oldE) == + compWithMappingMode1(x,m,oldE,$formalArgList) + +@ +\subsection{compWithMappingMode1} +<<*>>= +compWithMappingMode1(x,m is ["Mapping",m',:sl],oldE,$formalArgList) == $killOptimizeIfTrue: local:= true e:= oldE isFunctor x => if get(x,"modemap",$CategoryFrame) is [[[.,target,:argModeList],.],:.] and - (and/[extendsCategoryForm("$",s,mode) for mode in argModeList for s in sl] - ) and extendsCategoryForm("$",target,m') then return [x,m,e] + (and/[extendsCategoryForm("$",s,mode) for mode in argModeList for s in sl] + ) and extendsCategoryForm("$",target,m') then return [x,m,e] if STRINGP x then x:= INTERN x - for m in sl for v in (vl:= take(#sl,$FormalMapVariableList)) repeat + ress:=nil + old_style:=true + if x is ["+->",vl,nx] then + old_style:=false + vl is [":",:.] => + ress:=compLambda(x,m,oldE) + ress + vl:= + vl is ["Tuple",:vl1] => vl1 + vl + vl:= + SYMBOLP(vl) => [vl] + LISTP(vl) and (and/[SYMBOLP(v) for v in vl]) => vl + stackAndThrow ["bad +-> arguments:",vl] + $formatArgList:=[:vl,:$formalArgList] + x:=nx + else + vl:=take(#sl,$FormalMapVariableList) + ress => ress + for m in sl for v in vl repeat [.,.,e]:= compMakeDeclaration([":",v,m],$EmptyMode,e) - not null vl and not hasFormalMapVariable(x, vl) => return + old_style and not null vl and not hasFormalMapVariable(x, vl) => return [u,.,.] := comp([x,:vl],m',e) or return nil extractCodeAndConstructTriple(u, m, oldE) null vl and (t := comp([x], m', e)) => return @@ -328,20 +386,14 @@ compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) == ['LAMBDA,[:vl,vec], :CDDR expandedFunction] scode:=nil vec:=nil - slist:=nil locals:=nil i:=-1 for v in frees repeat i:=i+1 vec:=[first v,:vec] - rest v = 1 => - --Only used once - slist:=[[first v,($QuickCode => 'QREFELT;'ELT),"$$",i],:slist] scode:=[['SETQ,first v,[($QuickCode => 'QREFELT;'ELT),"$$",i]],:scode] locals:=[first v,:locals] - body:= - slist => SUBLISNQ(slist,CDDR expandedFunction) - CDDR expandedFunction + body:=CDDR expandedFunction if locals then if body is [['DECLARE,:.],:.] then body:=[CAR body,['PROG,locals,:scode,['RETURN,['PROGN,:CDR body]]]] diff --git a/src/interp/define.boot.pamphlet b/src/interp/define.boot.pamphlet index 0f2dc03..08a5310 100644 --- a/src/interp/define.boot.pamphlet +++ b/src/interp/define.boot.pamphlet @@ -88,6 +88,9 @@ compDefine1(form,m,e) == (sig:= getSignatureFromMode(lhs,e)) => -- here signature of lhs is determined by a previous declaration compDefine1(['DEF,lhs,[first sig,:rest signature],specialCases,rhs],m,e) + $insideCapsuleFunctionIfTrue => + --stackAndThrow ["Internal functions unsupported:",form] + compInternalFunction(form,m,e) if signature.target=$Category then $insideCategoryIfTrue:= true --?? following 3 lines seem bogus, BMT 6/23/93 --? if signature.target is ['Mapping,:map] then @@ -765,6 +768,20 @@ orderByDependency(vl,dl) == vl:= vl' dl:= dl' REMDUP NREVERSE orderedVarList --ordered so ith is indep. of jth if i < j + +compInternalFunction(df is ['DEF,form,signature,specialCases,body],m,e) == + -- $insideExpressionIfTrue:=false + [op,:argl]:=form + not(IDENTP(op)) => + stackAndThrow ["Bad name for internal function:",op] + #argl=0 => + stackAndThrow ["Argumentless internal functions unsupported:",op] + --nf:=["where",["LET",[":",op,["Mapping",:signature]],nbody],_ + -- :whereList1,:whereList2] + nbody:=["+->",argl,body] + nf:=["LET",[":",op,["Mapping",:signature]],nbody] + ress:=comp(nf,m,e) + ress compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body], m,oldE,$prefix,$formalArgList) == diff --git a/src/interp/newaux.lisp.pamphlet b/src/interp/newaux.lisp.pamphlet index 11295fb..ce51b7b 100644 --- a/src/interp/newaux.lisp.pamphlet +++ b/src/interp/newaux.lisp.pamphlet @@ -102,7 +102,7 @@ (/\\ 250 251) (\\/ 200 201) (\.\. SEGMENT 401 699 (|PARSE-Seg|)) (=\> 123 103) - (+-\> 998 102) + (+-\> 995 112) (== DEF 122 121) (==\> MDEF 122 121) (\| 108 111) ;was 190 190 diff --git a/src/interp/property.lisp.pamphlet b/src/interp/property.lisp.pamphlet index 095310b..8844c08 100644 --- a/src/interp/property.lisp.pamphlet +++ b/src/interp/property.lisp.pamphlet @@ -574,6 +574,7 @@ We have a similar problem with the control-G character. (\@ |compAtSign|) (|:| |compColon|) (\:\: |compCoerce|) + (|+->| |compLambda|) (QUOTE |compQuote|) <> (|add| |compAdd|)