remove pamphlets - part 6

1 files changed, 0 insertions, 967 deletions

diff --git a/src/interp/newfort.boot.pamphlet b/src/interp/newfort.boot.pamphlet
deleted file mode 100644
index b5720292..00000000
--- a/src/interp/newfort.boot.pamphlet
+++ /dev/null
@@ -1,967 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-\begin{document}
-\title{\$SPAD/src/interp newfort.boot}
-\author{The Axiom Team}
-\maketitle
-\begin{abstract}
-\end{abstract}
-\eject
-\tableofcontents
-\eject
-\section{License}
-<<license>>=
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
---
--- Redistribution and use in source and binary forms, with or without
--- modification, are permitted provided that the following conditions are
--- met:
---
---     - Redistributions of source code must retain the above copyright
---       notice, this list of conditions and the following disclaimer.
---
---     - Redistributions in binary form must reproduce the above copyright
---       notice, this list of conditions and the following disclaimer in
---       the documentation and/or other materials provided with the
---       distribution.
---
---     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
---       names of its contributors may be used to endorse or promote products
---       derived from this software without specific prior written permission.
---
--- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-@
-<<*>>=
-<<license>>
-
---% Translation of Expression to FORTRAN
-assignment2Fortran1(name,e) ==
-  $fortError : fluid := nil
-  checkLines fortran2Lines statement2Fortran ["=",name,e]
-
-integerAssignment2Fortran1(name,e) ==
-  $fortError : fluid := nil
-  $fortInts2Floats : fluid := nil
-  checkLines fortran2Lines statement2Fortran ["=",name,e]
-
-statement2Fortran e ==
-  -- takes an object of type Expression and returns a list of
-  -- strings. Any part of the expression which is a list starting
-  -- with 'FORTRAN is merely passed on in the list of strings. The
-  -- list of strings may contain '"%l".
-  -- This is used when formatting e.g. a DO loop from Lisp
-  $exp2FortTempVarIndex : local := 0
-  $fortName : fluid := "DUMMY"
-  $fortInts2Floats : fluid := nil
-  fortranCleanUp exp2Fort1 segment fortPre exp2FortOptimize outputTran e
-
-expression2Fortran e ==
-  -- takes an object of type Expression and returns a list of
-  -- strings. Any part of the expression which is a list starting
-  -- with 'FORTRAN is merely passed on in the list of strings. The
-  -- list of strings may contain '"%l".
-  $exp2FortTempVarIndex : local := 0
-  $fortName : fluid := newFortranTempVar()
-  $fortInts2Floats : fluid := nil
-  fortranCleanUp exp2Fort1 segment fortPre exp2FortOptimize outputTran e
-
-expression2Fortran1(name,e) ==
-  -- takes an object of type Expression and returns a list of
-  -- strings. Any part of the expression which is a list starting
-  -- with 'FORTRAN is merely passed on in the list of strings. The
-  -- list of strings may contain '"%l".
-  $exp2FortTempVarIndex : local := 0
-  $fortName : fluid := name
-  fortranCleanUp exp2Fort1 segment fortPre exp2FortOptimize outputTran e
-
-newFortranTempVar() ==
-  $exp2FortTempVarIndex := 1 + $exp2FortTempVarIndex
-  newVar := INTERN STRCONC('"T",STRINGIMAGE $exp2FortTempVarIndex)
-  updateSymbolTable(newVar,$defaultFortranType)
-  newVar
- 
-fortranCleanUp l ==
-  -- takes reversed list and cleans up a bit, putting it in
-  -- correct order
-  oldTok := NIL
-  m := NIL
-  for e in l repeat
-    if not (oldTok = '"-" and e = '"+") then m := [e,:m]
-    oldTok := e
-  m
- 
-exp2Fort1 l ==
-  s := nil
-  for e in l repeat s := [:exp2Fort2(e,0,nil),:s]
-  s
- 
-exp2Fort2(e,prec,oldOp) ==
-  null e    => nil
-  atom e    => [object2String e]
-  e is [ "=",lhs,rhs] or e is [ '"=",lhs,rhs] =>
-    ['"%l",:exp2Fort2(rhs,prec,'"="),'"=",:exp2Fort2(lhs,prec,'"=")]
- 
-  unaryOps    := ['"-",'"^",'"~"]
-  unaryPrecs  := [700,260,50]
-  binaryOps   := ['"|",'"**",'"/",'".LT.",'".GT.",'".EQ.",'".LE.",'".GE.", _
-                  '"OVER",'".AND.",'".OR."]
-  binaryPrecs := [0, 900, 800, 400, 400, 400, 400, 400, 800, 70, 90]
-  naryOps     := ['"-",'"+",'"*",'",",'" ",'"ROW",'""]
-  naryPrecs   := [700,  700, 800,  110,   0,     0,  0]
-  nonUnaryOps := append(binaryOps,naryOps)
-  [op,:args] := e
-  op := object2String op
-  nargs := #args
-  nargs = 0 => exp2FortFn(op,args,0)
-  nargs = 1 =>
-    (p := position(op,unaryOps)) > -1 =>
-      nprec := unaryPrecs.p
-      s := [:exp2Fort2(first args,nprec,op),op]
-      op = '"-" and atom first args => s
-      op = oldOp and op in ['"*",'"+"] => s
-      nprec <= prec => ['")",:s,'"("]
-      s
-    exp2FortFn(op,args,nargs)
-  op = '"CMPLX" =>
-    ['")",:exp2Fort2(SECOND args, prec, op),'",",:exp2Fort2(first args,prec,op),'"("]
-  member(op,nonUnaryOps) =>
-    if nargs > 0 then arg1 := first args
-    nargs = 1 and op in '("+" "*") => exp2Fort2(arg1,prec,op)
-    if nargs > 1 then arg2 := first rest args
-    p := position(op,binaryOps)
-    if p = -1
-      then
-        p := position(op,naryOps)
-        nprec := naryPrecs.p
-      else nprec := binaryPrecs.p
-    s := nil
-    for arg in args repeat
-      op = '"+" and (arg is [m,a]) and m in '(_- "=") =>
-        if not s then s := ['junk]
-        s:= [op,:exp2Fort2(a,nprec,op),'"-",:rest s]
-      s := [op,:exp2Fort2(arg,nprec,op),:s]
-    s := rest s
-    op = oldOp and op in ['"*",'"+"] => s
-    nprec <= prec => ['")",:s,'"("]
-    s
-  exp2FortFn(op,args,nargs)
- 
- 
-exp2FortFn(op,args,nargs) ==
-  s := ['"(",op]
-  while args repeat
-    s := ['",",:exp2Fort2(first args,0,op),:s]
-    args := rest args
-  if nargs > 0 then ['")",:rest s]
-  else ['")",:s]
- 
- 
---% Optimization of Expression
- 
-exp2FortOptimize e ==
-  -- $fortranOptimizationLevel means:
-  --   0         just extract arrays
-  --   1         extract common subexpressions
-  --   2         try to optimize computing of powers
-  $exprStack : local := NIL
-  atom e => [e]
-  $fortranOptimizationLevel = 0 =>
-    e1 := exp2FortOptimizeArray e
-    NREVERSE [e1,:$exprStack]
-  e := minimalise e
-  for e1 in exp2FortOptimizeCS  e repeat
-    e2 := exp2FortOptimizeArray e1
-    $exprStack := [e2,:$exprStack]
-  NREVERSE $exprStack
-
- 
-exp2FortOptimizeCS e ==
-  $fortCsList : local := NIL
-  $fortCsHash : local := MAKE_-HASHTABLE 'EQ
-  $fortCsExprStack : local := NIL
-  $fortCsFuncStack : local := NIL
-  f := exp2FortOptimizeCS1 e
-  NREVERSE [f,:$fortCsList]
- 
--- bug fix to beenHere 
--- Thu Nov 05 12:01:46 CUT 1992 , Author: TTT
--- Used in exp2FortOprtimizeCS 
--- Original file : newfort.boot
-beenHere(e,n) ==
-  n.0 := n.0 + 1                      -- increase count (initially 1)
-  n.0 = 2 =>                          -- first time back again
-    var := n.1 := newFortranTempVar() -- stuff n.1 with new var
-    exprStk := n.2                    -- get expression
-    if exprStk then
--- using COPY-TREE : RPLAC does not smash $fortCsList
--- which led to inconsistencies in assignment of temp. vars.
-      $fortCsList := COPY_-TREE [['"=",var,e],:$fortCsList]
-      loc := CAR exprStk
-      fun := CAR n.3
-      fun = 'CAR =>
-        RPLACA(loc,var)
-      fun = 'CDR =>
-        if PAIRP QCDR loc
-          then RPLACD(loc,[var])
-          else RPLACD(loc,var)
-      SAY '"whoops"
-    var
-  n.1                     -- been here before, so just get variable
-
-
-exp2FortOptimizeCS1 e ==
-  -- we do nothing with atoms or simple lists containing atoms
-  atom(e) or (atom first e and null rest e) => e
-  e is [op,arg] and object2Identifier op = "-" and atom arg => e
-
-  -- see if we have been here before
-  not (object2Identifier QCAR e in '(ROW AGGLST)) and
-    (n := HGET($fortCsHash,e)) => beenHere(e,n) -- where
-
-  -- descend sucessive CARs of CDRs of e
-  f := e
-  while f repeat
-    pushCsStacks(f,'CAR) where pushCsStacks(x,y) ==
-      $fortCsExprStack := [x,:$fortCsExprStack]
-      $fortCsFuncStack := [y,:$fortCsFuncStack]
-    RPLACA(f,exp2FortOptimizeCS1 QCAR f)
-    popCsStacks(0) where popCsStacks(x) ==
-      $fortCsFuncStack := QCDR $fortCsFuncStack
-      $fortCsExprStack := QCDR $fortCsExprStack
-    g := QCDR f
-    -- check to see of we have an non-NIL atomic CDR
-    g and atom g =>
-      pushCsStacks(f,'CDR)
-      RPLACD(f,exp2FortOptimizeCS1 g)
-      popCsStacks(0)
-      f := NIL
-    f := g
-
-  MEMQ(object2Identifier QCAR e,'(ROW AGGLST)) => e
-
-  -- see if we have already seen this expression
-  n := HGET($fortCsHash,e)
-  null n =>
-    n := VECTOR(1,NIL,$fortCsExprStack,$fortCsFuncStack)
-    HPUT($fortCsHash,e,n)
-    e
-  beenHere(e,n)
-
-
- 
-exp2FortOptimizeArray e ==
-  -- this handles arrays
-  atom e => e
-  [op,:args] := e
-  op1 := object2Identifier op
-  op1 in '(BRACE BRACKET) =>
-    args is [['AGGLST,:elts]] =>
-      LISTP first elts and first first elts in '(BRACE BRACKET) => fortError1 e
-      -- var := newFortranTempVar()
-      var := $fortName
-      $exprStack := [[op,var,['AGGLST,:exp2FortOptimizeArray elts]],
-        :$exprStack]
-      var
-  EQ(op1,'MATRIX) =>
-    -- var := newFortranTempVar()
-    var := $fortName
-    -- args looks like [NIL,[ROW,...],[ROW,...]]
-    $exprStack := [[op,var,:exp2FortOptimizeArray args],:$exprStack]
-    var
-  [exp2FortOptimizeArray op,:exp2FortOptimizeArray args]
-
- 
---% FORTRAN Line Breaking
- 
-fortran2Lines f ==
-  -- f is a list of strings
-  -- returns: a list of strings where each string is a valid
-  -- FORTRAN line in fixed form
- 
-  -- collect strings up to first %l or end of list. Then feed to
-  -- fortran2Lines1.
-  fs := NIL
-  lines := NIL
-  while f repeat
-    while f and (ff := first(f)) ^= '"%l" repeat
-      fs := [ff,:fs]
-      f := rest f
-    if f and first(f) = '"%l" then f := rest f
-    lines := append(fortran2Lines1 nreverse fs,lines)
-    fs := nil
-  nreverse lines
- 
-fortran2Lines1 f ==
-  -- f is a list of strings making up 1 FORTRAN statement
-  -- return: a reverse list of FORTRAN lines
-  normPref := MAKE_-STRING($fortIndent)
-  --contPref := STRCONC(MAKE_-STRING($fortIndent-1),"&")
-  contPref := STRCONC("     &",MAKE_-STRING($fortIndent-6))
-  lines := NIL
-  ll := $fortIndent
-  while f repeat
-    ok := true
-    line := normPref
-    ff := first f
-    while ok repeat
-      (ll + (sff := SIZE ff)) <= $fortLength =>
-        ll := ll + sff
-        line := STRCONC(line,ff)
-        f := rest f
-        if f then ff := first f
-        else ok := nil
-      -- fill the line out to exactly $fortLength spaces if possible by splitting
-      -- up symbols.  This is helpful when doing the segmentation
-      -- calculations, and also means that very long strings (e.g. numbers
-      -- with more than $fortLength-$fortIndent digits) are printed in a
-      -- legal format. MCD
-      if (ll < $fortLength) and (ll + sff) > $fortLength then
-        spaceLeft := $fortLength - ll
-        line := STRCONC(line,SUBSEQ(ff,0,spaceLeft))
-        ff := SUBSEQ(ff,spaceLeft)
-      lines := [line,:lines]
-      ll := $fortIndent
-      line := contPref
-    if ll > $fortIndent then lines := [line,:lines]
-  lines
- 
--- The Fortran error functions
-fortError1 u ==
-  $fortError := "t"
-  sayErrorly("Fortran translation error",
-             "   No corresponding Fortran structure for:")
-  mathPrint u
- 
-fortError(u,v) ==
-  $fortError := "t"
-  msg := STRCONC("   ",STRINGIMAGE u);
-  sayErrorly("Fortran translation error",msg)
-  mathPrint v
- 
---% Top Level Things to Call
--- The names are the same as those used in the old fortran code
-
-dispStatement x ==
-  $fortError : fluid := nil
-  displayLines fortran2Lines statement2Fortran x
-
-
-getStatement(x,ints2Floats?) ==
-  $fortInts2Floats : fluid := ints2Floats?
-  $fortError : fluid := nil
-  checkLines fortran2Lines statement2Fortran x
-
-fortexp0 x ==
-  f := expression2Fortran x
-  p := position('"%l",f)
-  p < 0 => f
-  l := NIL
-  while p < 0 repeat
-    [t,:f] := f
-    l := [t,:l]
-  NREVERSE ['"...",:l]
- 
-dispfortexp x ==
-  if atom(x) or x is [op,:.] and not object2Identifier op in
-    '(_= MATRIX construct ) then
-      var := INTERN STRCONC('"R",object2String $IOindex)
-      x := ['"=",var,x]
-  dispfortexp1 x
- 
-dispfortexpf (xf, fortranName) ==
-  $fortError : fluid := nil
-  linef := fortran2Lines BUTLAST(expression2Fortran1(fortranName,xf),2)
-  displayLines linef
-
-dispfortexpj (xj, fortranName) ==
-  $fortName : fluid := fortranName
-  $fortError : fluid := nil
-  linej := fortran2Lines BUTLAST(expression2Fortran1(fortranName,xj),2)
-  displayLines linej
-
-
-dispfortexp1 x ==
-  $fortError : fluid := nil
-  displayLines fortran2Lines expression2Fortran x
-
-getfortexp1 x ==
-  $fortError : fluid := nil
-  checkLines fortran2Lines expression2Fortran x
-
-displayLines1 lines ==
-  for l in lines repeat
-    PRINTEXP(l,$fortranOutputStream)
-    TERPRI($fortranOutputStream)
-
-displayLines lines ==
-  if not $fortError then displayLines1 lines
- 
-checkLines lines ==
-  $fortError => []
-  lines
-
-dispfortarrayexp (fortranName,m) ==
-  $fortError : fluid := nil
-  displayLines fortran2Lines BUTLAST(expression2Fortran1(fortranName,m),2)
-
-getfortarrayexp(fortranName,m,ints2floats?) ==
-  $fortInts2Floats : fluid := ints2floats?
-  $fortError : fluid := nil
-  checkLines fortran2Lines BUTLAST(expression2Fortran1(fortranName,m),2)
-
- 
--- Globals
-$currentSubprogram := nil
-$symbolTable := nil
- 
-
-
---fix [x,exp x]
- 
------------- exp2FortSpecial.boot --------------------
- 
-exp2FortSpecial(op,args,nargs) ==
-  op = "CONCAT" and first args in ["<",">","<=",">=","~","and","or"] =>
-    mkFortFn(first args,CDADAR rest args,#(CDADAR rest args))
-  op = "CONCAT" and CADR(args)="EQ" =>
-    mkFortFn("EQ",[first args, CADDR args],2)
-  --the next line is NEVER used by FORTRAN code but is needed when
-  --  called to get a linearized form for the browser
-  op = "QUOTE" =>
-    atom (arg := first args) => STRINGIMAGE arg
-    tailPart := "STRCONC"/[STRCONC('",",x) for x in rest arg]
-    STRCONC('"[",first arg,tailPart,'"]")
-  op = "PAREN" =>
-    args := first args
-    not(first(args)="CONCATB") => fortError1 [op,:args]
-    -- Have a matrix element
-    mkMat(args)
-  op = "SUB" =>
-    $fortInts2Floats : fluid := nil
-    mkFortFn(first args,rest args,#(rest args))
-  op in ["BRACE","BRACKET"] =>
-    args is [var,['AGGLST,:elts]] =>
-      var := object2String var
-      si := $fortranArrayStartingIndex
-      hidim := #elts - 1 + si
-      if LISTP first elts and #elts=1 and first elts is [sOp,:sArgs] then
-        sOp in ['"SEGMENT","SEGMENT"] =>
-          #sArgs=1 => fortError1 first elts
-          not(NUMBERP(first sArgs) and NUMBERP(SECOND sArgs)) =>
-            fortError("Cannot expand segment: ",first elts)
-          first sArgs > SECOND sArgs => fortError1
-            '"Lower bound of segment exceeds upper bound."
-          for e in first sArgs .. SECOND sArgs for i in si.. repeat
-            $exprStack := [["=",[var,object2String i],fortPre1(e)],:$exprStack]
-      for e in elts for i in si.. repeat
-        $exprStack := [["=",[var,object2String i],fortPre1(e)],:$exprStack]
-    fortError1 [op,:args]
-  op in ["CONCAT","CONCATB"] =>
-    nargs = 0 => NIL
-    nargs = 1 => fortPre1 first args
-    nargs = 2 and first rest args in ["!",'"!"] =>
-      mkFortFn("FACTORIAL",[first args],1)
-    fortError1 [op,:args]
-  op in ['"MATRIX","MATRIX"] =>
-    args is [var, =NIL,:rows] =>
-      var := object2String var
-      nrows := #rows - 1
-      ncols := #(rest first rows) - 1
-      si := $fortranArrayStartingIndex
-      for r in rows for rx in si.. repeat
-        for c in rest r for cx in si.. repeat
-          $exprStack := [["=",[var,object2String rx,object2String cx],
-                          fortPre1(c)],:$exprStack]
-    fortError1 [op,:args]
-  fortError1 [op,:args]
-
-mkMat(args) ==
-  $fortInts2Floats : fluid := nil
-  mkFortFn(first rest args,rest rest args,#(rest rest args))
-
- 
-mkFortFn(op,args,nargs) ==
-  [fortranifyFunctionName(STRINGIMAGE op,nargs), 
-   :MAPCAR(function fortPre1 , args) ]
- 
-fortranifyFunctionName(op,nargs) ==
-  op = '"<" => '".LT."
-  op = '">" => '".GT."
-  op = '"<=" => '".LE."
-  op = '">=" => '".GE."
-  op = '"EQ" => '".EQ."
-  op = '"and" => '".AND."
-  op = '"or" => '".OR."
-  op = '"~" => '".NOT."
-  fortranifyIntrinsicFunctionName(op,nargs)
-
-fortranifyIntrinsicFunctionName(op,nargs) ==
-  $useIntrinsicFunctions =>
-    intrinsic := if op = '"acos" then '"ACOS"
-    else if op = '"asin" then '"ASIN"
-    else if op = '"atan" then
-      nargs = 2 => '"ATAN2"
-      '"ATAN"
-    else if op = '"cos" then '"COS"
-    else if op = '"cosh" then '"COSH"
-    else if op = '"cot" then '"COTAN"
-    else if op = '"erf" then '"ERF"
-    else if op = '"exp" then '"EXP"
-    else if op = '"log" then '"LOG"
-    else if op = '"log10" then '"LOG10"
-    else if op = '"sin" then '"SIN"
-    else if op = '"sinh" then '"SINH"
-    else if op = '"sqrt" then '"SQRT"
-    else if op = '"tan" then '"TAN"
-    else if op = '"tanh" then '"TANH"
-    intrinsic =>
-      $intrinsics := ADJOIN(intrinsic,$intrinsics)
-      intrinsic
-    op
-  $fortranPrecision = 'double =>
-    op = '"acos" => '"DACOS"
-    op = '"asin" => '"DASIN"
-    op = '"atan" =>
-      nargs = 2 => '"DATAN2"
-      '"DATAN"
-    op = '"cos" => '"DCOS"
-    op = '"cosh" => '"DCOSH"
-    op = '"cot" => '"DCOTAN"
-    op = '"erf" => '"DERF"
-    op = '"exp" => '"DEXP"
-    op = '"log" => '"DLOG"
-    op = '"log10" => '"DLOG10"
-    op = '"sin" => '"DSIN"
-    op = '"sinh" => '"DSINH"
-    op = '"sqrt" => '"DSQRT"
-    op = '"tan" => '"DTAN"
-    op = '"tanh" => '"DTANH"
-    op = '"abs" => '"DABS"
-    op
-  op = '"acos" => '"ACOS"
-  op = '"asin" => '"ASIN"
-  op = '"atan" =>
-    nargs = 2 => '"ATAN2"
-    '"ATAN"
-  op = '"cos" => '"COS"
-  op = '"cosh" => '"COSH"
-  op = '"cot" => '"COTAN"
-  op = '"erf" => '"ERF"
-  op = '"exp" => '"EXP"
-  op = '"log" => '"ALOG"
-  op = '"log10" => '"ALOG10"
-  op = '"sin" => '"SIN"
-  op = '"sinh" => '"SINH"
-  op = '"sqrt" => '"SQRT"
-  op = '"tan" => '"TAN"
-  op = '"tanh" => '"TANH"
-  op = '"abs" => '"ABS"
-  op
-
---------------------------format.boot------------------------------------------
-
--- These functions are all used by FortranCode and FortranProgram.
--- Those used by FortranCode have been changed to return a list of
--- lines rather than print them directly, thus allowing us to catch
--- and display type declarations for temporary variables.
---  MCD 25/3/93
-
-indentFortLevel(i) ==
-  $maximumFortranExpressionLength := $maximumFortranExpressionLength -2*i
-  $fortIndent := $fortIndent + 2*i
-
-changeExprLength(i) ==>
-  $maximumFortranExpressionLength := $maximumFortranExpressionLength + i
-
-fortFormatDo(var,lo,hi,incr,lab) ==
-  $fortError : fluid := nil
-  $fortInts2Floats : fluid := nil
-  incr=1 =>
-    checkLines fortran2Lines
-      ['"DO ",STRINGIMAGE lab,'" ",STRINGIMAGE var,'"=",:statement2Fortran lo,_
-       '",", :statement2Fortran hi]
-  checkLines fortran2Lines
-    ['"DO ",STRINGIMAGE lab,'" ",STRINGIMAGE var,'"=",:statement2Fortran lo,_
-     '",", :statement2Fortran hi,'",",:statement2Fortran incr]
-
-fortFormatIfGoto(switch,label) ==
-  changeExprLength(-8) -- Leave room for IF( ... )GOTO
-  $fortError : fluid := nil
-  if first(switch) = "NULL" then switch := first rest switch
-  r := nreverse statement2Fortran switch
-  changeExprLength(8)
-  l := ['")GOTO ",STRINGIMAGE label]
-  while r and not(first(r) = '"%l") repeat
-    l := [first(r),:l]
-    r := rest(r)
-  checkLines fortran2Lines nreverse [:nreverse l,'"IF(",:r]
-
-fortFormatLabelledIfGoto(switch,label1,label2) ==
-  changeExprLength(-8) -- Leave room for IF( ... )GOTO
-  $fortError : fluid := nil
-  if LISTP(switch) and first(switch) = "NULL" then switch := first rest switch
-  r := nreverse statement2Fortran switch
-  changeExprLength(8)
-  l := ['")GOTO ",STRINGIMAGE label2]
-  while r and not(first(r) = '"%l") repeat
-    l := [first(r),:l]
-    r := rest(r)
-  labString := STRINGIMAGE label1
-  for i in #(labString)..5 repeat labString := STRCONC(labString,'" ")
-  lines := fortran2Lines nreverse [:nreverse l,'"IF(",:r]
-  lines := [STRCONC(labString,SUBSEQ(first lines,6)),:rest lines]
-  checkLines lines
-
-fortFormatIf(switch) ==
-  changeExprLength(-8) -- Leave room for IF( ... )THEN
-  $fortError : fluid := nil
-  if LISTP(switch) and first(switch) = "NULL" then switch := first rest switch
-  r := nreverse statement2Fortran switch
-  changeExprLength(8)
-  l := ['")THEN"]
-  while r and not(first(r) = '"%l") repeat
-    l := [first(r),:l]
-    r := rest(r)
-  checkLines fortran2Lines nreverse [:nreverse l,'"IF(",:r]
-
-fortFormatElseIf(switch) ==
-  -- Leave room for IF( ... )THEN
-  changeExprLength(-12)
-  $fortError : fluid := nil
-  if LISTP(switch) and first(switch) = "NULL" then switch := first rest switch
-  r := nreverse statement2Fortran switch
-  changeExprLength(12)
-  l := ['")THEN"]
-  while r and not(first(r) = '"%l") repeat
-    l := [first(r),:l]
-    r := rest(r)
-  checkLines fortran2Lines nreverse [:nreverse l,'"ELSEIF(",:r]
-
-fortFormatHead(returnType,name,args) ==
-  $fortError : fluid := nil
-  $fortranSegment : fluid := nil
-  -- if returnType = '"_"_(_)_"" then 
-  if returnType = '"void" then
-    asp := ['"SUBROUTINE "]
-    changeExprLength(l := -11)
-  else
-    asp := [s := checkType STRINGIMAGE returnType,'" FUNCTION "]
-    changeExprLength(l := -10-LENGTH(s))
-  displayLines fortran2Lines [:asp,:statement2Fortran [name,:CDADR args] ]
-  changeExprLength(-l)
-
-checkType ty ==
-  ty := STRING_-UPCASE STRINGIMAGE ty
-  $fortranPrecision = "double" =>
-    ty = '"REAL" => '"DOUBLE PRECISION"
-    ty = '"COMPLEX" => '"DOUBLE COMPLEX"
-    ty
-  ty
-
-mkParameterList l ==
-  [par2string(u) for u in l] where par2string u ==
-      atom(u) => STRINGIMAGE u
-      u := rest first rest u
-      apply('STRCONC,[STRINGIMAGE(first u),'"(",_
-               :rest [:['",",:statement2Fortran(v)] for v in rest u],'")"])
-
-nameLen n ==>
- +/[1+LENGTH(u) for u in n]
-
-fortFormatTypes(typeName,names) ==
-  null names => return()
-  $fortError : fluid := nil
-  $fortranSegment : fluid := nil
-  $fortInts2Floats : fluid := nil
-  typeName := checkType typeName
-  typeName = '"CHARACTER" =>
-    fortFormatCharacterTypes([unravel(u) for u in names])
-      where unravel u ==
-              atom u => u
-              CDADR u
-  fortFormatTypes1(typeName,mkParameterList names)
-
-fortFormatTypes1(typeName,names) ==
-  l := $maximumFortranExpressionLength-1-LENGTH(typeName)
-  while nameLen(names) > l repeat
-    n := []
-    ln := 0
-    while (ln := ln + LENGTH(first names) + 1) < l repeat
-      n := [first names,:n]
-      names := rest names
-    displayLines fortran2Lines [typeName,'" ",:addCommas n]
-  displayLines fortran2Lines [typeName,'" ",:addCommas names]
-
-insertEntry(size,el,aList) ==
-  entry := assoc(size,aList)
-  null entry => CONS(CONS(size,LIST el),aList)
-  RPLACD(entry,CONS(el,CDR entry))
-  aList
-
-fortFormatCharacterTypes(names) ==
-  sortedByLength := []
-  genuineArrays  := []
-  for u in names repeat
-    ATOM u => sortedByLength := insertEntry(0,u,sortedByLength)
-    #u=2 => sortedByLength := insertEntry(CADR u,CAR u,sortedByLength)
-    genuineArrays := [u,:genuineArrays]
-  for u in sortedByLength repeat
-    fortFormatTypes1(mkCharName car u, [STRINGIMAGE(s) for s in cdr(u)]) where
-       mkCharName v == CONCAT("CHARACTER*(",STRINGIMAGE v,")")
-  if (not null genuineArrays) then
-    fortFormatTypes1('"CHARACTER",mkParameterList2 genuineArrays) where
-       mkParameterList2 l ==
-         [par2string(u) for u in l] where par2string u ==
-             apply('STRCONC,[STRINGIMAGE(first u),'"(",_
-                      :rest [:['",",:statement2Fortran(v)] for v in rest u],'")"])
-
-fortFormatIntrinsics(l) ==
-  $fortError : fluid := nil
-  null l => return()
-  displayLines fortran2Lines ['"INTRINSIC ",:addCommas(l)]
-  
- 
------------------- fortDec.boot --------------------
- 
--- This file contains the stuff for creating and updating the Fortran symbol
--- table.
- 
-currentSP () ==
-  -- Return the name of the current subprogram being generated
-  $currentSubprogram or "MAIN"
- 
-updateSymbolTable(name,type) ==
-    fun := ['$elt,'SYMS,'declare_!]
-    coercion := ['_:_:,STRING type,'FST]
-    $insideCompileBodyIfTrue: local := false
-    interpret([fun,["QUOTE",name],coercion])
- 
-addCommas l ==
-  not l => nil
-  r := [STRINGIMAGE first l]
-  for e in rest l repeat r := [STRINGIMAGE e,'",",:r]
-  reverse r
-
-$intrinsics := []
-initialiseIntrinsicList() == 
-  $intrinsics := []
-
-getIntrinsicList() ==
-  $intrinsics
-
- 
--------------------- fortPre.boot ------------------
- 
-fortPre l ==
-  -- Essentially, the idea is to fix things so that we know what size of
-  -- expression we will generate, which helps segment large expressions
-  -- and do transformations to double precision output etc..
-  $exprStack : fluid := nil -- sometimes we will add elements to this in
-                            -- other functions, for example when extracing
-                            -- lists etc.
-  for e in l repeat if new := fortPre1 e then
-     $exprStack := [new,:$exprStack]
-  reverse $exprStack
- 
-fortPre1 e ==
-  -- replace spad function names by Fortran equivalents
-  -- where appropriate, replace integers by floats
-  -- extract complex numbers
-  -- replace powers of %e by calls to EXP
-  -- replace x**2 by x*x etc.
-  -- replace ROOT by either SQRT or **(1./ ... )
-  -- replace N-ary by binary functions
-  -- strip the '%' character off objects like %pi etc..
-  null e => nil
-  INTEGERP(e) =>
-    $fortInts2Floats = true =>
-      e >= 0 => fix2FortranFloat(e)
-      ['"-", fix2FortranFloat(-e)]
-    e
-  isFloat(e) => checkPrecision(e)
-  -- Keep strings as strings:
-  -- STRINGP(e) => STRCONC(STRING(34),e,STRING(34))
-  STRINGP(e) => e
-  e = "%e" => fortPre1 ["exp" , 1]
-  imags := ['"%i","%i"]
-  e in imags => ['"CMPLX",fortPre1(0),fortPre1(1)]
-  -- other special objects
-  ELT(STRINGIMAGE e,0) = "%" => SUBSEQ(STRINGIMAGE e,1)
-  atom e => e
-  [op, :args] := e
-  op in ["**" , '"**"] =>
-    [rand,exponent] := args
-    rand = "%e" => fortPre1 ["exp", exponent]
-    (IDENTP rand or STRINGP rand) and exponent=2 => ["*", rand, rand]
-    (FIXP exponent and ABS(exponent) < 32768) => ["**",fortPre1 rand,exponent]
-    ["**", fortPre1 rand,fortPre1 exponent]
-  op = "ROOT" =>
-    #args = 1 => fortPreRoot ["sqrt", first args]
-    [ "**" , fortPreRoot first args , [ "/" , fortPreRoot(1), fortPreRoot first rest args] ]
-  if op in ['"OVER", "OVER"] then op := '"/"
-  specialOps  := '(BRACKET BRACE SUB AGGLST SUPERSUB MATRIX SEGMENT ALTSUPERSUB
-                   PAREN CONCAT CONCATB QUOTE STRING SIGMA  STEP IN SIGMA2
-                   INTSIGN  PI PI2 INDEFINTEGRAL)
-  op in specialOps => exp2FortSpecial(op,args,#args)
-  op in ['"*", "*", '"+", "+", '"-", "-"] and (#args > 2) =>
-    binaryExpr := fortPre1 [op,first args, SECOND args]
-    for i in 3..#args repeat
-      binaryExpr := [op,binaryExpr,fortPre1 NTH(i-1,args)]
-    binaryExpr
-  -- Now look for any complex objects
-  #args = 2 =>
-    [arg1,arg2] := args
-    op in ["*",'"*"] and arg2 in imags => ['"CMPLX",fortPre1(0),fortPre1(arg1)]
-    op in ["+",'"+"] and arg2 in imags => ['"CMPLX",fortPre1(arg1),fortPre1(1)]
-    op in ["+",'"+"] and arg2 is [mop,m1,m2] and mop in ["*",'"*"] =>
-      m2 in imags => ['"CMPLX",fortPre1(arg1),fortPre1(m1)]
-      m1 in imags => ['"CMPLX",fortPre1(arg1),fortPre1(m2)]
-      ["+",fortPre1 arg1,fortPre1 arg2]
-    op in ["+",'"+"] and arg1 is [mop,m1,m2] and mop in ["*",'"*"] =>
-      m2 in imags => ['"CMPLX",fortPre1(arg2),fortPre1(m1)]
-      m1 in imags => ['"CMPLX",fortPre1(arg2),fortPre1(m2)]
-      ["+",fortPre1 arg1,fortPre1 arg2]
-    mkFortFn(op,args,2)
-  mkFortFn(op,args,#args)
-
-fortPreRoot e ==
--- To set $fortInts2Floats 
-  $fortInts2Floats : fluid := true
-  fortPre1 e
- 
-fix2FortranFloat e ==
-  -- Return a Fortran float for a given integer.
-  $fortranPrecision = "double" => STRCONC(STRINGIMAGE(e),".0D0")
-  STRCONC(STRINGIMAGE(e),".")
- 
-isFloat e ==
-  FLOATP(e) or STRINGP(e) and FIND(char ".",e)
- 
-checkPrecision e ==
-  -- Do we have a string?
-  STRINGP(e) and CHAR_-CODE(CHAR(e,0)) = 34 => e
-  e := delete(char " ",STRINGIMAGE e)
-  $fortranPrecision = "double" =>
-    iPart := SUBSEQ(e,0,(period:=POSITION(char ".",e))+1)
-    expt  := if ePos := POSITION(char "E",e) then SUBSEQ(e,ePos+1) else "0"
-    rPart :=
-      ePos => SUBSEQ(e,period+1,ePos)
-      period+1 < LENGTH e => SUBSEQ(e,period+1)
-      "0"
-    STRCONC(iPart,rPart,"D",expt)
-  e
- 
------------------ segment.boot -----------------------
- 
-fortExpSize e ==
-  -- computes a tree reflecting the number of characters of the printed
-  -- expression.
-  -- The first element of a list is the "total so far", while subsequent
-  -- elements are the sizes of the components.
-  --
-  -- This function overestimates the size because it assumes that e.g.
-  -- (+ x (+ y z)) will be printed as "x+(y+z)" rather than "x+y+z"
-  -- which is the actual case.
-  atom e => LENGTH STRINGIMAGE e
-  #e > 3 => 2+fortSize MAPCAR(function fortExpSize, e)
-  #e < 3 => 2+fortSize MAPCAR(function fortExpSize, e)
-  [op,arg1,arg2] := e
-  op := STRINGIMAGE op
-  op = '"CMPLX" => 3+fortSize [fortExpSize arg1,fortExpSize arg2]
-  narys := ['"+",'"*"] -- those nary ops we changed to binary
-  op in narys =>
-    LISTP arg1 and not(op=STRINGIMAGE first arg1) =>
-      2+fortSize MAPCAR(function fortExpSize, e)
-    LISTP arg2 and not(op=STRINGIMAGE first arg2) =>
-      2+fortSize MAPCAR(function fortExpSize, e)
-    1+fortSize [fortExpSize arg1,fortExpSize arg2]
-  2+fortSize MAPCAR(function fortExpSize, e)
- 
-fortSize e ==
-  +/[elen u for u in e] where
-    elen z ==
-      atom z => z
-      first z
- 
-tempLen () == 1 + LENGTH STRINGIMAGE $exp2FortTempVarIndex
- 
-segment l ==
-  not $fortranSegment => l
-  s := nil
-  for e in l repeat
-    if LISTP(e) and first e in ["=",'"="] then
-      var := NTH(1,e)
-      exprs := segment1(THIRD e,
-                        $maximumFortranExpressionLength-1-fortExpSize var)
-      s:= [:[['"=",var,car exprs],:cdr exprs],:s]
-    else if LISTP(e) and first e in ['"RETURN"] then
-      exprs := segment1(SECOND e,
-                        $maximumFortranExpressionLength-2-fortExpSize first e)
-      s := [:[[first e,car exprs],:cdr exprs],:s]
-    else s:= [e,:s]
-  reverse s
- 
-segment1(e,maxSize) ==
-  (size := fortExpSize e) < maxSize => [e]
-  expressions := nil;
-  newE := [first e]
-  -- Assume we have to replace each argument with a temporary variable, and
-  -- that the temporary variable may be larger than we expect.
-  safeSize := maxSize -  (#e-1)*(tempLen()+1) - fortExpSize newE
-  for i in 2..#e repeat
-    subSize := fortExpSize NTH(i-1,e)
-    -- We could have a check here for symbols which are simply too big
-    -- for Fortran (i.e. more than the maximum practical expression length)
-    subSize <= safeSize =>
-      safeSize := safeSize - subSize
-      newE := [:newE,NTH(i-1,e)]
-    -- this ones too big.
-    exprs := segment2(NTH(i-1,e),safeSize)
-    expressions := [:(cdr exprs),:expressions]
-    newE := [:newE,(car exprs)]
-    safeSize := safeSize - fortExpSize car exprs
-  [newE,:expressions]
- 
-segment2(e,topSize) ==
-  maxSize := $maximumFortranExpressionLength -tempLen()-1
-  atom(e) => [e]
-  exprs := nil
-  newE  := [first e]
-  topSize := topSize - fortExpSize newE
-  for i in 2..#e repeat
-    subE := NTH(i-1,e)
-    (subSize := fortExpSize subE) > maxSize =>
-      subE := segment2(subE,maxSize)
-      exprs := [:(cdr subE),:exprs]
-      if (subSize := fortExpSize first subE) <= topSize then
-        newE := [:newE,first subE]
-        topSize := topSize - subSize
-      else
-        newVar := newFortranTempVar()
-        newE := [:newE,newVar]
-        exprs:=[['"=",newVar,first subE],:exprs]
-        topSize := topSize - fortExpSize newVar
-    newE := [:newE,subE]
-    topSize := topSize - subSize
-  topSize > 0 => [newE,:exprs]
-  newVar := newFortranTempVar()
-  [newVar,['"=",newVar,newE],:exprs]
- 
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}