[Axiom-developer] 20090417.02.wxh.patch (compiler use Waldek +-> syntax)

[daly]

Waldek has implemented changes to the spad compiler to use 
+-> rather than #1 for anonymous function syntax which makes
anonymous functions easier to understand. He helped by pointing
out the explicit revisions that contained the changes.

Bezier was updated to test and use Waldek notation.

=====================================================================
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)]
      
 @
 <<BEZIER.dotabb>>=
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<br/>
 bookvol5 move more interpreter code<br/>
 <a href="patches/20090416.03.tpd.patch">20090416.03.tpd.patch</a>
 bookvol10.4 update bezier documentation<br/>
-<a href="patches/20090416.03.tpd.patch">20090416.03.tpd.patch</a>
+<a href="patches/20090417.01.tpd.patch">20090417.01.tpd.patch</a>
 bookvol10.4, 10.2 document binomial<br/>
+<a href="patches/20090417.02.tpd.patch">20090417.02.tpd.patch</a>
+compiler use waldek +-> syntax <br/>
  </body>
 </html>
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|)
 <<clip1>>
   (|add| |compAdd|)