diff options
Diffstat (limited to 'src/algebra')
| -rw-r--r-- | src/algebra/Makefile.in | 55 | ||||
| -rw-r--r-- | src/algebra/annacat.spad.pamphlet | 496 | ||||
| -rw-r--r-- | src/algebra/asp.spad.pamphlet | 4282 | ||||
| -rw-r--r-- | src/algebra/cont.spad.pamphlet | 354 | ||||
| -rw-r--r-- | src/algebra/exposed.lsp.pamphlet | 45 | ||||
| -rw-r--r-- | src/algebra/fortcat.spad.pamphlet | 345 | ||||
| -rw-r--r-- | src/algebra/fortmac.spad.pamphlet | 458 | ||||
| -rw-r--r-- | src/algebra/fortpak.spad.pamphlet | 641 | ||||
| -rw-r--r-- | src/algebra/fortran.spad.pamphlet | 1784 | ||||
| -rw-r--r-- | src/algebra/functions.spad.pamphlet | 120 | ||||
| -rw-r--r-- | src/algebra/routines.spad.pamphlet | 647 |
11 files changed, 28 insertions, 9199 deletions
diff --git a/src/algebra/Makefile.in b/src/algebra/Makefile.in index cb018420..dcd03071 100644 --- a/src/algebra/Makefile.in +++ b/src/algebra/Makefile.in @@ -949,7 +949,7 @@ $(OUT)/DMEXT.$(FASLEXT): $(OUT)/DSEXT.$(FASLEXT) $(OUT)/DIFFMOD.$(FASLEXT) \ $(OUT)/STREAM.$(FASLEXT): $(OUT)/LZSTAGG.$(FASLEXT) axiom_algebra_layer_1 = \ - ABELGRP ABELGRP- ABELMON ABELMON- FORTCAT ITUPLE \ + ABELGRP ABELGRP- ABELMON ABELMON- ITUPLE \ CABMON MONOID MONOID- RING RING- COMRING \ DIFRING ENTIRER INTDOM INTDOM- OINTDOM \ GCDDOM GCDDOM- UFD UFD- ES ES- \ @@ -1005,9 +1005,9 @@ $(OUT)/PALETTE.$(FASLEXT): $(OUT)/COLOR.$(FASLEXT) axiom_algebra_layer_4 = \ - ANON OSI COMM COMPPROP ESCONT1 EXIT \ - FAMONC FORMULA1 IDPC NONE NUMINT \ - ODECAT COLOR ONECOMP2 OPTCAT \ + ANON OSI COMM COMPPROP EXIT \ + FAMONC FORMULA1 IDPC NONE \ + COLOR ONECOMP2 \ PALETTE PARPCURV PARPC2 PARSCURV PARSC2 PARSURF \ PARSU2 PATRES2 PATTERN1 PDECAT \ REPSQ REPDB RFDIST RIDIST SPACEC SPLNODE \ @@ -1028,7 +1028,7 @@ $(OUT)/PDRING.$(FASLEXT): $(OUT)/PDSPC.$(FASLEXT) axiom_algebra_layer_5 = \ CHARNZ DVARCAT DVARCAT- ELEMFUN \ - ELEMFUN- ESTOOLS2 FCOMP FPATMAB IDPAM IDPO \ + ELEMFUN- FCOMP FPATMAB IDPAM IDPO \ INCRMAPS KERNEL2 MODMONOM MONADWU MONADWU- \ MRF2 NARNG NARNG- NSUP2 ODVAR OPQUERY \ ORDMON PATMATCH PERMCAT PDRING \ @@ -1081,7 +1081,7 @@ $(OUT)/BSTREE.$(FASLEXT): $(OUT)/BTREE.$(FASLEXT) $(OUT)/ITAYLOR.$(FASLEXT): $(OUT)/STREAM.$(FASLEXT) axiom_algebra_layer_8 = \ - BSTREE BTOURN CARD DRAWHACK FACTFUNC FMTC \ + BSTREE BTOURN CARD DRAWHACK FACTFUNC \ FR2 FRAC2 FRUTIL ITAYLOR MLO NAALG \ NAALG- OP ORDCOMP2 RANDSRC UNISEG2 XALG \ BTREE ARR2CAT ARR2CAT- @@ -1095,14 +1095,13 @@ axiom_algebra_layer_8_objects = \ $(OUT)/FT.$(FASLEXT): $(OUT)/FST.$(FASLEXT) axiom_algebra_layer_9 = \ - AMR AMR- DEGRED DLP EAB ESTOOLS1 \ + AMR AMR- DEGRED DLP EAB \ FAGROUP FAMONOID FLINEXP FLINEXP- FRETRCT FRETRCT- \ FSERIES FT IDPAG IDPOAMS INFINITY LA \ OMLO ORTHPOL PRODUCT PADICCT PMPRED PMASS \ PTFUNC2 RATRET RADUTIL UPXS2 \ XFALG ZLINDEP BBTREE TABLE INTABL \ - NIPROB ODEPROB OPTPROB \ - PDEPROB SIG FMONCAT FST + SIG FMONCAT FST axiom_algebra_layer_9_nrlibs = \ @@ -1129,7 +1128,7 @@ $(OUT)/BTAGG.$(FASLEXT): $(OUT)/BOOLE.$(FASLEXT) $(OUT)/PATLRES.$(FASLEXT): $(OUT)/PATRES.$(FASLEXT) axiom_algebra_layer_10 = \ - RESULT BFUNCT BPADIC ANY \ + BPADIC ANY \ SEXOF CRAPACK DEQUEUE DLIST \ DRAWCX \ DRAWPT FAMR FAMR- FLASORT \ @@ -1209,7 +1208,7 @@ axiom_algebra_layer_13 = \ COORDSYS DBASE DHMATRIX DIOSP \ FAXF FAXF- FFPOLY2 \ FNLA GRAY HB IRSN \ - MCALCFN MHROWRED NUMODE NUMQUAD \ + MHROWRED NUMODE NUMQUAD \ ODESYS ODETOOLS ORDFUNS PERMAN \ PFECAT PFECAT- POINT PSEUDLIN \ PTPACK REP2 SETMN \ @@ -1223,7 +1222,6 @@ axiom_algebra_layer_13_objects = \ $(addprefix $(OUT)/, \ $(addsuffix .$(FASLEXT),$(axiom_algebra_layer_13))) $(OUT)/FS.$(FASLEXT): $(OUT)/UPOLYC.$(FASLEXT) -$(OUT)/FTEM.$(FASLEXT): $(OUT)/TEXTFILE.$(FASLEXT) $(OUT)/FILE.$(FASLEXT): $(OUT)/FNAME.$(FASLEXT) axiom_algebra_layer_14 = \ @@ -1238,8 +1236,8 @@ axiom_algebra_layer_14 = \ FFPOLY FFX FFSLPE FGLMICPK \ FILE FINAALG FINAALG- FINRALG \ FINRALG- FLOATRP FNAME \ - FOP FORMULA FORT FRAC \ - FTEM GENEEZ GENMFACT GENPGCD \ + FORMULA FRAC \ + GENEEZ GENMFACT GENPGCD \ GALFACTU GALPOLYU GB GBEUCLID \ GBF GBINTERN GHENSEL GMODPOL \ GOSPER GRIMAGE GROEBSOL HDMP \ @@ -1251,7 +1249,7 @@ axiom_algebra_layer_14 = \ ISUMP LAUPOL LEADCDET LGROBP \ LIMITRF LINDEP LO LPEFRAC \ LSPP MATLIN MCDEN MDDFACT \ - MFINFACT MFLOAT MINT MLIFT \ + MFINFACT MLIFT \ MMAP MODMON MONOTOOL MPCPF \ MPC2 MPC3 MPOLY MPRFF \ MRATFAC MULTSQFR NORMRETR NPCOEF \ @@ -1272,7 +1270,7 @@ axiom_algebra_layer_14 = \ SMITH SMP SMTS SOLVEFOR \ SPLTREE STINPROD STTFNC SUBRESP \ SUMRF SUP SUPFRACF TANEXP \ - TEMUTL TEX TEXTFILE \ + TEX TEXTFILE \ TWOFACT UNIFACT UP UPCDEN \ UPDECOMP UPDIVP UPMP UPOLYC2 \ UPXSCAT UPSQFREE VIEWDEF VIEW2D \ @@ -1355,13 +1353,12 @@ axiom_algebra_layer_18_objects = \ $(addsuffix .$(FASLEXT),$(axiom_algebra_layer_18))) $(OUT)/TSETCAT.$(FASLEXT): $(OUT)/PSETCAT.$(FASLEXT) $(OUT)/RPOLCAT.$(FASLEXT) $(OUT)/FPARFRAC.$(FASLEXT): $(OUT)/DIFFSPC.$(FASLEXT) -$(OUT)/FEXPR.$(FASLEXT): $(OUT)/EXPR.$(FASLEXT) axiom_algebra_layer_19 = \ - ACPLOT ANTISYM ATTRBUT \ + ACPLOT ANTISYM \ COMPCAT \ COMPCAT- DRAW DRAWCFUN DROPT \ - DROPT0 EP FCPAK1 FEXPR \ + DROPT0 EP \ FFCAT FFCAT- FFCGP FFNBP \ FFP FLOAT FPARFRAC FR \ FRNAALG FRNAALG- EXPR \ @@ -1369,16 +1366,16 @@ axiom_algebra_layer_19 = \ IDEAL INFORM INFORM1 IPRNTPK \ IR ISUPS LIB \ LMDICT LODOOPS MKFLCFN \ - MSET M3D \ + MSET \ NREP NUMFMT OC OC- \ ODERAT \ PATTERN OVAR \ PMKERNEL PMSYM PRIMELT \ QALGSET2 QEQUAT RECLOS REP1 \ QUATCAT QUATCAT- RFFACT \ - ROMAN ROUTINE RNGBIND \ + ROMAN RNGBIND \ RULECOLD SAOS SEGBIND \ - SET SPECOUT SWITCH \ + SET SPECOUT \ SYSSOLP \ VARIABLE WFFINTBS SPADPRSR \ PARSER TSETCAT TSETCAT- @@ -1401,10 +1398,10 @@ axiom_algebra_layer_20 = \ CTRIGMNP \ DBLRESP DERHAM DFSFUN DRAWCURV \ EF EFSTRUC \ - ELFUTS ESTOOLS EXPEXPAN EXPRODE \ - EXPRTUBE EXPR2 FC FDIVCAT \ + ELFUTS EXPEXPAN EXPRODE \ + EXPRTUBE EXPR2 FDIVCAT \ FDIVCAT- FDIV2 FFCAT2 FLOATCP \ - FORDER FORTRAN FSRED FSUPFACT \ + FORDER FSRED FSUPFACT \ FRNAAF2 FSPECF FS2 FS2UPS \ GAUSSFAC GCNAALG GENUFACT GENUPS \ GTSET GPOLSET IAN INEP \ @@ -1413,7 +1410,7 @@ axiom_algebra_layer_20 = \ INTHERAL INTPAF INTPM INTTOOLS \ ITRIGMNP JORDAN KOVACIC LF \ LIE LODOF LSQM \ - MCMPLX MULTFACT NCEP \ + MULTFACT NCEP \ NLINSOL NSMP NUMERIC OCT \ OCTCT2 ODEPAL ODERTRIC PADE \ PAN2EXPR PFO PFOQ \ @@ -1421,7 +1418,7 @@ axiom_algebra_layer_20 = \ PSETPK QUAT QUATCT2 RADFF \ RDEEF RDEEFS RDIV RSETCAT \ RSETCAT- RULE RULESET SIMPAN \ - SFORT SOLVESER SUMFS SUTS \ + SOLVESER SUMFS SUTS \ TOOLSIGN TRIGMNIP TRMANIP ULSCCAT \ ULSCCAT- UPXSSING UTSODE UTSODETL \ UTS2 WUTSET @@ -1439,7 +1436,7 @@ $(OUT)/SUPXS.$(FASLEXT): $(OUT)/PDDOM.$(FASLEXT) axiom_algebra_layer_21 = \ DEFINTEF DFINTTLS DEFINTRF \ - EFULS ESCONT EXPR2UPS \ + EFULS EXPR2UPS \ FDIV FSCINT FSINT FS2EXPXP \ GSERIES HELLFDIV INVLAPLA IR2F \ IRRF2F LAPLACE LIMITPS LODEEF \ @@ -1488,7 +1485,7 @@ axiom_algebra_layer_user = \ QQUTAST DEFAST MACROAST SPADXPT SPADAST PARAMAST \ INBFILE OUTBFILE IOBFILE RGBCMDL RGBCSPC STEPAST \ CTOR IP4ADDR NETCLT INETCLTS \ - FMC FMFUN FORTFN FVC FVFUN IRFORM COMPILER \ + IRFORM COMPILER \ ITFORM ELABOR TALGOP YDIAGRAM LINELT DBASIS \ LINFORM LINBASIS JVMOP JVMCFACC JVMFDACC JVMMDACC \ JVMCSTTG diff --git a/src/algebra/annacat.spad.pamphlet b/src/algebra/annacat.spad.pamphlet deleted file mode 100644 index 1c92b907..00000000 --- a/src/algebra/annacat.spad.pamphlet +++ /dev/null @@ -1,496 +0,0 @@ -\documentclass{article} -\usepackage{open-axiom} -\begin{document} -\title{\$SPAD/src/algebra annacat.spad} -\author{Brian Dupee} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain NIPROB NumericalIntegrationProblem} -<<domain NIPROB NumericalIntegrationProblem>>= -)abbrev domain NIPROB NumericalIntegrationProblem -++ Author: Brian Dupee -++ Date Created: December 1997 -++ Date Last Updated: December 1997 -++ Basic Operations: coerce, retract -++ Related Constructors: Union -++ Description: -++ \axiomType{NumericalIntegrationProblem} is a \axiom{domain} -++ for the representation of Numerical Integration problems for use -++ by ANNA. -++ -++ The representation is a Union of two record types - one for integration of -++ a function of one variable: -++ -++ \axiomType{Record}(var:\axiomType{Symbol}, -++ fn:\axiomType{Expression DoubleFloat}, -++ range:\axiomType{Segment OrderedCompletion DoubleFloat}, -++ abserr:\axiomType{DoubleFloat}, -++ relerr:\axiomType{DoubleFloat},) -++ -++ and one for multivariate integration: -++ -++ \axiomType{Record}(fn:\axiomType{Expression DoubleFloat}, -++ range:\axiomType{List Segment OrderedCompletion DoubleFloat}, -++ abserr:\axiomType{DoubleFloat}, -++ relerr:\axiomType{DoubleFloat},). -++ - -EDFA ==> Expression DoubleFloat -SOCDFA ==> Segment OrderedCompletion DoubleFloat -DFA ==> DoubleFloat -NIAA ==> Record(var:Symbol,fn:EDFA,range:SOCDFA,abserr:DFA,relerr:DFA) -MDNIAA ==> Record(fn:EDFA,range:List SOCDFA,abserr:DFA,relerr:DFA) - -NumericalIntegrationProblem():SetCategory with - coerce: NIAA -> % - ++ coerce(x) \undocumented{} - coerce: MDNIAA -> % - ++ coerce(x) \undocumented{} - coerce: Union(nia:NIAA,mdnia:MDNIAA) -> % - ++ coerce(x) \undocumented{} - retract: % -> Union(nia:NIAA,mdnia:MDNIAA) - ++ retract(x) \undocumented{} - - == - - add - Rep := Union(nia:NIAA,mdnia:MDNIAA) - - coerce(s:NIAA) == [s] - coerce(s:MDNIAA) == [s] - coerce(s:Union(nia:NIAA,mdnia:MDNIAA)) == s - coerce(x:%):OutputForm == - (x) case nia => (x.nia)::OutputForm - (x.mdnia)::OutputForm - retract(x:%):Union(nia:NIAA,mdnia:MDNIAA) == - (x) case nia => [x.nia] - [x.mdnia] - -@ -\section{domain ODEPROB NumericalODEProblem} -<<domain ODEPROB NumericalODEProblem>>= -)abbrev domain ODEPROB NumericalODEProblem -++ Author: Brian Dupee -++ Date Created: December 1997 -++ Date Last Updated: December 1997 -++ Basic Operations: coerce, retract -++ Related Constructors: Union -++ Description: -++ \axiomType{NumericalODEProblem} is a \axiom{domain} -++ for the representation of Numerical ODE problems for use -++ by ANNA. -++ -++ The representation is of type: -++ -++ \axiomType{Record}(xinit:\axiomType{DoubleFloat}, -++ xend:\axiomType{DoubleFloat}, -++ fn:\axiomType{Vector Expression DoubleFloat}, -++ yinit:\axiomType{List DoubleFloat},intvals:\axiomType{List DoubleFloat}, -++ g:\axiomType{Expression DoubleFloat},abserr:\axiomType{DoubleFloat}, -++ relerr:\axiomType{DoubleFloat}) -++ - -DFB ==> DoubleFloat -VEDFB ==> Vector Expression DoubleFloat -LDFB ==> List DoubleFloat -EDFB ==> Expression DoubleFloat -ODEAB ==> Record(xinit:DFB,xend:DFB,fn:VEDFB,yinit:LDFB,intvals:LDFB,g:EDFB,abserr:DFB,relerr:DFB) -NumericalODEProblem():SetCategory with - - coerce: ODEAB -> % - ++ coerce(x) \undocumented{} - retract: % -> ODEAB - ++ retract(x) \undocumented{} - - == - - add - Rep := ODEAB - - coerce(s:ODEAB) == s - coerce(x:%):OutputForm == - (retract(x))::OutputForm - retract(x:%):ODEAB == x :: Rep - -@ -\section{domain PDEPROB NumericalPDEProblem} -<<domain PDEPROB NumericalPDEProblem>>= -)abbrev domain PDEPROB NumericalPDEProblem -++ Author: Brian Dupee -++ Date Created: December 1997 -++ Date Last Updated: December 1997 -++ Basic Operations: coerce, retract -++ Related Constructors: Union -++ Description: -++ \axiomType{NumericalPDEProblem} is a \axiom{domain} -++ for the representation of Numerical PDE problems for use -++ by ANNA. -++ -++ The representation is of type: -++ -++ \axiomType{Record}(pde:\axiomType{List Expression DoubleFloat}, -++ constraints:\axiomType{List PDEC}, -++ f:\axiomType{List List Expression DoubleFloat}, -++ st:\axiomType{String}, -++ tol:\axiomType{DoubleFloat}) -++ -++ where \axiomType{PDEC} is of type: -++ -++ \axiomType{Record}(start:\axiomType{DoubleFloat}, -++ finish:\axiomType{DoubleFloat}, -++ grid:\axiomType{NonNegativeInteger}, -++ boundaryType:\axiomType{Integer}, -++ dStart:\axiomType{Matrix DoubleFloat}, -++ dFinish:\axiomType{Matrix DoubleFloat}) -++ - -DFC ==> DoubleFloat -NNIC ==> NonNegativeInteger -INTC ==> Integer -MDFC ==> Matrix DoubleFloat -PDECC ==> Record(start:DFC, finish:DFC, grid:NNIC, boundaryType:INTC, - dStart:MDFC, dFinish:MDFC) -LEDFC ==> List Expression DoubleFloat -PDEBC ==> Record(pde:LEDFC, constraints:List PDECC, f:List LEDFC, - st:String, tol:DFC) -NumericalPDEProblem():SetCategory with - - coerce: PDEBC -> % - ++ coerce(x) \undocumented{} - retract: % -> PDEBC - ++ retract(x) \undocumented{} - - == - - add - Rep := PDEBC - - coerce(s:PDEBC) == s - coerce(x:%):OutputForm == - (retract(x))::OutputForm - retract(x:%):PDEBC == x :: Rep - -@ -\section{domain OPTPROB NumericalOptimizationProblem} -<<domain OPTPROB NumericalOptimizationProblem>>= -)abbrev domain OPTPROB NumericalOptimizationProblem -++ Author: Brian Dupee -++ Date Created: December 1997 -++ Date Last Updated: December 1997 -++ Basic Operations: coerce, retract -++ Related Constructors: Union -++ Description: -++ \axiomType{NumericalOptimizationProblem} is a \axiom{domain} -++ for the representation of Numerical Optimization problems for use -++ by ANNA. -++ -++ The representation is a Union of two record types - one for otimization of -++ a single function of one or more variables: -++ -++ \axiomType{Record}( -++ fn:\axiomType{Expression DoubleFloat}, -++ init:\axiomType{List DoubleFloat}, -++ lb:\axiomType{List OrderedCompletion DoubleFloat}, -++ cf:\axiomType{List Expression DoubleFloat}, -++ ub:\axiomType{List OrderedCompletion DoubleFloat}) -++ -++ and one for least-squares problems i.e. optimization of a set of -++ observations of a data set: -++ -++ \axiomType{Record}(lfn:\axiomType{List Expression DoubleFloat}, -++ init:\axiomType{List DoubleFloat}). -++ - -LDFD ==> List DoubleFloat -LEDFD ==> List Expression DoubleFloat -LSAD ==> Record(lfn:LEDFD, init:LDFD) -UNOALSAD ==> Union(noa:NOAD,lsa:LSAD) -EDFD ==> Expression DoubleFloat -LOCDFD ==> List OrderedCompletion DoubleFloat -NOAD ==> Record(fn:EDFD, init:LDFD, lb:LOCDFD, cf:LEDFD, ub:LOCDFD) -NumericalOptimizationProblem():SetCategory with - - coerce: NOAD -> % - ++ coerce(x) \undocumented{} - coerce: LSAD -> % - ++ coerce(x) \undocumented{} - coerce: UNOALSAD -> % - ++ coerce(x) \undocumented{} - retract: % -> UNOALSAD - ++ retract(x) \undocumented{} - - == - - add - Rep := UNOALSAD - - coerce(s:NOAD) == [s] - coerce(s:LSAD) == [s] - coerce(x:UNOALSAD) == x - coerce(x:%):OutputForm == - (x) case noa => (x.noa)::OutputForm - (x.lsa)::OutputForm - retract(x:%):UNOALSAD == - (x) case noa => [x.noa] - [x.lsa] - -@ -\section{category NUMINT NumericalIntegrationCategory} -<<category NUMINT NumericalIntegrationCategory>>= -)abbrev category NUMINT NumericalIntegrationCategory -++ Author: Brian Dupee -++ Date Created: February 1994 -++ Date Last Updated: March 1996 -++ Description: -++ \axiomType{NumericalIntegrationCategory} is the \axiom{category} for -++ describing the set of Numerical Integration \axiom{domains} with -++ \axiomFun{measure} and \axiomFun{numericalIntegration}. - -EDFE ==> Expression DoubleFloat -SOCDFE ==> Segment OrderedCompletion DoubleFloat -DFE ==> DoubleFloat -NIAE ==> Record(var:Symbol,fn:EDFE,range:SOCDFE,abserr:DFE,relerr:DFE) -MDNIAE ==> Record(fn:EDFE,range:List SOCDFE,abserr:DFE,relerr:DFE) -NumericalIntegrationCategory(): Category == SetCategory with - - measure:(RoutinesTable,NIAE)->Record(measure:Float,explanations:String,extra:Result) - ++ measure(R,args) calculates an estimate of the ability of a particular - ++ method to solve a problem. - ++ - ++ This method may be either a specific NAG routine or a strategy (such - ++ as transforming the function from one which is difficult to one which - ++ is easier to solve). - ++ - ++ It will call whichever agents are needed to perform analysis on the - ++ problem in order to calculate the measure. There is a parameter, - ++ labelled \axiom{sofar}, which would contain the best compatibility - ++ found so far. - - numericalIntegration: (NIAE, Result) -> Result - ++ numericalIntegration(args,hints) performs the integration of the - ++ function given the strategy or method returned by \axiomFun{measure}. - - measure:(RoutinesTable,MDNIAE)->Record(measure:Float,explanations:String,extra:Result) - ++ measure(R,args) calculates an estimate of the ability of a particular - ++ method to solve a problem. - ++ - ++ This method may be either a specific NAG routine or a strategy (such - ++ as transforming the function from one which is difficult to one which - ++ is easier to solve). - ++ - ++ It will call whichever agents are needed to perform analysis on the - ++ problem in order to calculate the measure. There is a parameter, - ++ labelled \axiom{sofar}, which would contain the best compatibility - ++ found so far. - - numericalIntegration: (MDNIAE, Result) -> Result - ++ numericalIntegration(args,hints) performs the integration of the - ++ function given the strategy or method returned by \axiomFun{measure}. - -@ -\section{category ODECAT OrdinaryDifferentialEquationsSolverCategory} -<<category ODECAT OrdinaryDifferentialEquationsSolverCategory>>= -)abbrev category ODECAT OrdinaryDifferentialEquationsSolverCategory -++ Author: Brian Dupee -++ Date Created: February 1995 -++ Date Last Updated: June 1995 -++ Basic Operations: -++ Description: -++ \axiomType{OrdinaryDifferentialEquationsSolverCategory} is the -++ \axiom{category} for describing the set of ODE solver \axiom{domains} -++ with \axiomFun{measure} and \axiomFun{ODEsolve}. - -DFF ==> DoubleFloat -VEDFF ==> Vector Expression DoubleFloat -LDFF ==> List DoubleFloat -EDFF ==> Expression DoubleFloat -ODEAF ==> Record(xinit:DFF,xend:DFF,fn:VEDFF,yinit:LDFF,intvals:LDFF,g:EDFF,abserr:DFF,relerr:DFF) -OrdinaryDifferentialEquationsSolverCategory(): Category == SetCategory with - - measure:(RoutinesTable,ODEAF) -> Record(measure:Float,explanations:String) - ++ measure(R,args) calculates an estimate of the ability of a particular - ++ method to solve a problem. - ++ - ++ This method may be either a specific NAG routine or a strategy (such - ++ as transforming the function from one which is difficult to one which - ++ is easier to solve). - ++ - ++ It will call whichever agents are needed to perform analysis on the - ++ problem in order to calculate the measure. There is a parameter, - ++ labelled \axiom{sofar}, which would contain the best compatibility - ++ found so far. - - ODESolve: ODEAF -> Result - ++ ODESolve(args) performs the integration of the - ++ function given the strategy or method returned by \axiomFun{measure}. - -@ -\section{category PDECAT PartialDifferentialEquationsSolverCategory} -<<category PDECAT PartialDifferentialEquationsSolverCategory>>= -)abbrev category PDECAT PartialDifferentialEquationsSolverCategory -++ Author: Brian Dupee -++ Date Created: February 1995 -++ Date Last Updated: June 1995 -++ Basic Operations: -++ Description: -++ \axiomType{PartialDifferentialEquationsSolverCategory} is the -++ \axiom{category} for describing the set of PDE solver \axiom{domains} -++ with \axiomFun{measure} and \axiomFun{PDEsolve}. - --- PDEA ==> Record(xmin:F,xmax:F,ymin:F,ymax:F,ngx:NNI,ngy:NNI,_ --- pde:List Expression Float, bounds:List List Expression Float,_ --- st:String, tol:DF) - --- measure:(RoutinesTable,PDEA) -> Record(measure:F,explanations:String) --- ++ measure(R,args) calculates an estimate of the ability of a particular --- ++ method to solve a problem. --- ++ --- ++ This method may be either a specific NAG routine or a strategy (such --- ++ as transforming the function from one which is difficult to one which --- ++ is easier to solve). --- ++ --- ++ It will call whichever agents are needed to perform analysis on the --- ++ problem in order to calculate the measure. There is a parameter, --- ++ labelled \axiom{sofar}, which would contain the best compatibility --- ++ found so far. - --- PDESolve: PDEA -> Result --- ++ PDESolve(args) performs the integration of the --- ++ function given the strategy or method returned by \axiomFun{measure}. - -DFG ==> DoubleFloat -NNIG ==> NonNegativeInteger -INTG ==> Integer -MDFG ==> Matrix DoubleFloat -PDECG ==> Record(start:DFG, finish:DFG, grid:NNIG, boundaryType:INTG, - dStart:MDFG, dFinish:MDFG) -LEDFG ==> List Expression DoubleFloat -PDEBG ==> Record(pde:LEDFG, constraints:List PDECG, f:List LEDFG, - st:String, tol:DFG) -PartialDifferentialEquationsSolverCategory(): Category == SetCategory with - - measure:(RoutinesTable,PDEBG) -> Record(measure:Float,explanations:String) - ++ measure(R,args) calculates an estimate of the ability of a particular - ++ method to solve a problem. - ++ - ++ This method may be either a specific NAG routine or a strategy (such - ++ as transforming the function from one which is difficult to one which - ++ is easier to solve). - ++ - ++ It will call whichever agents are needed to perform analysis on the - ++ problem in order to calculate the measure. There is a parameter, - ++ labelled \axiom{sofar}, which would contain the best compatibility - ++ found so far. - - PDESolve: PDEBG -> Result - ++ PDESolve(args) performs the integration of the - ++ function given the strategy or method returned by \axiomFun{measure}. - -@ -\section{category OPTCAT NumericalOptimizationCategory} -<<category OPTCAT NumericalOptimizationCategory>>= -)abbrev category OPTCAT NumericalOptimizationCategory -++ Author: Brian Dupee -++ Date Created: January 1996 -++ Date Last Updated: March 1996 -++ Description: -++ \axiomType{NumericalOptimizationCategory} is the \axiom{category} for -++ describing the set of Numerical Optimization \axiom{domains} with -++ \axiomFun{measure} and \axiomFun{optimize}. - -LDFH ==> List DoubleFloat -LEDFH ==> List Expression DoubleFloat -LSAH ==> Record(lfn:LEDFH, init:LDFH) -EDFH ==> Expression DoubleFloat -LOCDFH ==> List OrderedCompletion DoubleFloat -NOAH ==> Record(fn:EDFH, init:LDFH, lb:LOCDFH, cf:LEDFH, ub:LOCDFH) -NumericalOptimizationCategory(): Category == SetCategory with - measure:(RoutinesTable,NOAH)->Record(measure:Float,explanations:String) - ++ measure(R,args) calculates an estimate of the ability of a particular - ++ method to solve an optimization problem. - ++ - ++ This method may be either a specific NAG routine or a strategy (such - ++ as transforming the function from one which is difficult to one which - ++ is easier to solve). - ++ - ++ It will call whichever agents are needed to perform analysis on the - ++ problem in order to calculate the measure. There is a parameter, - ++ labelled \axiom{sofar}, which would contain the best compatibility - ++ found so far. - - measure:(RoutinesTable,LSAH)->Record(measure:Float,explanations:String) - ++ measure(R,args) calculates an estimate of the ability of a particular - ++ method to solve an optimization problem. - ++ - ++ This method may be either a specific NAG routine or a strategy (such - ++ as transforming the function from one which is difficult to one which - ++ is easier to solve). - ++ - ++ It will call whichever agents are needed to perform analysis on the - ++ problem in order to calculate the measure. There is a parameter, - ++ labelled \axiom{sofar}, which would contain the best compatibility - ++ found so far. - - numericalOptimization:LSAH -> Result - ++ numericalOptimization(args) performs the optimization of the - ++ function given the strategy or method returned by \axiomFun{measure}. - - numericalOptimization:NOAH -> Result - ++ numericalOptimization(args) performs the optimization of the - ++ function given the strategy or method returned by \axiomFun{measure}. - -@ -\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>> - -<<domain NIPROB NumericalIntegrationProblem>> -<<domain ODEPROB NumericalODEProblem>> -<<domain PDEPROB NumericalPDEProblem>> -<<domain OPTPROB NumericalOptimizationProblem>> -<<category NUMINT NumericalIntegrationCategory>> -<<category ODECAT OrdinaryDifferentialEquationsSolverCategory>> -<<category PDECAT PartialDifferentialEquationsSolverCategory>> -<<category OPTCAT NumericalOptimizationCategory>> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/asp.spad.pamphlet b/src/algebra/asp.spad.pamphlet deleted file mode 100644 index d95211a8..00000000 --- a/src/algebra/asp.spad.pamphlet +++ /dev/null @@ -1,4282 +0,0 @@ -\documentclass{article} -\usepackage{open-axiom} -\begin{document} -\title{\$SPAD/src/algebra asp.spad} -\author{Mike Dewar, Grant Keady, Godfrey Nolan} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain ASP1 Asp1} -<<domain ASP1 Asp1>>= -)abbrev domain ASP1 Asp1 -++ Author: Mike Dewar, Grant Keady, Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 18 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranFunctionCategory, FortranProgramCategory. -++ Description: -++\spadtype{Asp1} produces Fortran for Type 1 ASPs, needed for various -++NAG routines. Type 1 ASPs take a univariate expression (in the symbol -++X) and turn it into a Fortran Function like the following: -++\begin{verbatim} -++ DOUBLE PRECISION FUNCTION F(X) -++ DOUBLE PRECISION X -++ F=DSIN(X) -++ RETURN -++ END -++\end{verbatim} - - -Asp1(name): Exports == Implementation where - name : Symbol - - FEXPR ==> FortranExpression - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - - Exports ==> FortranFunctionCategory with - coerce : FEXPR(['X],[],MachineFloat) -> $ - ++coerce(f) takes an object from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns it into an ASP. - - Implementation ==> add - - -- Build Symbol Table for Rep - syms : SYMTAB := empty()$SYMTAB - declare!(X,fortranReal()$FT,syms)$SYMTAB - real : FST := "real"::FST - - Rep := FortranProgram(name,[real]$Union(fst:FST,void:"void"),[X],syms) - - retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ - retractIfCan(u:FRAC POLY INT):Union($,"failed") == - foo : Union(FEXPR(['X],[],MachineFloat),"failed") - foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) - foo case "failed" => "failed" - foo::FEXPR(['X],[],MachineFloat)::$ - - retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ - retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == - foo : Union(FEXPR(['X],[],MachineFloat),"failed") - foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) - foo case "failed" => "failed" - foo::FEXPR(['X],[],MachineFloat)::$ - - retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ - retractIfCan(u:EXPR FLOAT):Union($,"failed") == - foo : Union(FEXPR(['X],[],MachineFloat),"failed") - foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) - foo case "failed" => "failed" - foo::FEXPR(['X],[],MachineFloat)::$ - - retract(u:EXPR INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ - retractIfCan(u:EXPR INT):Union($,"failed") == - foo : Union(FEXPR(['X],[],MachineFloat),"failed") - foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) - foo case "failed" => "failed" - foo::FEXPR(['X],[],MachineFloat)::$ - - retract(u:POLY FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ - retractIfCan(u:POLY FLOAT):Union($,"failed") == - foo : Union(FEXPR(['X],[],MachineFloat),"failed") - foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) - foo case "failed" => "failed" - foo::FEXPR(['X],[],MachineFloat)::$ - - retract(u:POLY INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ - retractIfCan(u:POLY INT):Union($,"failed") == - foo : Union(FEXPR(['X],[],MachineFloat),"failed") - foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) - foo case "failed" => "failed" - foo::FEXPR(['X],[],MachineFloat)::$ - - coerce(u:FEXPR(['X],[],MachineFloat)):$ == - coerce((u::Expression(MachineFloat))$FEXPR(['X],[],MachineFloat))$Rep - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP10 Asp10} -<<domain ASP10 Asp10>>= -)abbrev domain ASP10 Asp10 -++ Author: Mike Dewar and Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 18 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{ASP10} produces Fortran for Type 10 ASPs, needed for NAG routine -++\axiomOpFrom{d02kef}{d02Package}. This ASP computes the values of a set of functions, for example: -++\begin{verbatim} -++ SUBROUTINE COEFFN(P,Q,DQDL,X,ELAM,JINT) -++ DOUBLE PRECISION ELAM,P,Q,X,DQDL -++ INTEGER JINT -++ P=1.0D0 -++ Q=((-1.0D0*X**3)+ELAM*X*X-2.0D0)/(X*X) -++ DQDL=1.0D0 -++ RETURN -++ END -++\end{verbatim} - -Asp10(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - EXF ==> Expression Float - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FEXPR ==> FortranExpression(['JINT,'X,'ELAM],[],MFLOAT) - MFLOAT ==> MachineFloat - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - VF2 ==> VectorFunctions2 - - Exports ==> FortranVectorFunctionCategory with - coerce : Vector FEXPR -> % - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - real : FST := "real"::FST - syms : SYMTAB := empty()$SYMTAB - declare!(P,fortranReal()$FT,syms)$SYMTAB - declare!(Q,fortranReal()$FT,syms)$SYMTAB - declare!(DQDL,fortranReal()$FT,syms)$SYMTAB - declare!(X,fortranReal()$FT,syms)$SYMTAB - declare!(ELAM,fortranReal()$FT,syms)$SYMTAB - declare!(JINT,fortranInteger()$FT,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$Union(fst:FST,void:"void"), - [P,Q,DQDL,X,ELAM,JINT],syms) - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - coerce(c:FortranCode):% == coerce(c)$Rep - - coerce(r:RSFC):% == coerce(r)$Rep - - coerce(c:List FortranCode):% == coerce(c)$Rep - - -- To help the poor old compiler! - localAssign(s:Symbol,u:Expression MFLOAT):FortranCode == - assign(s,u)$FortranCode - - coerce(u:Vector FEXPR):% == - import Vector FEXPR - not (#u = 3) => error "Incorrect Dimension For Vector" - ([localAssign(P,elt(u,1)::Expression MFLOAT),_ - localAssign(Q,elt(u,2)::Expression MFLOAT),_ - localAssign(DQDL,elt(u,3)::Expression MFLOAT),_ - returns()$FortranCode ]$List(FortranCode))::Rep - - coerce(u:%):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP12 Asp12} -<<domain ASP12 Asp12>>= -)abbrev domain ASP12 Asp12 -++ Author: Mike Dewar and Godfrey Nolan -++ Date Created: Oct 1993 -++ Date Last Updated: 18 March 1994 -++ 21 June 1994 Changed print to printStatement -++ Related Constructors: -++ Description: -++\spadtype{Asp12} produces Fortran for Type 12 ASPs, needed for NAG routine -++\axiomOpFrom{d02kef}{d02Package} etc., for example: -++\begin{verbatim} -++ SUBROUTINE MONIT (MAXIT,IFLAG,ELAM,FINFO) -++ DOUBLE PRECISION ELAM,FINFO(15) -++ INTEGER MAXIT,IFLAG -++ IF(MAXIT.EQ.-1)THEN -++ PRINT*,"Output from Monit" -++ ENDIF -++ PRINT*,MAXIT,IFLAG,ELAM,(FINFO(I),I=1,4) -++ RETURN -++ END -++\end{verbatim} -Asp12(name): Exports == Implementation where - name : Symbol - - O ==> OutputForm - S ==> Symbol - FST ==> FortranScalarType - FT ==> FortranType - FC ==> FortranCode - SYMTAB ==> SymbolTable - EXI ==> Expression Integer - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - U ==> Union(I: Expression Integer,F: Expression Float,_ - CF: Expression Complex Float,switch:Switch) - UFST ==> Union(fst:FST,void:"void") - - Exports ==> FortranProgramCategory with - outputAsFortran:() -> Void - ++outputAsFortran() generates the default code for \spadtype{ASP12}. - - Implementation ==> add - - import FC - import Switch - - real : FST := "real"::FST - syms : SYMTAB := empty()$SYMTAB - declare!(MAXIT,fortranInteger()$FT,syms)$SYMTAB - declare!(IFLAG,fortranInteger()$FT,syms)$SYMTAB - declare!(ELAM,fortranReal()$FT,syms)$SYMTAB - fType : FT := construct([real]$UFST,["15"::Symbol],false)$FT - declare!(FINFO,fType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST,[MAXIT,IFLAG,ELAM,FINFO],syms) - - -- eqn : O := (I::O)=(1@Integer::EXI::O) - code:=([cond(EQ([MAXIT@S::EXI]$U,[-1::EXI]$U), - printStatement(["_"Output from Monit_""::O])), - printStatement([MAXIT::O,IFLAG::O,ELAM::O,subscript("(FINFO"::S,[I::O])::O,"I=1"::S::O,"4)"::S::O]), -- YUCK! - returns()]$List(FortranCode))::Rep - - coerce(u:%):OutputForm == coerce(u)$Rep - - outputAsFortran(u:%):Void == outputAsFortran(u)$Rep - outputAsFortran():Void == outputAsFortran(code)$Rep - -@ -\section{domain ASP19 Asp19} -<<domain ASP19 Asp19>>= -)abbrev domain ASP19 Asp19 -++ Author: Mike Dewar, Godfrey Nolan, Grant Keady -++ Date Created: Mar 1993 -++ Date Last Updated: 18 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp19} produces Fortran for Type 19 ASPs, evaluating a set of -++functions and their jacobian at a given point, for example: -++\begin{verbatim} -++ SUBROUTINE LSFUN2(M,N,XC,FVECC,FJACC,LJC) -++ DOUBLE PRECISION FVECC(M),FJACC(LJC,N),XC(N) -++ INTEGER M,N,LJC -++ INTEGER I,J -++ DO 25003 I=1,LJC -++ DO 25004 J=1,N -++ FJACC(I,J)=0.0D0 -++25004 CONTINUE -++25003 CONTINUE -++ FVECC(1)=((XC(1)-0.14D0)*XC(3)+(15.0D0*XC(1)-2.1D0)*XC(2)+1.0D0)/( -++ &XC(3)+15.0D0*XC(2)) -++ FVECC(2)=((XC(1)-0.18D0)*XC(3)+(7.0D0*XC(1)-1.26D0)*XC(2)+1.0D0)/( -++ &XC(3)+7.0D0*XC(2)) -++ FVECC(3)=((XC(1)-0.22D0)*XC(3)+(4.333333333333333D0*XC(1)-0.953333 -++ &3333333333D0)*XC(2)+1.0D0)/(XC(3)+4.333333333333333D0*XC(2)) -++ FVECC(4)=((XC(1)-0.25D0)*XC(3)+(3.0D0*XC(1)-0.75D0)*XC(2)+1.0D0)/( -++ &XC(3)+3.0D0*XC(2)) -++ FVECC(5)=((XC(1)-0.29D0)*XC(3)+(2.2D0*XC(1)-0.6379999999999999D0)* -++ &XC(2)+1.0D0)/(XC(3)+2.2D0*XC(2)) -++ FVECC(6)=((XC(1)-0.32D0)*XC(3)+(1.666666666666667D0*XC(1)-0.533333 -++ &3333333333D0)*XC(2)+1.0D0)/(XC(3)+1.666666666666667D0*XC(2)) -++ FVECC(7)=((XC(1)-0.35D0)*XC(3)+(1.285714285714286D0*XC(1)-0.45D0)* -++ &XC(2)+1.0D0)/(XC(3)+1.285714285714286D0*XC(2)) -++ FVECC(8)=((XC(1)-0.39D0)*XC(3)+(XC(1)-0.39D0)*XC(2)+1.0D0)/(XC(3)+ -++ &XC(2)) -++ FVECC(9)=((XC(1)-0.37D0)*XC(3)+(XC(1)-0.37D0)*XC(2)+1.285714285714 -++ &286D0)/(XC(3)+XC(2)) -++ FVECC(10)=((XC(1)-0.58D0)*XC(3)+(XC(1)-0.58D0)*XC(2)+1.66666666666 -++ &6667D0)/(XC(3)+XC(2)) -++ FVECC(11)=((XC(1)-0.73D0)*XC(3)+(XC(1)-0.73D0)*XC(2)+2.2D0)/(XC(3) -++ &+XC(2)) -++ FVECC(12)=((XC(1)-0.96D0)*XC(3)+(XC(1)-0.96D0)*XC(2)+3.0D0)/(XC(3) -++ &+XC(2)) -++ FVECC(13)=((XC(1)-1.34D0)*XC(3)+(XC(1)-1.34D0)*XC(2)+4.33333333333 -++ &3333D0)/(XC(3)+XC(2)) -++ FVECC(14)=((XC(1)-2.1D0)*XC(3)+(XC(1)-2.1D0)*XC(2)+7.0D0)/(XC(3)+X -++ &C(2)) -++ FVECC(15)=((XC(1)-4.39D0)*XC(3)+(XC(1)-4.39D0)*XC(2)+15.0D0)/(XC(3 -++ &)+XC(2)) -++ FJACC(1,1)=1.0D0 -++ FJACC(1,2)=-15.0D0/(XC(3)**2+30.0D0*XC(2)*XC(3)+225.0D0*XC(2)**2) -++ FJACC(1,3)=-1.0D0/(XC(3)**2+30.0D0*XC(2)*XC(3)+225.0D0*XC(2)**2) -++ FJACC(2,1)=1.0D0 -++ FJACC(2,2)=-7.0D0/(XC(3)**2+14.0D0*XC(2)*XC(3)+49.0D0*XC(2)**2) -++ FJACC(2,3)=-1.0D0/(XC(3)**2+14.0D0*XC(2)*XC(3)+49.0D0*XC(2)**2) -++ FJACC(3,1)=1.0D0 -++ FJACC(3,2)=((-0.1110223024625157D-15*XC(3))-4.333333333333333D0)/( -++ &XC(3)**2+8.666666666666666D0*XC(2)*XC(3)+18.77777777777778D0*XC(2) -++ &**2) -++ FJACC(3,3)=(0.1110223024625157D-15*XC(2)-1.0D0)/(XC(3)**2+8.666666 -++ &666666666D0*XC(2)*XC(3)+18.77777777777778D0*XC(2)**2) -++ FJACC(4,1)=1.0D0 -++ FJACC(4,2)=-3.0D0/(XC(3)**2+6.0D0*XC(2)*XC(3)+9.0D0*XC(2)**2) -++ FJACC(4,3)=-1.0D0/(XC(3)**2+6.0D0*XC(2)*XC(3)+9.0D0*XC(2)**2) -++ FJACC(5,1)=1.0D0 -++ FJACC(5,2)=((-0.1110223024625157D-15*XC(3))-2.2D0)/(XC(3)**2+4.399 -++ &999999999999D0*XC(2)*XC(3)+4.839999999999998D0*XC(2)**2) -++ FJACC(5,3)=(0.1110223024625157D-15*XC(2)-1.0D0)/(XC(3)**2+4.399999 -++ &999999999D0*XC(2)*XC(3)+4.839999999999998D0*XC(2)**2) -++ FJACC(6,1)=1.0D0 -++ FJACC(6,2)=((-0.2220446049250313D-15*XC(3))-1.666666666666667D0)/( -++ &XC(3)**2+3.333333333333333D0*XC(2)*XC(3)+2.777777777777777D0*XC(2) -++ &**2) -++ FJACC(6,3)=(0.2220446049250313D-15*XC(2)-1.0D0)/(XC(3)**2+3.333333 -++ &333333333D0*XC(2)*XC(3)+2.777777777777777D0*XC(2)**2) -++ FJACC(7,1)=1.0D0 -++ FJACC(7,2)=((-0.5551115123125783D-16*XC(3))-1.285714285714286D0)/( -++ &XC(3)**2+2.571428571428571D0*XC(2)*XC(3)+1.653061224489796D0*XC(2) -++ &**2) -++ FJACC(7,3)=(0.5551115123125783D-16*XC(2)-1.0D0)/(XC(3)**2+2.571428 -++ &571428571D0*XC(2)*XC(3)+1.653061224489796D0*XC(2)**2) -++ FJACC(8,1)=1.0D0 -++ FJACC(8,2)=-1.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) -++ FJACC(8,3)=-1.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) -++ FJACC(9,1)=1.0D0 -++ FJACC(9,2)=-1.285714285714286D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)* -++ &*2) -++ FJACC(9,3)=-1.285714285714286D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)* -++ &*2) -++ FJACC(10,1)=1.0D0 -++ FJACC(10,2)=-1.666666666666667D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2) -++ &**2) -++ FJACC(10,3)=-1.666666666666667D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2) -++ &**2) -++ FJACC(11,1)=1.0D0 -++ FJACC(11,2)=-2.2D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) -++ FJACC(11,3)=-2.2D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) -++ FJACC(12,1)=1.0D0 -++ FJACC(12,2)=-3.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) -++ FJACC(12,3)=-3.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) -++ FJACC(13,1)=1.0D0 -++ FJACC(13,2)=-4.333333333333333D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2) -++ &**2) -++ FJACC(13,3)=-4.333333333333333D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2) -++ &**2) -++ FJACC(14,1)=1.0D0 -++ FJACC(14,2)=-7.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) -++ FJACC(14,3)=-7.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) -++ FJACC(15,1)=1.0D0 -++ FJACC(15,2)=-15.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) -++ FJACC(15,3)=-15.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) -++ RETURN -++ END -++\end{verbatim} - -Asp19(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - FC ==> FortranCode - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FC)) - FSTU ==> Union(fst:FST,void:"void") - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - MFLOAT ==> MachineFloat - VEC ==> Vector - VF2 ==> VectorFunctions2 - MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,Matrix FEXPR,EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,Matrix EXPR MFLOAT) - FEXPR ==> FortranExpression([],['XC],MFLOAT) - S ==> Symbol - - Exports ==> FortranVectorFunctionCategory with - coerce : VEC FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - real : FSTU := ["real"::FST]$FSTU - syms : SYMTAB := empty()$SYMTAB - declare!(M,fortranInteger()$FT,syms)$SYMTAB - declare!(N,fortranInteger()$FT,syms)$SYMTAB - declare!(LJC,fortranInteger()$FT,syms)$SYMTAB - xcType : FT := construct(real,[N],false)$FT - declare!(XC,xcType,syms)$SYMTAB - fveccType : FT := construct(real,[M],false)$FT - declare!(FVECC,fveccType,syms)$SYMTAB - fjaccType : FT := construct(real,[LJC,N],false)$FT - declare!(FJACC,fjaccType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$FSTU,[M,N,XC,FVECC,FJACC,LJC],syms) - - coerce(c:List FC):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FC):$ == coerce(c)$Rep - - -- Take a symbol, pull of the script and turn it into an integer!! - o2int(u:S):Integer == - o : OutputForm := first elt(scripts(u)$S,sub) - o pretend Integer - - -- To help the poor old compiler! - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - localAssign1(s:S,j:Matrix FEXPR):FC == - j' : Matrix EXPR MFLOAT := map(fexpr2expr,j)$MF2 - assign(s,j')$FC - - localAssign2(s:S,j:VEC FEXPR):FC == - j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) - assign(s,j')$FC - - coerce(u:VEC FEXPR):$ == - -- First zero the Jacobian matrix in case we miss some derivatives which - -- are zero. - import POLY INT - seg1 : Segment (POLY INT) := segment(1::(POLY INT),LJC@S::(POLY INT)) - seg2 : Segment (POLY INT) := segment(1::(POLY INT),N@S::(POLY INT)) - s1 : SegmentBinding POLY INT := equation(I@S,seg1) - s2 : SegmentBinding POLY INT := equation(J@S,seg2) - as : FC := assign(FJACC,[I@S::(POLY INT),J@S::(POLY INT)],0.0::EXPR FLOAT) - clear : FC := forLoop(s1,forLoop(s2,as)) - x:S := XC::S - pu:List(S) := [] - -- Work out which variables appear in the expressions - for e in entries(u) repeat - pu := setUnion(pu,variables(e)$FEXPR) - scriptList : List Integer := map(o2int,pu)$ListFunctions2(S,Integer) - -- This should be the maximum XC_n which occurs (there may be others - -- which don't): - n:Integer := reduce(max,scriptList)$List(Integer) - p:List(S) := [] - for j in 1..n repeat p:= cons(subscript(x,[j::OutputForm])$S,p) - p:= reverse(p) - jac:Matrix(FEXPR) := _ - jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S)) - c1:FC := localAssign2(FVECC,u) - c2:FC := localAssign1(FJACC,jac) - [clear,c1,c2,returns()]$List(FC)::$ - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - -@ -\section{domain ASP20 Asp20} -<<domain ASP20 Asp20>>= -)abbrev domain ASP20 Asp20 -++ Author: Mike Dewar and Godfrey Nolan and Grant Keady -++ Date Created: Dec 1993 -++ Date Last Updated: 21 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp20} produces Fortran for Type 20 ASPs, for example: -++\begin{verbatim} -++ SUBROUTINE QPHESS(N,NROWH,NCOLH,JTHCOL,HESS,X,HX) -++ DOUBLE PRECISION HX(N),X(N),HESS(NROWH,NCOLH) -++ INTEGER JTHCOL,N,NROWH,NCOLH -++ HX(1)=2.0D0*X(1) -++ HX(2)=2.0D0*X(2) -++ HX(3)=2.0D0*X(4)+2.0D0*X(3) -++ HX(4)=2.0D0*X(4)+2.0D0*X(3) -++ HX(5)=2.0D0*X(5) -++ HX(6)=(-2.0D0*X(7))+(-2.0D0*X(6)) -++ HX(7)=(-2.0D0*X(7))+(-2.0D0*X(6)) -++ RETURN -++ END -++\end{verbatim} - -Asp20(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - PI ==> PositiveInteger - UFST ==> Union(fst:FST,void:"void") - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - MAT ==> Matrix - VF2 ==> VectorFunctions2 - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression([],['X,'HESS],MFLOAT) - O ==> OutputForm - M2 ==> MatrixCategoryFunctions2 - MF2a ==> M2(FRAC POLY INT,VEC FRAC POLY INT,VEC FRAC POLY INT, - MAT FRAC POLY INT,FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2b ==> M2(FRAC POLY FLOAT,VEC FRAC POLY FLOAT,VEC FRAC POLY FLOAT, - MAT FRAC POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2c ==> M2(POLY INT,VEC POLY INT,VEC POLY INT,MAT POLY INT, - FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2d ==> M2(POLY FLOAT,VEC POLY FLOAT,VEC POLY FLOAT, - MAT POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2e ==> M2(EXPR INT,VEC EXPR INT,VEC EXPR INT,MAT EXPR INT, - FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2f ==> M2(EXPR FLOAT,VEC EXPR FLOAT,VEC EXPR FLOAT, - MAT EXPR FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - - - Exports == Join(FortranMatrixFunctionCategory, CoercibleFrom MAT FEXPR) - Implementation == add - - real : UFST := ["real"::FST]$UFST - syms : SYMTAB := empty() - declare!(N,fortranInteger(),syms)$SYMTAB - declare!(NROWH,fortranInteger(),syms)$SYMTAB - declare!(NCOLH,fortranInteger(),syms)$SYMTAB - declare!(JTHCOL,fortranInteger(),syms)$SYMTAB - hessType : FT := construct(real,[NROWH,NCOLH],false)$FT - declare!(HESS,hessType,syms)$SYMTAB - xType : FT := construct(real,[N],false)$FT - declare!(X,xType,syms)$SYMTAB - declare!(HX,xType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST, - [N,NROWH,NCOLH,JTHCOL,HESS,X,HX],syms) - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FortranCode):$ == coerce(c)$Rep - - -- To help the poor old compiler! - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - localAssign(s:Symbol,j:VEC FEXPR):FortranCode == - j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) - assign(s,j')$FortranCode - - coerce(u:MAT FEXPR):$ == - x:Symbol := X::Symbol - n := nrows(u)::PI - p:VEC FEXPR := [retract(subscript(x,[j::O])$Symbol)@FEXPR for j in 1..n] - prod:VEC FEXPR := u*p - ([localAssign(HX,prod),returns()$FortranCode]$List(FortranCode))::$ - - retract(u:MAT FRAC POLY INT):$ == - v : MAT FEXPR := map(retract,u)$MF2a - v::$ - - retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT FRAC POLY FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2b - v::$ - - retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT EXPR INT):$ == - v : MAT FEXPR := map(retract,u)$MF2e - v::$ - - retractIfCan(u:MAT EXPR INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT EXPR FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2f - v::$ - - retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT POLY INT):$ == - v : MAT FEXPR := map(retract,u)$MF2c - v::$ - - retractIfCan(u:MAT POLY INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT POLY FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2d - v::$ - - retractIfCan(u:MAT POLY FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - coerce(u:$):O == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP24 Asp24} -<<domain ASP24 Asp24>>= -)abbrev domain ASP24 Asp24 -++ Author: Mike Dewar, Grant Keady and Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 21 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp24} produces Fortran for Type 24 ASPs which evaluate a -++multivariate function at a point (needed for NAG routine \axiomOpFrom{e04jaf}{e04Package}), for example: -++\begin{verbatim} -++ SUBROUTINE FUNCT1(N,XC,FC) -++ DOUBLE PRECISION FC,XC(N) -++ INTEGER N -++ FC=10.0D0*XC(4)**4+(-40.0D0*XC(1)*XC(4)**3)+(60.0D0*XC(1)**2+5 -++ &.0D0)*XC(4)**2+((-10.0D0*XC(3))+(-40.0D0*XC(1)**3))*XC(4)+16.0D0*X -++ &C(3)**4+(-32.0D0*XC(2)*XC(3)**3)+(24.0D0*XC(2)**2+5.0D0)*XC(3)**2+ -++ &(-8.0D0*XC(2)**3*XC(3))+XC(2)**4+100.0D0*XC(2)**2+20.0D0*XC(1)*XC( -++ &2)+10.0D0*XC(1)**4+XC(1)**2 -++ RETURN -++ END -++\end{verbatim} - -Asp24(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FSTU ==> Union(fst:FST,void:"void") - FEXPR ==> FortranExpression([],['XC],MachineFloat) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - - Exports ==> FortranFunctionCategory with - coerce : FEXPR -> $ - ++ coerce(f) takes an object from the appropriate instantiation of - ++ \spadtype{FortranExpression} and turns it into an ASP. - - - Implementation ==> add - - - real : FSTU := ["real"::FST]$FSTU - syms : SYMTAB := empty() - declare!(N,fortranInteger(),syms)$SYMTAB - xcType : FT := construct(real,[N::Symbol],false)$FT - declare!(XC,xcType,syms)$SYMTAB - declare!(FC,fortranReal(),syms)$SYMTAB - Rep := FortranProgram(name,["void"]$FSTU,[N,XC,FC],syms) - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(u:FEXPR):$ == - coerce(assign(FC,u::Expression(MachineFloat))$FortranCode)$Rep - - retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:FRAC POLY INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:EXPR FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:EXPR INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:POLY FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:POLY INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:POLY INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP27 Asp27} -<<domain ASP27 Asp27>>= -)abbrev domain ASP27 Asp27 -++ Author: Mike Dewar and Godfrey Nolan -++ Date Created: Nov 1993 -++ Date Last Updated: 27 April 1994 -++ 6 October 1994 -++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp27} produces Fortran for Type 27 ASPs, needed for NAG routine -++\axiomOpFrom{f02fjf}{f02Package} ,for example: -++\begin{verbatim} -++ FUNCTION DOT(IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK) -++ DOUBLE PRECISION W(N),Z(N),RWORK(LRWORK) -++ INTEGER N,LIWORK,IFLAG,LRWORK,IWORK(LIWORK) -++ DOT=(W(16)+(-0.5D0*W(15)))*Z(16)+((-0.5D0*W(16))+W(15)+(-0.5D0*W(1 -++ &4)))*Z(15)+((-0.5D0*W(15))+W(14)+(-0.5D0*W(13)))*Z(14)+((-0.5D0*W( -++ &14))+W(13)+(-0.5D0*W(12)))*Z(13)+((-0.5D0*W(13))+W(12)+(-0.5D0*W(1 -++ &1)))*Z(12)+((-0.5D0*W(12))+W(11)+(-0.5D0*W(10)))*Z(11)+((-0.5D0*W( -++ &11))+W(10)+(-0.5D0*W(9)))*Z(10)+((-0.5D0*W(10))+W(9)+(-0.5D0*W(8)) -++ &)*Z(9)+((-0.5D0*W(9))+W(8)+(-0.5D0*W(7)))*Z(8)+((-0.5D0*W(8))+W(7) -++ &+(-0.5D0*W(6)))*Z(7)+((-0.5D0*W(7))+W(6)+(-0.5D0*W(5)))*Z(6)+((-0. -++ &5D0*W(6))+W(5)+(-0.5D0*W(4)))*Z(5)+((-0.5D0*W(5))+W(4)+(-0.5D0*W(3 -++ &)))*Z(4)+((-0.5D0*W(4))+W(3)+(-0.5D0*W(2)))*Z(3)+((-0.5D0*W(3))+W( -++ &2)+(-0.5D0*W(1)))*Z(2)+((-0.5D0*W(2))+W(1))*Z(1) -++ RETURN -++ END -++\end{verbatim} - -Asp27(name): Exports == Implementation where - name : Symbol - - O ==> OutputForm - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - UFST ==> Union(fst:FST,void:"void") - FC ==> FortranCode - PI ==> PositiveInteger - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - EXPR ==> Expression - MAT ==> Matrix - MFLOAT ==> MachineFloat - - - - Exports == FortranMatrixCategory - - Implementation == add - - - real : UFST := ["real"::FST]$UFST - integer : UFST := ["integer"::FST]$UFST - syms : SYMTAB := empty()$SYMTAB - declare!(IFLAG,fortranInteger(),syms)$SYMTAB - declare!(N,fortranInteger(),syms)$SYMTAB - declare!(LRWORK,fortranInteger(),syms)$SYMTAB - declare!(LIWORK,fortranInteger(),syms)$SYMTAB - zType : FT := construct(real,[N],false)$FT - declare!(Z,zType,syms)$SYMTAB - declare!(W,zType,syms)$SYMTAB - rType : FT := construct(real,[LRWORK],false)$FT - declare!(RWORK,rType,syms)$SYMTAB - iType : FT := construct(integer,[LIWORK],false)$FT - declare!(IWORK,iType,syms)$SYMTAB - Rep := FortranProgram(name,real, - [IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK],syms) - - -- To help the poor old compiler! - localCoerce(u:Symbol):EXPR(MFLOAT) == coerce(u)$EXPR(MFLOAT) - - coerce (u:MAT MFLOAT):$ == - Ws: Symbol := W - Zs: Symbol := Z - code : List FC - l:EXPR MFLOAT := "+"/ _ - [("+"/[localCoerce(elt(Ws,[j::O])$Symbol) * u(j,i)_ - for j in 1..nrows(u)::PI])_ - *localCoerce(elt(Zs,[i::O])$Symbol) for i in 1..ncols(u)::PI] - c := assign(name,l)$FC - code := [c,returns()]$List(FC) - code::$ - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP28 Asp28} -<<domain ASP28 Asp28>>= -)abbrev domain ASP28 Asp28 -++ Author: Mike Dewar -++ Date Created: 21 March 1994 -++ Date Last Updated: 28 April 1994 -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp28} produces Fortran for Type 28 ASPs, used in NAG routine -++\axiomOpFrom{f02fjf}{f02Package}, for example: -++\begin{verbatim} -++ SUBROUTINE IMAGE(IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK) -++ DOUBLE PRECISION Z(N),W(N),IWORK(LRWORK),RWORK(LRWORK) -++ INTEGER N,LIWORK,IFLAG,LRWORK -++ W(1)=0.01707454969713436D0*Z(16)+0.001747395874954051D0*Z(15)+0.00 -++ &2106973900813502D0*Z(14)+0.002957434991769087D0*Z(13)+(-0.00700554 -++ &0882865317D0*Z(12))+(-0.01219194009813166D0*Z(11))+0.0037230647365 -++ &3087D0*Z(10)+0.04932374658377151D0*Z(9)+(-0.03586220812223305D0*Z( -++ &8))+(-0.04723268012114625D0*Z(7))+(-0.02434652144032987D0*Z(6))+0. -++ &2264766947290192D0*Z(5)+(-0.1385343580686922D0*Z(4))+(-0.116530050 -++ &8238904D0*Z(3))+(-0.2803531651057233D0*Z(2))+1.019463911841327D0*Z -++ &(1) -++ W(2)=0.0227345011107737D0*Z(16)+0.008812321197398072D0*Z(15)+0.010 -++ &94012210519586D0*Z(14)+(-0.01764072463999744D0*Z(13))+(-0.01357136 -++ &72105995D0*Z(12))+0.00157466157362272D0*Z(11)+0.05258889186338282D -++ &0*Z(10)+(-0.01981532388243379D0*Z(9))+(-0.06095390688679697D0*Z(8) -++ &)+(-0.04153119955569051D0*Z(7))+0.2176561076571465D0*Z(6)+(-0.0532 -++ &5555586632358D0*Z(5))+(-0.1688977368984641D0*Z(4))+(-0.32440166056 -++ &67343D0*Z(3))+0.9128222941872173D0*Z(2)+(-0.2419652703415429D0*Z(1 -++ &)) -++ W(3)=0.03371198197190302D0*Z(16)+0.02021603150122265D0*Z(15)+(-0.0 -++ &06607305534689702D0*Z(14))+(-0.03032392238968179D0*Z(13))+0.002033 -++ &305231024948D0*Z(12)+0.05375944956767728D0*Z(11)+(-0.0163213312502 -++ &9967D0*Z(10))+(-0.05483186562035512D0*Z(9))+(-0.04901428822579872D -++ &0*Z(8))+0.2091097927887612D0*Z(7)+(-0.05760560341383113D0*Z(6))+(- -++ &0.1236679206156403D0*Z(5))+(-0.3523683853026259D0*Z(4))+0.88929961 -++ &32269974D0*Z(3)+(-0.2995429545781457D0*Z(2))+(-0.02986582812574917 -++ &D0*Z(1)) -++ W(4)=0.05141563713660119D0*Z(16)+0.005239165960779299D0*Z(15)+(-0. -++ &01623427735779699D0*Z(14))+(-0.01965809746040371D0*Z(13))+0.054688 -++ &97337339577D0*Z(12)+(-0.014224695935687D0*Z(11))+(-0.0505181779315 -++ &6355D0*Z(10))+(-0.04353074206076491D0*Z(9))+0.2012230497530726D0*Z -++ &(8)+(-0.06630874514535952D0*Z(7))+(-0.1280829963720053D0*Z(6))+(-0 -++ &.305169742604165D0*Z(5))+0.8600427128450191D0*Z(4)+(-0.32415033802 -++ &68184D0*Z(3))+(-0.09033531980693314D0*Z(2))+0.09089205517109111D0* -++ &Z(1) -++ W(5)=0.04556369767776375D0*Z(16)+(-0.001822737697581869D0*Z(15))+( -++ &-0.002512226501941856D0*Z(14))+0.02947046460707379D0*Z(13)+(-0.014 -++ &45079632086177D0*Z(12))+(-0.05034242196614937D0*Z(11))+(-0.0376966 -++ &3291725935D0*Z(10))+0.2171103102175198D0*Z(9)+(-0.0824949256021352 -++ &4D0*Z(8))+(-0.1473995209288945D0*Z(7))+(-0.315042193418466D0*Z(6)) -++ &+0.9591623347824002D0*Z(5)+(-0.3852396953763045D0*Z(4))+(-0.141718 -++ &5427288274D0*Z(3))+(-0.03423495461011043D0*Z(2))+0.319820917706851 -++ &6D0*Z(1) -++ W(6)=0.04015147277405744D0*Z(16)+0.01328585741341559D0*Z(15)+0.048 -++ &26082005465965D0*Z(14)+(-0.04319641116207706D0*Z(13))+(-0.04931323 -++ &319055762D0*Z(12))+(-0.03526886317505474D0*Z(11))+0.22295383396730 -++ &01D0*Z(10)+(-0.07375317649315155D0*Z(9))+(-0.1589391311991561D0*Z( -++ &8))+(-0.328001910890377D0*Z(7))+0.952576555482747D0*Z(6)+(-0.31583 -++ &09975786731D0*Z(5))+(-0.1846882042225383D0*Z(4))+(-0.0703762046700 -++ &4427D0*Z(3))+0.2311852964327382D0*Z(2)+0.04254083491825025D0*Z(1) -++ W(7)=0.06069778964023718D0*Z(16)+0.06681263884671322D0*Z(15)+(-0.0 -++ &2113506688615768D0*Z(14))+(-0.083996867458326D0*Z(13))+(-0.0329843 -++ &8523869648D0*Z(12))+0.2276878326327734D0*Z(11)+(-0.067356038933017 -++ &95D0*Z(10))+(-0.1559813965382218D0*Z(9))+(-0.3363262957694705D0*Z( -++ &8))+0.9442791158560948D0*Z(7)+(-0.3199955249404657D0*Z(6))+(-0.136 -++ &2463839920727D0*Z(5))+(-0.1006185171570586D0*Z(4))+0.2057504515015 -++ &423D0*Z(3)+(-0.02065879269286707D0*Z(2))+0.03160990266745513D0*Z(1 -++ &) -++ W(8)=0.126386868896738D0*Z(16)+0.002563370039476418D0*Z(15)+(-0.05 -++ &581757739455641D0*Z(14))+(-0.07777893205900685D0*Z(13))+0.23117338 -++ &45834199D0*Z(12)+(-0.06031581134427592D0*Z(11))+(-0.14805474755869 -++ &52D0*Z(10))+(-0.3364014128402243D0*Z(9))+0.9364014128402244D0*Z(8) -++ &+(-0.3269452524413048D0*Z(7))+(-0.1396841886557241D0*Z(6))+(-0.056 -++ &1733845834199D0*Z(5))+0.1777789320590069D0*Z(4)+(-0.04418242260544 -++ &359D0*Z(3))+(-0.02756337003947642D0*Z(2))+0.07361313110326199D0*Z( -++ &1) -++ W(9)=0.07361313110326199D0*Z(16)+(-0.02756337003947642D0*Z(15))+(- -++ &0.04418242260544359D0*Z(14))+0.1777789320590069D0*Z(13)+(-0.056173 -++ &3845834199D0*Z(12))+(-0.1396841886557241D0*Z(11))+(-0.326945252441 -++ &3048D0*Z(10))+0.9364014128402244D0*Z(9)+(-0.3364014128402243D0*Z(8 -++ &))+(-0.1480547475586952D0*Z(7))+(-0.06031581134427592D0*Z(6))+0.23 -++ &11733845834199D0*Z(5)+(-0.07777893205900685D0*Z(4))+(-0.0558175773 -++ &9455641D0*Z(3))+0.002563370039476418D0*Z(2)+0.126386868896738D0*Z( -++ &1) -++ W(10)=0.03160990266745513D0*Z(16)+(-0.02065879269286707D0*Z(15))+0 -++ &.2057504515015423D0*Z(14)+(-0.1006185171570586D0*Z(13))+(-0.136246 -++ &3839920727D0*Z(12))+(-0.3199955249404657D0*Z(11))+0.94427911585609 -++ &48D0*Z(10)+(-0.3363262957694705D0*Z(9))+(-0.1559813965382218D0*Z(8 -++ &))+(-0.06735603893301795D0*Z(7))+0.2276878326327734D0*Z(6)+(-0.032 -++ &98438523869648D0*Z(5))+(-0.083996867458326D0*Z(4))+(-0.02113506688 -++ &615768D0*Z(3))+0.06681263884671322D0*Z(2)+0.06069778964023718D0*Z( -++ &1) -++ W(11)=0.04254083491825025D0*Z(16)+0.2311852964327382D0*Z(15)+(-0.0 -++ &7037620467004427D0*Z(14))+(-0.1846882042225383D0*Z(13))+(-0.315830 -++ &9975786731D0*Z(12))+0.952576555482747D0*Z(11)+(-0.328001910890377D -++ &0*Z(10))+(-0.1589391311991561D0*Z(9))+(-0.07375317649315155D0*Z(8) -++ &)+0.2229538339673001D0*Z(7)+(-0.03526886317505474D0*Z(6))+(-0.0493 -++ &1323319055762D0*Z(5))+(-0.04319641116207706D0*Z(4))+0.048260820054 -++ &65965D0*Z(3)+0.01328585741341559D0*Z(2)+0.04015147277405744D0*Z(1) -++ W(12)=0.3198209177068516D0*Z(16)+(-0.03423495461011043D0*Z(15))+(- -++ &0.1417185427288274D0*Z(14))+(-0.3852396953763045D0*Z(13))+0.959162 -++ &3347824002D0*Z(12)+(-0.315042193418466D0*Z(11))+(-0.14739952092889 -++ &45D0*Z(10))+(-0.08249492560213524D0*Z(9))+0.2171103102175198D0*Z(8 -++ &)+(-0.03769663291725935D0*Z(7))+(-0.05034242196614937D0*Z(6))+(-0. -++ &01445079632086177D0*Z(5))+0.02947046460707379D0*Z(4)+(-0.002512226 -++ &501941856D0*Z(3))+(-0.001822737697581869D0*Z(2))+0.045563697677763 -++ &75D0*Z(1) -++ W(13)=0.09089205517109111D0*Z(16)+(-0.09033531980693314D0*Z(15))+( -++ &-0.3241503380268184D0*Z(14))+0.8600427128450191D0*Z(13)+(-0.305169 -++ &742604165D0*Z(12))+(-0.1280829963720053D0*Z(11))+(-0.0663087451453 -++ &5952D0*Z(10))+0.2012230497530726D0*Z(9)+(-0.04353074206076491D0*Z( -++ &8))+(-0.05051817793156355D0*Z(7))+(-0.014224695935687D0*Z(6))+0.05 -++ &468897337339577D0*Z(5)+(-0.01965809746040371D0*Z(4))+(-0.016234277 -++ &35779699D0*Z(3))+0.005239165960779299D0*Z(2)+0.05141563713660119D0 -++ &*Z(1) -++ W(14)=(-0.02986582812574917D0*Z(16))+(-0.2995429545781457D0*Z(15)) -++ &+0.8892996132269974D0*Z(14)+(-0.3523683853026259D0*Z(13))+(-0.1236 -++ &679206156403D0*Z(12))+(-0.05760560341383113D0*Z(11))+0.20910979278 -++ &87612D0*Z(10)+(-0.04901428822579872D0*Z(9))+(-0.05483186562035512D -++ &0*Z(8))+(-0.01632133125029967D0*Z(7))+0.05375944956767728D0*Z(6)+0 -++ &.002033305231024948D0*Z(5)+(-0.03032392238968179D0*Z(4))+(-0.00660 -++ &7305534689702D0*Z(3))+0.02021603150122265D0*Z(2)+0.033711981971903 -++ &02D0*Z(1) -++ W(15)=(-0.2419652703415429D0*Z(16))+0.9128222941872173D0*Z(15)+(-0 -++ &.3244016605667343D0*Z(14))+(-0.1688977368984641D0*Z(13))+(-0.05325 -++ &555586632358D0*Z(12))+0.2176561076571465D0*Z(11)+(-0.0415311995556 -++ &9051D0*Z(10))+(-0.06095390688679697D0*Z(9))+(-0.01981532388243379D -++ &0*Z(8))+0.05258889186338282D0*Z(7)+0.00157466157362272D0*Z(6)+(-0. -++ &0135713672105995D0*Z(5))+(-0.01764072463999744D0*Z(4))+0.010940122 -++ &10519586D0*Z(3)+0.008812321197398072D0*Z(2)+0.0227345011107737D0*Z -++ &(1) -++ W(16)=1.019463911841327D0*Z(16)+(-0.2803531651057233D0*Z(15))+(-0. -++ &1165300508238904D0*Z(14))+(-0.1385343580686922D0*Z(13))+0.22647669 -++ &47290192D0*Z(12)+(-0.02434652144032987D0*Z(11))+(-0.04723268012114 -++ &625D0*Z(10))+(-0.03586220812223305D0*Z(9))+0.04932374658377151D0*Z -++ &(8)+0.00372306473653087D0*Z(7)+(-0.01219194009813166D0*Z(6))+(-0.0 -++ &07005540882865317D0*Z(5))+0.002957434991769087D0*Z(4)+0.0021069739 -++ &00813502D0*Z(3)+0.001747395874954051D0*Z(2)+0.01707454969713436D0* -++ &Z(1) -++ RETURN -++ END -++\end{verbatim} - -Asp28(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - FC ==> FortranCode - PI ==> PositiveInteger - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - EXPR ==> Expression - MFLOAT ==> MachineFloat - VEC ==> Vector - UFST ==> Union(fst:FST,void:"void") - MAT ==> Matrix - - Exports == FortranMatrixCategory - - Implementation == add - - - real : UFST := ["real"::FST]$UFST - syms : SYMTAB := empty() - declare!(IFLAG,fortranInteger(),syms)$SYMTAB - declare!(N,fortranInteger(),syms)$SYMTAB - declare!(LRWORK,fortranInteger(),syms)$SYMTAB - declare!(LIWORK,fortranInteger(),syms)$SYMTAB - xType : FT := construct(real,[N],false)$FT - declare!(Z,xType,syms)$SYMTAB - declare!(W,xType,syms)$SYMTAB - rType : FT := construct(real,[LRWORK],false)$FT - declare!(RWORK,rType,syms)$SYMTAB - iType : FT := construct(real,[LIWORK],false)$FT - declare!(IWORK,rType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST, - [IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK],syms) - - -- To help the poor old compiler! - localCoerce(u:Symbol):EXPR(MFLOAT) == coerce(u)$EXPR(MFLOAT) - - coerce (u:MAT MFLOAT):$ == - Zs: Symbol := Z - code : List FC - r: List EXPR MFLOAT - r := ["+"/[u(j,i)*localCoerce(elt(Zs,[i::OutputForm])$Symbol)_ - for i in 1..ncols(u)$MAT(MFLOAT)::PI]_ - for j in 1..nrows(u)$MAT(MFLOAT)::PI] - code := [assign(W@Symbol,vector(r)$VEC(EXPR MFLOAT)),returns()]$List(FC) - code::$ - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP29 Asp29} -<<domain ASP29 Asp29>>= -)abbrev domain ASP29 Asp29 -++ Author: Mike Dewar and Godfrey Nolan -++ Date Created: Nov 1993 -++ Date Last Updated: 18 March 1994 -++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp29} produces Fortran for Type 29 ASPs, needed for NAG routine -++\axiomOpFrom{f02fjf}{f02Package}, for example: -++\begin{verbatim} -++ SUBROUTINE MONIT(ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D) -++ DOUBLE PRECISION D(K),F(K) -++ INTEGER K,NEXTIT,NEVALS,NVECS,ISTATE -++ CALL F02FJZ(ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D) -++ RETURN -++ END -++\end{verbatim} - -Asp29(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - FSTU ==> Union(fst:FST,void:"void") - SYMTAB ==> SymbolTable - FC ==> FortranCode - PI ==> PositiveInteger - EXF ==> Expression Float - EXI ==> Expression Integer - VEF ==> Vector Expression Float - VEI ==> Vector Expression Integer - MEI ==> Matrix Expression Integer - MEF ==> Matrix Expression Float - UEXPR ==> Union(I: Expression Integer,F: Expression Float,_ - CF: Expression Complex Float) - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - - Exports == FortranProgramCategory with - outputAsFortran:() -> Void - ++outputAsFortran() generates the default code for \spadtype{ASP29}. - - - Implementation == add - - import FST - import FT - import FC - import SYMTAB - - real : FSTU := ["real"::FST]$FSTU - integer : FSTU := ["integer"::FST]$FSTU - syms : SYMTAB := empty() - declare!(ISTATE,fortranInteger(),syms) - declare!(NEXTIT,fortranInteger(),syms) - declare!(NEVALS,fortranInteger(),syms) - declare!(NVECS,fortranInteger(),syms) - declare!(K,fortranInteger(),syms) - kType : FT := construct(real,[K],false)$FT - declare!(F,kType,syms) - declare!(D,kType,syms) - Rep := FortranProgram(name,["void"]$FSTU, - [ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D],syms) - - - outputAsFortran():Void == - callOne := call("F02FJZ(ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D)") - code : List FC := [callOne,returns()]$List(FC) - outputAsFortran(coerce(code)@Rep)$Rep - -@ -\section{domain ASP30 Asp30} -<<domain ASP30 Asp30>>= -)abbrev domain ASP30 Asp30 -++ Author: Mike Dewar and Godfrey Nolan -++ Date Created: Nov 1993 -++ Date Last Updated: 28 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp30} produces Fortran for Type 30 ASPs, needed for NAG routine -++\axiomOpFrom{f04qaf}{f04Package}, for example: -++\begin{verbatim} -++ SUBROUTINE APROD(MODE,M,N,X,Y,RWORK,LRWORK,IWORK,LIWORK) -++ DOUBLE PRECISION X(N),Y(M),RWORK(LRWORK) -++ INTEGER M,N,LIWORK,IFAIL,LRWORK,IWORK(LIWORK),MODE -++ DOUBLE PRECISION A(5,5) -++ EXTERNAL F06PAF -++ A(1,1)=1.0D0 -++ A(1,2)=0.0D0 -++ A(1,3)=0.0D0 -++ A(1,4)=-1.0D0 -++ A(1,5)=0.0D0 -++ A(2,1)=0.0D0 -++ A(2,2)=1.0D0 -++ A(2,3)=0.0D0 -++ A(2,4)=0.0D0 -++ A(2,5)=-1.0D0 -++ A(3,1)=0.0D0 -++ A(3,2)=0.0D0 -++ A(3,3)=1.0D0 -++ A(3,4)=-1.0D0 -++ A(3,5)=0.0D0 -++ A(4,1)=-1.0D0 -++ A(4,2)=0.0D0 -++ A(4,3)=-1.0D0 -++ A(4,4)=4.0D0 -++ A(4,5)=-1.0D0 -++ A(5,1)=0.0D0 -++ A(5,2)=-1.0D0 -++ A(5,3)=0.0D0 -++ A(5,4)=-1.0D0 -++ A(5,5)=4.0D0 -++ IF(MODE.EQ.1)THEN -++ CALL F06PAF('N',M,N,1.0D0,A,M,X,1,1.0D0,Y,1) -++ ELSEIF(MODE.EQ.2)THEN -++ CALL F06PAF('T',M,N,1.0D0,A,M,Y,1,1.0D0,X,1) -++ ENDIF -++ RETURN -++ END -++\end{verbatim} - -Asp30(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - FC ==> FortranCode - PI ==> PositiveInteger - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - UFST ==> Union(fst:FST,void:"void") - MAT ==> Matrix - MFLOAT ==> MachineFloat - EXI ==> Expression Integer - UEXPR ==> Union(I:Expression Integer,F:Expression Float,_ - CF:Expression Complex Float,switch:Switch) - S ==> Symbol - - Exports == FortranMatrixCategory - - Implementation == add - - import FC - import FT - import Switch - - real : UFST := ["real"::FST]$UFST - integer : UFST := ["integer"::FST]$UFST - syms : SYMTAB := empty()$SYMTAB - declare!(MODE,fortranInteger()$FT,syms)$SYMTAB - declare!(M,fortranInteger()$FT,syms)$SYMTAB - declare!(N,fortranInteger()$FT,syms)$SYMTAB - declare!(LRWORK,fortranInteger()$FT,syms)$SYMTAB - declare!(LIWORK,fortranInteger()$FT,syms)$SYMTAB - xType : FT := construct(real,[N],false)$FT - declare!(X,xType,syms)$SYMTAB - yType : FT := construct(real,[M],false)$FT - declare!(Y,yType,syms)$SYMTAB - rType : FT := construct(real,[LRWORK],false)$FT - declare!(RWORK,rType,syms)$SYMTAB - iType : FT := construct(integer,[LIWORK],false)$FT - declare!(IWORK,iType,syms)$SYMTAB - declare!(IFAIL,fortranInteger()$FT,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST, - [MODE,M,N,X,Y,RWORK,LRWORK,IWORK,LIWORK],syms) - - coerce(a:MAT MFLOAT):$ == - locals : SYMTAB := empty() - numRows := nrows(a) :: Polynomial Integer - numCols := ncols(a) :: Polynomial Integer - declare!(A,[real,[numRows,numCols],false]$FT,locals) - declare!(F06PAF@S,construct(["void"]$UFST,[]@List(S),true)$FT,locals) - ptA:UEXPR := [("MODE"::S)::EXI] - ptB:UEXPR := [1::EXI] - ptC:UEXPR := [2::EXI] - sw1 : Switch := EQ(ptA,ptB)$Switch - sw2 : Switch := EQ(ptA,ptC)$Switch - callOne := call("F06PAF('N',M,N,1.0D0,A,M,X,1,1.0D0,Y,1)") - callTwo := call("F06PAF('T',M,N,1.0D0,A,M,Y,1,1.0D0,X,1)") - c : FC := cond(sw1,callOne,cond(sw2,callTwo)) - code' : List FC := [assign(A,a),c,returns()] - ([locals,code']$RSFC)::$ - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP31 Asp31} -<<domain ASP31 Asp31>>= -)abbrev domain ASP31 Asp31 -++ Author: Mike Dewar, Grant Keady and Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 22 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranMatrixFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp31} produces Fortran for Type 31 ASPs, needed for NAG routine -++\axiomOpFrom{d02ejf}{d02Package}, for example: -++\begin{verbatim} -++ SUBROUTINE PEDERV(X,Y,PW) -++ DOUBLE PRECISION X,Y(*) -++ DOUBLE PRECISION PW(3,3) -++ PW(1,1)=-0.03999999999999999D0 -++ PW(1,2)=10000.0D0*Y(3) -++ PW(1,3)=10000.0D0*Y(2) -++ PW(2,1)=0.03999999999999999D0 -++ PW(2,2)=(-10000.0D0*Y(3))+(-60000000.0D0*Y(2)) -++ PW(2,3)=-10000.0D0*Y(2) -++ PW(3,1)=0.0D0 -++ PW(3,2)=60000000.0D0*Y(2) -++ PW(3,3)=0.0D0 -++ RETURN -++ END -++\end{verbatim} - -Asp31(name): Exports == Implementation where - name : Symbol - - O ==> OutputForm - FST ==> FortranScalarType - UFST ==> Union(fst:FST,void:"void") - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression(['X],['Y],MFLOAT) - FT ==> FortranType - FC ==> FortranCode - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - MAT ==> Matrix - VF2 ==> VectorFunctions2 - MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR, - EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT) - - - - Exports ==> FortranVectorFunctionCategory with - coerce : VEC FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - - real : UFST := ["real"::FST]$UFST - syms : SYMTAB := empty() - declare!(X,fortranReal(),syms)$SYMTAB - yType : FT := construct(real,["*"::Symbol],false)$FT - declare!(Y,yType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST,[X,Y,PW],syms) - - -- To help the poor old compiler! - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - localAssign(s:Symbol,j:MAT FEXPR):FC == - j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2 - assign(s,j')$FC - - makeXList(n:Integer):List(Symbol) == - y:Symbol := Y::Symbol - p:List(Symbol) := [] - for j in 1 .. n repeat p:= cons(subscript(y,[j::OutputForm])$Symbol,p) - p:= reverse(p) - - coerce(u:VEC FEXPR):$ == - dimension := #u::Polynomial Integer - locals : SYMTAB := empty() - declare!(PW,[real,[dimension,dimension],false]$FT,locals)$SYMTAB - n:Integer := maxIndex(u)$VEC(FEXPR) - p:List(Symbol) := makeXList(n) - jac: MAT FEXPR := jacobian(u,p)$MultiVariableCalculusFunctions(_ - Symbol,FEXPR ,VEC FEXPR,List(Symbol)) - code' : List FC := [localAssign(PW,jac),returns()$FC]$List(FC) - ([locals,code']$RSFC)::$ - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - coerce(c:List FC):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FC):$ == coerce(c)$Rep - - coerce(u:$):O == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP33 Asp33} -<<domain ASP33 Asp33>>= -)abbrev domain ASP33 Asp33 -++ Author: Mike Dewar and Godfrey Nolan -++ Date Created: Nov 1993 -++ Date Last Updated: 30 March 1994 -++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory. -++ Description: -++\spadtype{Asp33} produces Fortran for Type 33 ASPs, needed for NAG routine -++\axiomOpFrom{d02kef}{d02Package}. The code is a dummy ASP: -++\begin{verbatim} -++ SUBROUTINE REPORT(X,V,JINT) -++ DOUBLE PRECISION V(3),X -++ INTEGER JINT -++ RETURN -++ END -++\end{verbatim} - -Asp33(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - UFST ==> Union(fst:FST,void:"void") - FT ==> FortranType - SYMTAB ==> SymbolTable - FC ==> FortranCode - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - - Exports ==> FortranProgramCategory with - outputAsFortran:() -> Void - ++outputAsFortran() generates the default code for \spadtype{ASP33}. - - - Implementation ==> add - - real : UFST := ["real"::FST]$UFST - syms : SYMTAB := empty() - declare!(JINT,fortranInteger(),syms)$SYMTAB - declare!(X,fortranReal(),syms)$SYMTAB - vType : FT := construct(real,["3"::Symbol],false)$FT - declare!(V,vType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST,[X,V,JINT],syms) - - outputAsFortran():Void == - outputAsFortran( (returns()$FortranCode)::Rep )$Rep - - outputAsFortran(u):Void == outputAsFortran(u)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - -@ -\section{domain ASP34 Asp34} -<<domain ASP34 Asp34>>= -)abbrev domain ASP34 Asp34 -++ Author: Mike Dewar and Godfrey Nolan -++ Date Created: Nov 1993 -++ Date Last Updated: 14 June 1994 (Themos Tsikas) -++ 6 October 1994 -++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp34} produces Fortran for Type 34 ASPs, needed for NAG routine -++\axiomOpFrom{f04mbf}{f04Package}, for example: -++\begin{verbatim} -++ SUBROUTINE MSOLVE(IFLAG,N,X,Y,RWORK,LRWORK,IWORK,LIWORK) -++ DOUBLE PRECISION RWORK(LRWORK),X(N),Y(N) -++ INTEGER I,J,N,LIWORK,IFLAG,LRWORK,IWORK(LIWORK) -++ DOUBLE PRECISION W1(3),W2(3),MS(3,3) -++ IFLAG=-1 -++ MS(1,1)=2.0D0 -++ MS(1,2)=1.0D0 -++ MS(1,3)=0.0D0 -++ MS(2,1)=1.0D0 -++ MS(2,2)=2.0D0 -++ MS(2,3)=1.0D0 -++ MS(3,1)=0.0D0 -++ MS(3,2)=1.0D0 -++ MS(3,3)=2.0D0 -++ CALL F04ASF(MS,N,X,N,Y,W1,W2,IFLAG) -++ IFLAG=-IFLAG -++ RETURN -++ END -++\end{verbatim} - -Asp34(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - UFST ==> Union(fst:FST,void:"void") - SYMTAB ==> SymbolTable - FC ==> FortranCode - PI ==> PositiveInteger - EXI ==> Expression Integer - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - - Exports == FortranMatrixCategory - - Implementation == add - - real : UFST := ["real"::FST]$UFST - integer : UFST := ["integer"::FST]$UFST - syms : SYMTAB := empty()$SYMTAB - declare!('IFLAG,fortranInteger(),syms)$SYMTAB - declare!('N,fortranInteger(),syms)$SYMTAB - xType : FT := construct(real,['N],false)$FT - declare!('X,xType,syms)$SYMTAB - declare!('Y,xType,syms)$SYMTAB - declare!('LRWORK,fortranInteger(),syms)$SYMTAB - declare!('LIWORK,fortranInteger(),syms)$SYMTAB - rType : FT := construct(real,['LRWORK],false)$FT - declare!('RWORK,rType,syms)$SYMTAB - iType : FT := construct(integer,['LIWORK],false)$FT - declare!('IWORK,iType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST, - ['IFLAG,'N,'X,'Y,'RWORK,'LRWORK,'IWORK,'LIWORK],syms) - - -- To help the poor old compiler - localAssign(s:Symbol,u:EXI):FC == assign(s,u)$FC - - coerce(u:Matrix MachineFloat):$ == - dimension := nrows(u) ::Polynomial Integer - locals : SYMTAB := empty()$SYMTAB - declare!('I,fortranInteger(),syms)$SYMTAB - declare!('J,fortranInteger(),syms)$SYMTAB - declare!('W1,[real,[dimension],false]$FT,locals)$SYMTAB - declare!('W2,[real,[dimension],false]$FT,locals)$SYMTAB - declare!('MS,[real,[dimension,dimension],false]$FT,locals)$SYMTAB - assign1 : FC := localAssign('IFLAG,(-1)@EXI) - call : FC := call("F04ASF(MS,N,X,N,Y,W1,W2,IFLAG)")$FC - assign2 : FC := localAssign('IFLAG,-('IFLAG::EXI)) - assign3 : FC := assign('MS,u)$FC - code' : List FC := [assign1,assign3,call,assign2,returns()]$List(FC) - ([locals,code']$RSFC)::$ - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP35 Asp35} -<<domain ASP35 Asp35>>= -)abbrev domain ASP35 Asp35 -++ Author: Mike Dewar, Godfrey Nolan, Grant Keady -++ Date Created: Mar 1993 -++ Date Last Updated: 22 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp35} produces Fortran for Type 35 ASPs, needed for NAG routines -++\axiomOpFrom{c05pbf}{c05Package}, \axiomOpFrom{c05pcf}{c05Package}, for example: -++\begin{verbatim} -++ SUBROUTINE FCN(N,X,FVEC,FJAC,LDFJAC,IFLAG) -++ DOUBLE PRECISION X(N),FVEC(N),FJAC(LDFJAC,N) -++ INTEGER LDFJAC,N,IFLAG -++ IF(IFLAG.EQ.1)THEN -++ FVEC(1)=(-1.0D0*X(2))+X(1) -++ FVEC(2)=(-1.0D0*X(3))+2.0D0*X(2) -++ FVEC(3)=3.0D0*X(3) -++ ELSEIF(IFLAG.EQ.2)THEN -++ FJAC(1,1)=1.0D0 -++ FJAC(1,2)=-1.0D0 -++ FJAC(1,3)=0.0D0 -++ FJAC(2,1)=0.0D0 -++ FJAC(2,2)=2.0D0 -++ FJAC(2,3)=-1.0D0 -++ FJAC(3,1)=0.0D0 -++ FJAC(3,2)=0.0D0 -++ FJAC(3,3)=3.0D0 -++ ENDIF -++ END -++\end{verbatim} - -Asp35(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - UFST ==> Union(fst:FST,void:"void") - SYMTAB ==> SymbolTable - FC ==> FortranCode - PI ==> PositiveInteger - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - MAT ==> Matrix - VF2 ==> VectorFunctions2 - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression([],['X],MFLOAT) - MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR, - EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT) - SWU ==> Union(I:Expression Integer,F:Expression Float, - CF:Expression Complex Float,switch:Switch) - - Exports ==> FortranVectorFunctionCategory with - coerce : VEC FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - real : UFST := ["real"::FST]$UFST - syms : SYMTAB := empty()$SYMTAB - declare!(N,fortranInteger(),syms)$SYMTAB - xType : FT := construct(real,[N],false)$FT - declare!(X,xType,syms)$SYMTAB - declare!(FVEC,xType,syms)$SYMTAB - declare!(LDFJAC,fortranInteger(),syms)$SYMTAB - jType : FT := construct(real,[LDFJAC,N],false)$FT - declare!(FJAC,jType,syms)$SYMTAB - declare!(IFLAG,fortranInteger(),syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST,[N,X,FVEC,FJAC,LDFJAC,IFLAG],syms) - - coerce(u:$):OutputForm == coerce(u)$Rep - - makeXList(n:Integer):List(Symbol) == - x:Symbol := X::Symbol - [subscript(x,[j::OutputForm])$Symbol for j in 1..n] - - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - localAssign1(s:Symbol,j:MAT FEXPR):FC == - j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2 - assign(s,j')$FC - - localAssign2(s:Symbol,j:VEC FEXPR):FC == - j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) - assign(s,j')$FC - - coerce(u:VEC FEXPR):$ == - n:Integer := maxIndex(u) - p:List(Symbol) := makeXList(n) - jac: MAT FEXPR := jacobian(u,p)$MultiVariableCalculusFunctions(_ - Symbol,FEXPR,VEC FEXPR,List(Symbol)) - assf:FC := localAssign2(FVEC,u) - assj:FC := localAssign1(FJAC,jac) - iflag:SWU := [IFLAG@Symbol::EXPR(INT)]$SWU - sw1:Switch := EQ(iflag,[1::EXPR(INT)]$SWU) - sw2:Switch := EQ(iflag,[2::EXPR(INT)]$SWU) - cond(sw1,assf,cond(sw2,assj)$FC)$FC::$ - - coerce(c:List FC):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FC):$ == coerce(c)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - -@ -\section{domain ASP4 Asp4} -<<domain ASP4 Asp4>>= -)abbrev domain ASP4 Asp4 -++ Author: Mike Dewar, Grant Keady and Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 18 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp4} produces Fortran for Type 4 ASPs, which take an expression -++in X(1) .. X(NDIM) and produce a real function of the form: -++\begin{verbatim} -++ DOUBLE PRECISION FUNCTION FUNCTN(NDIM,X) -++ DOUBLE PRECISION X(NDIM) -++ INTEGER NDIM -++ FUNCTN=(4.0D0*X(1)*X(3)**2*DEXP(2.0D0*X(1)*X(3)))/(X(4)**2+(2.0D0* -++ &X(2)+2.0D0)*X(4)+X(2)**2+2.0D0*X(2)+1.0D0) -++ RETURN -++ END -++\end{verbatim} - -Asp4(name): Exports == Implementation where - name : Symbol - - FEXPR ==> FortranExpression([],['X],MachineFloat) - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FSTU ==> Union(fst:FST,void:"void") - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - - Exports ==> FortranFunctionCategory with - coerce : FEXPR -> $ - ++coerce(f) takes an object from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns it into an ASP. - - Implementation ==> add - - real : FSTU := ["real"::FST]$FSTU - syms : SYMTAB := empty()$SYMTAB - declare!(NDIM,fortranInteger(),syms)$SYMTAB - xType : FT := construct(real,[NDIM],false)$FT - declare!(X,xType,syms)$SYMTAB - Rep := FortranProgram(name,real,[NDIM,X],syms) - - retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:FRAC POLY INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - foo::FEXPR::$ - - retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - foo::FEXPR::$ - - retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:EXPR FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - foo::FEXPR::$ - - retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:EXPR INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - foo::FEXPR::$ - - retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:POLY FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - foo::FEXPR::$ - - retract(u:POLY INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:POLY INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - foo::FEXPR::$ - - coerce(u:FEXPR):$ == - coerce((u::Expression(MachineFloat))$FEXPR)$Rep - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP41 Asp41} -<<domain ASP41 Asp41>>= -)abbrev domain ASP41 Asp41 -++ Author: Mike Dewar, Godfrey Nolan -++ Date Created: -++ Date Last Updated: 29 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranFunctionCategory, FortranProgramCategory. -++ Description: -++\spadtype{Asp41} produces Fortran for Type 41 ASPs, needed for NAG -++routines \axiomOpFrom{d02raf}{d02Package} and \axiomOpFrom{d02saf}{d02Package} -++in particular. These ASPs are in fact -++three Fortran routines which return a vector of functions, and their -++derivatives wrt Y(i) and also a continuation parameter EPS, for example: -++\begin{verbatim} -++ SUBROUTINE FCN(X,EPS,Y,F,N) -++ DOUBLE PRECISION EPS,F(N),X,Y(N) -++ INTEGER N -++ F(1)=Y(2) -++ F(2)=Y(3) -++ F(3)=(-1.0D0*Y(1)*Y(3))+2.0D0*EPS*Y(2)**2+(-2.0D0*EPS) -++ RETURN -++ END -++ SUBROUTINE JACOBF(X,EPS,Y,F,N) -++ DOUBLE PRECISION EPS,F(N,N),X,Y(N) -++ INTEGER N -++ F(1,1)=0.0D0 -++ F(1,2)=1.0D0 -++ F(1,3)=0.0D0 -++ F(2,1)=0.0D0 -++ F(2,2)=0.0D0 -++ F(2,3)=1.0D0 -++ F(3,1)=-1.0D0*Y(3) -++ F(3,2)=4.0D0*EPS*Y(2) -++ F(3,3)=-1.0D0*Y(1) -++ RETURN -++ END -++ SUBROUTINE JACEPS(X,EPS,Y,F,N) -++ DOUBLE PRECISION EPS,F(N),X,Y(N) -++ INTEGER N -++ F(1)=0.0D0 -++ F(2)=0.0D0 -++ F(3)=2.0D0*Y(2)**2-2.0D0 -++ RETURN -++ END -++\end{verbatim} - -Asp41(nameOne,nameTwo,nameThree): Exports == Implementation where - nameOne : Symbol - nameTwo : Symbol - nameThree : Symbol - - D ==> differentiate - FST ==> FortranScalarType - UFST ==> Union(fst:FST,void:"void") - FT ==> FortranType - FC ==> FortranCode - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - VF2 ==> VectorFunctions2 - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression(['X,'EPS],['Y],MFLOAT) - S ==> Symbol - MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,Matrix FEXPR, - EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,Matrix EXPR MFLOAT) - - Exports ==> FortranVectorFunctionCategory with - coerce : VEC FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - real : UFST := ["real"::FST]$UFST - - symOne : SYMTAB := empty()$SYMTAB - declare!(N,fortranInteger(),symOne)$SYMTAB - declare!(X,fortranReal(),symOne)$SYMTAB - declare!(EPS,fortranReal(),symOne)$SYMTAB - yType : FT := construct(real,[N],false)$FT - declare!(Y,yType,symOne)$SYMTAB - declare!(F,yType,symOne)$SYMTAB - - symTwo : SYMTAB := empty()$SYMTAB - declare!(N,fortranInteger(),symTwo)$SYMTAB - declare!(X,fortranReal(),symTwo)$SYMTAB - declare!(EPS,fortranReal(),symTwo)$SYMTAB - declare!(Y,yType,symTwo)$SYMTAB - fType : FT := construct(real,[N,N],false)$FT - declare!(F,fType,symTwo)$SYMTAB - - symThree : SYMTAB := empty()$SYMTAB - declare!(N,fortranInteger(),symThree)$SYMTAB - declare!(X,fortranReal(),symThree)$SYMTAB - declare!(EPS,fortranReal(),symThree)$SYMTAB - declare!(Y,yType,symThree)$SYMTAB - declare!(F,yType,symThree)$SYMTAB - - R1:=FortranProgram(nameOne,["void"]$UFST,[X,EPS,Y,F,N],symOne) - R2:=FortranProgram(nameTwo,["void"]$UFST,[X,EPS,Y,F,N],symTwo) - R3:=FortranProgram(nameThree,["void"]$UFST,[X,EPS,Y,F,N],symThree) - Rep := Record(f:R1,fJacob:R2,eJacob:R3) - Fsym:Symbol:=coerce "F" - - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - localAssign1(s:S,j:Matrix FEXPR):FC == - j' : Matrix EXPR MFLOAT := map(fexpr2expr,j)$MF2 - assign(s,j')$FC - - localAssign2(s:S,j:VEC FEXPR):FC == - j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) - assign(s,j')$FC - - makeCodeOne(u:VEC FEXPR):FortranCode == - -- simple assign - localAssign2(Fsym,u) - - makeCodeThree(u:VEC FEXPR):FortranCode == - -- compute jacobian wrt to eps - jacEps:VEC FEXPR := [D(v,EPS) for v in entries(u)]$VEC(FEXPR) - makeCodeOne(jacEps) - - makeYList(n:Integer):List(Symbol) == - y:Symbol := Y::Symbol - p:List(Symbol) := [] - [subscript(y,[j::OutputForm])$Symbol for j in 1..n] - - makeCodeTwo(u:VEC FEXPR):FortranCode == - -- compute jacobian wrt to f - n:Integer := maxIndex(u)$VEC(FEXPR) - p:List(Symbol) := makeYList(n) - jac:Matrix(FEXPR) := _ - jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S)) - localAssign1(Fsym,jac) - - coerce(u:VEC FEXPR):$ == - aF:FortranCode := makeCodeOne(u) - bF:FortranCode := makeCodeTwo(u) - cF:FortranCode := makeCodeThree(u) - -- add returns() to complete subroutines - aLF:List(FortranCode) := [aF,returns()$FortranCode]$List(FortranCode) - bLF:List(FortranCode) := [bF,returns()$FortranCode]$List(FortranCode) - cLF:List(FortranCode) := [cF,returns()$FortranCode]$List(FortranCode) - [coerce(aLF)$R1,coerce(bLF)$R2,coerce(cLF)$R3] - - coerce(u:$):OutputForm == - bracket commaSeparate - [nameOne::OutputForm,nameTwo::OutputForm,nameThree::OutputForm] - - outputAsFortran(u:$):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran elt(u,f)$Rep - outputAsFortran elt(u,fJacob)$Rep - outputAsFortran elt(u,eJacob)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - -@ -\section{domain ASP42 Asp42} -<<domain ASP42 Asp42>>= -)abbrev domain ASP42 Asp42 -++ Author: Mike Dewar, Godfrey Nolan -++ Date Created: -++ Date Last Updated: 29 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranFunctionCategory, FortranProgramCategory. -++ Description: -++\spadtype{Asp42} produces Fortran for Type 42 ASPs, needed for NAG -++routines \axiomOpFrom{d02raf}{d02Package} and \axiomOpFrom{d02saf}{d02Package} -++in particular. These ASPs are in fact -++three Fortran routines which return a vector of functions, and their -++derivatives wrt Y(i) and also a continuation parameter EPS, for example: -++\begin{verbatim} -++ SUBROUTINE G(EPS,YA,YB,BC,N) -++ DOUBLE PRECISION EPS,YA(N),YB(N),BC(N) -++ INTEGER N -++ BC(1)=YA(1) -++ BC(2)=YA(2) -++ BC(3)=YB(2)-1.0D0 -++ RETURN -++ END -++ SUBROUTINE JACOBG(EPS,YA,YB,AJ,BJ,N) -++ DOUBLE PRECISION EPS,YA(N),AJ(N,N),BJ(N,N),YB(N) -++ INTEGER N -++ AJ(1,1)=1.0D0 -++ AJ(1,2)=0.0D0 -++ AJ(1,3)=0.0D0 -++ AJ(2,1)=0.0D0 -++ AJ(2,2)=1.0D0 -++ AJ(2,3)=0.0D0 -++ AJ(3,1)=0.0D0 -++ AJ(3,2)=0.0D0 -++ AJ(3,3)=0.0D0 -++ BJ(1,1)=0.0D0 -++ BJ(1,2)=0.0D0 -++ BJ(1,3)=0.0D0 -++ BJ(2,1)=0.0D0 -++ BJ(2,2)=0.0D0 -++ BJ(2,3)=0.0D0 -++ BJ(3,1)=0.0D0 -++ BJ(3,2)=1.0D0 -++ BJ(3,3)=0.0D0 -++ RETURN -++ END -++ SUBROUTINE JACGEP(EPS,YA,YB,BCEP,N) -++ DOUBLE PRECISION EPS,YA(N),YB(N),BCEP(N) -++ INTEGER N -++ BCEP(1)=0.0D0 -++ BCEP(2)=0.0D0 -++ BCEP(3)=0.0D0 -++ RETURN -++ END -++\end{verbatim} - -Asp42(nameOne,nameTwo,nameThree): Exports == Implementation where - nameOne : Symbol - nameTwo : Symbol - nameThree : Symbol - - D ==> differentiate - FST ==> FortranScalarType - FT ==> FortranType - FP ==> FortranProgram - FC ==> FortranCode - PI ==> PositiveInteger - NNI ==> NonNegativeInteger - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - UFST ==> Union(fst:FST,void:"void") - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - VF2 ==> VectorFunctions2 - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression(['EPS],['YA,'YB],MFLOAT) - S ==> Symbol - MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,Matrix FEXPR, - EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,Matrix EXPR MFLOAT) - - Exports ==> FortranVectorFunctionCategory with - coerce : VEC FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - real : UFST := ["real"::FST]$UFST - - symOne : SYMTAB := empty()$SYMTAB - declare!(EPS,fortranReal(),symOne)$SYMTAB - declare!(N,fortranInteger(),symOne)$SYMTAB - yType : FT := construct(real,[N],false)$FT - declare!(YA,yType,symOne)$SYMTAB - declare!(YB,yType,symOne)$SYMTAB - declare!(BC,yType,symOne)$SYMTAB - - symTwo : SYMTAB := empty()$SYMTAB - declare!(EPS,fortranReal(),symTwo)$SYMTAB - declare!(N,fortranInteger(),symTwo)$SYMTAB - declare!(YA,yType,symTwo)$SYMTAB - declare!(YB,yType,symTwo)$SYMTAB - ajType : FT := construct(real,[N,N],false)$FT - declare!(AJ,ajType,symTwo)$SYMTAB - declare!(BJ,ajType,symTwo)$SYMTAB - - symThree : SYMTAB := empty()$SYMTAB - declare!(EPS,fortranReal(),symThree)$SYMTAB - declare!(N,fortranInteger(),symThree)$SYMTAB - declare!(YA,yType,symThree)$SYMTAB - declare!(YB,yType,symThree)$SYMTAB - declare!(BCEP,yType,symThree)$SYMTAB - - rt := ["void"]$UFST - R1:=FortranProgram(nameOne,rt,[EPS,YA,YB,BC,N],symOne) - R2:=FortranProgram(nameTwo,rt,[EPS,YA,YB,AJ,BJ,N],symTwo) - R3:=FortranProgram(nameThree,rt,[EPS,YA,YB,BCEP,N],symThree) - Rep := Record(g:R1,gJacob:R2,geJacob:R3) - BCsym:Symbol:=coerce "BC" - AJsym:Symbol:=coerce "AJ" - BJsym:Symbol:=coerce "BJ" - BCEPsym:Symbol:=coerce "BCEP" - - makeList(n:Integer,s:Symbol):List(Symbol) == - p:List(Symbol) := [] - for j in 1 .. n repeat p:= cons(subscript(s,[j::OutputForm])$Symbol,p) - reverse(p) - - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - localAssign1(s:S,j:Matrix FEXPR):FC == - j' : Matrix EXPR MFLOAT := map(fexpr2expr,j)$MF2 - assign(s,j')$FC - - localAssign2(s:S,j:VEC FEXPR):FC == - j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) - assign(s,j')$FC - - makeCodeOne(u:VEC FEXPR):FortranCode == - -- simple assign - localAssign2(BCsym,u) - - makeCodeTwo(u:VEC FEXPR):List(FortranCode) == - -- compute jacobian wrt to ya - n:Integer := maxIndex(u) - p:List(Symbol) := makeList(n,YA::Symbol) - jacYA:Matrix(FEXPR) := _ - jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S)) - -- compute jacobian wrt to yb - p:List(Symbol) := makeList(n,YB::Symbol) - jacYB: Matrix(FEXPR) := _ - jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S)) - -- assign jacobians to AJ & BJ - [localAssign1(AJsym,jacYA),localAssign1(BJsym,jacYB),returns()$FC]$List(FC) - - makeCodeThree(u:VEC FEXPR):FortranCode == - -- compute jacobian wrt to eps - jacEps:VEC FEXPR := [D(v,EPS) for v in entries u]$VEC(FEXPR) - localAssign2(BCEPsym,jacEps) - - coerce(u:VEC FEXPR):$ == - aF:FortranCode := makeCodeOne(u) - bF:List(FortranCode) := makeCodeTwo(u) - cF:FortranCode := makeCodeThree(u) - -- add returns() to complete subroutines - aLF:List(FortranCode) := [aF,returns()$FC]$List(FortranCode) - cLF:List(FortranCode) := [cF,returns()$FC]$List(FortranCode) - [coerce(aLF)$R1,coerce(bF)$R2,coerce(cLF)$R3] - - coerce(u:$) : OutputForm == - bracket commaSeparate - [nameOne::OutputForm,nameTwo::OutputForm,nameThree::OutputForm] - - outputAsFortran(u:$):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran elt(u,g)$Rep - outputAsFortran elt(u,gJacob)$Rep - outputAsFortran elt(u,geJacob)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - -@ -\section{domain ASP49 Asp49} -<<domain ASP49 Asp49>>= -)abbrev domain ASP49 Asp49 -++ Author: Mike Dewar, Grant Keady and Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 23 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp49} produces Fortran for Type 49 ASPs, needed for NAG routines -++\axiomOpFrom{e04dgf}{e04Package}, \axiomOpFrom{e04ucf}{e04Package}, for example: -++\begin{verbatim} -++ SUBROUTINE OBJFUN(MODE,N,X,OBJF,OBJGRD,NSTATE,IUSER,USER) -++ DOUBLE PRECISION X(N),OBJF,OBJGRD(N),USER(*) -++ INTEGER N,IUSER(*),MODE,NSTATE -++ OBJF=X(4)*X(9)+((-1.0D0*X(5))+X(3))*X(8)+((-1.0D0*X(3))+X(1))*X(7) -++ &+(-1.0D0*X(2)*X(6)) -++ OBJGRD(1)=X(7) -++ OBJGRD(2)=-1.0D0*X(6) -++ OBJGRD(3)=X(8)+(-1.0D0*X(7)) -++ OBJGRD(4)=X(9) -++ OBJGRD(5)=-1.0D0*X(8) -++ OBJGRD(6)=-1.0D0*X(2) -++ OBJGRD(7)=(-1.0D0*X(3))+X(1) -++ OBJGRD(8)=(-1.0D0*X(5))+X(3) -++ OBJGRD(9)=X(4) -++ RETURN -++ END -++\end{verbatim} - -Asp49(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - UFST ==> Union(fst:FST,void:"void") - FT ==> FortranType - FC ==> FortranCode - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FC)) - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression([],['X],MFLOAT) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - VF2 ==> VectorFunctions2 - S ==> Symbol - - Exports ==> FortranFunctionCategory with - coerce : FEXPR -> $ - ++coerce(f) takes an object from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns it into an ASP. - - Implementation ==> add - - real : UFST := ["real"::FST]$UFST - integer : UFST := ["integer"::FST]$UFST - syms : SYMTAB := empty()$SYMTAB - declare!(MODE,fortranInteger(),syms)$SYMTAB - declare!(N,fortranInteger(),syms)$SYMTAB - xType : FT := construct(real,[N::S],false)$FT - declare!(X,xType,syms)$SYMTAB - declare!(OBJF,fortranReal(),syms)$SYMTAB - declare!(OBJGRD,xType,syms)$SYMTAB - declare!(NSTATE,fortranInteger(),syms)$SYMTAB - iuType : FT := construct(integer,["*"::S],false)$FT - declare!(IUSER,iuType,syms)$SYMTAB - uType : FT := construct(real,["*"::S],false)$FT - declare!(USER,uType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST, - [MODE,N,X,OBJF,OBJGRD,NSTATE,IUSER,USER],syms) - - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - localAssign(s:S,j:VEC FEXPR):FC == - j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) - assign(s,j')$FC - - coerce(u:FEXPR):$ == - vars:List(S) := variables(u) - grd:VEC FEXPR := gradient(u,vars)$MultiVariableCalculusFunctions(_ - S,FEXPR,VEC FEXPR,List(S)) - code : List(FC) := [assign(OBJF@S,fexpr2expr u)$FC,_ - localAssign(OBJGRD@S,grd),_ - returns()$FC] - code::$ - - coerce(u:$):OutputForm == coerce(u)$Rep - - coerce(c:List FC):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FC):$ == coerce(c)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:FRAC POLY INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:EXPR FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:EXPR INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:POLY FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:POLY INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:POLY INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - -@ -\section{domain ASP50 Asp50} -<<domain ASP50 Asp50>>= -)abbrev domain ASP50 Asp50 -++ Author: Mike Dewar, Grant Keady and Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 23 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp50} produces Fortran for Type 50 ASPs, needed for NAG routine -++\axiomOpFrom{e04fdf}{e04Package}, for example: -++\begin{verbatim} -++ SUBROUTINE LSFUN1(M,N,XC,FVECC) -++ DOUBLE PRECISION FVECC(M),XC(N) -++ INTEGER I,M,N -++ FVECC(1)=((XC(1)-2.4D0)*XC(3)+(15.0D0*XC(1)-36.0D0)*XC(2)+1.0D0)/( -++ &XC(3)+15.0D0*XC(2)) -++ FVECC(2)=((XC(1)-2.8D0)*XC(3)+(7.0D0*XC(1)-19.6D0)*XC(2)+1.0D0)/(X -++ &C(3)+7.0D0*XC(2)) -++ FVECC(3)=((XC(1)-3.2D0)*XC(3)+(4.333333333333333D0*XC(1)-13.866666 -++ &66666667D0)*XC(2)+1.0D0)/(XC(3)+4.333333333333333D0*XC(2)) -++ FVECC(4)=((XC(1)-3.5D0)*XC(3)+(3.0D0*XC(1)-10.5D0)*XC(2)+1.0D0)/(X -++ &C(3)+3.0D0*XC(2)) -++ FVECC(5)=((XC(1)-3.9D0)*XC(3)+(2.2D0*XC(1)-8.579999999999998D0)*XC -++ &(2)+1.0D0)/(XC(3)+2.2D0*XC(2)) -++ FVECC(6)=((XC(1)-4.199999999999999D0)*XC(3)+(1.666666666666667D0*X -++ &C(1)-7.0D0)*XC(2)+1.0D0)/(XC(3)+1.666666666666667D0*XC(2)) -++ FVECC(7)=((XC(1)-4.5D0)*XC(3)+(1.285714285714286D0*XC(1)-5.7857142 -++ &85714286D0)*XC(2)+1.0D0)/(XC(3)+1.285714285714286D0*XC(2)) -++ FVECC(8)=((XC(1)-4.899999999999999D0)*XC(3)+(XC(1)-4.8999999999999 -++ &99D0)*XC(2)+1.0D0)/(XC(3)+XC(2)) -++ FVECC(9)=((XC(1)-4.699999999999999D0)*XC(3)+(XC(1)-4.6999999999999 -++ &99D0)*XC(2)+1.285714285714286D0)/(XC(3)+XC(2)) -++ FVECC(10)=((XC(1)-6.8D0)*XC(3)+(XC(1)-6.8D0)*XC(2)+1.6666666666666 -++ &67D0)/(XC(3)+XC(2)) -++ FVECC(11)=((XC(1)-8.299999999999999D0)*XC(3)+(XC(1)-8.299999999999 -++ &999D0)*XC(2)+2.2D0)/(XC(3)+XC(2)) -++ FVECC(12)=((XC(1)-10.6D0)*XC(3)+(XC(1)-10.6D0)*XC(2)+3.0D0)/(XC(3) -++ &+XC(2)) -++ FVECC(13)=((XC(1)-1.34D0)*XC(3)+(XC(1)-1.34D0)*XC(2)+4.33333333333 -++ &3333D0)/(XC(3)+XC(2)) -++ FVECC(14)=((XC(1)-2.1D0)*XC(3)+(XC(1)-2.1D0)*XC(2)+7.0D0)/(XC(3)+X -++ &C(2)) -++ FVECC(15)=((XC(1)-4.39D0)*XC(3)+(XC(1)-4.39D0)*XC(2)+15.0D0)/(XC(3 -++ &)+XC(2)) -++ END -++\end{verbatim} - -Asp50(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - UFST ==> Union(fst:FST,void:"void") - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - VF2 ==> VectorFunctions2 - FEXPR ==> FortranExpression([],['XC],MFLOAT) - MFLOAT ==> MachineFloat - - Exports ==> FortranVectorFunctionCategory with - coerce : VEC FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - real : UFST := ["real"::FST]$UFST - syms : SYMTAB := empty()$SYMTAB - declare!(M,fortranInteger(),syms)$SYMTAB - declare!(N,fortranInteger(),syms)$SYMTAB - xcType : FT := construct(real,[N],false)$FT - declare!(XC,xcType,syms)$SYMTAB - fveccType : FT := construct(real,[M],false)$FT - declare!(FVECC,fveccType,syms)$SYMTAB - declare!(I,fortranInteger(),syms)$SYMTAB - tType : FT := construct(real,[M,N],false)$FT --- declare!(TC,tType,syms)$SYMTAB --- declare!(Y,fveccType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST, [M,N,XC,FVECC],syms) - - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - coerce(u:VEC FEXPR):$ == - u' : VEC EXPR MFLOAT := map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT) - assign(FVECC,u')$FortranCode::$ - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP55 Asp55} -<<domain ASP55 Asp55>>= -)abbrev domain ASP55 Asp55 -++ Author: Mike Dewar, Grant Keady and Godfrey Nolan -++ Date Created: June 1993 -++ Date Last Updated: 23 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp55} produces Fortran for Type 55 ASPs, needed for NAG routines -++\axiomOpFrom{e04dgf}{e04Package} and \axiomOpFrom{e04ucf}{e04Package}, for example: -++\begin{verbatim} -++ SUBROUTINE CONFUN(MODE,NCNLN,N,NROWJ,NEEDC,X,C,CJAC,NSTATE,IUSER -++ &,USER) -++ DOUBLE PRECISION C(NCNLN),X(N),CJAC(NROWJ,N),USER(*) -++ INTEGER N,IUSER(*),NEEDC(NCNLN),NROWJ,MODE,NCNLN,NSTATE -++ IF(NEEDC(1).GT.0)THEN -++ C(1)=X(6)**2+X(1)**2 -++ CJAC(1,1)=2.0D0*X(1) -++ CJAC(1,2)=0.0D0 -++ CJAC(1,3)=0.0D0 -++ CJAC(1,4)=0.0D0 -++ CJAC(1,5)=0.0D0 -++ CJAC(1,6)=2.0D0*X(6) -++ ENDIF -++ IF(NEEDC(2).GT.0)THEN -++ C(2)=X(2)**2+(-2.0D0*X(1)*X(2))+X(1)**2 -++ CJAC(2,1)=(-2.0D0*X(2))+2.0D0*X(1) -++ CJAC(2,2)=2.0D0*X(2)+(-2.0D0*X(1)) -++ CJAC(2,3)=0.0D0 -++ CJAC(2,4)=0.0D0 -++ CJAC(2,5)=0.0D0 -++ CJAC(2,6)=0.0D0 -++ ENDIF -++ IF(NEEDC(3).GT.0)THEN -++ C(3)=X(3)**2+(-2.0D0*X(1)*X(3))+X(2)**2+X(1)**2 -++ CJAC(3,1)=(-2.0D0*X(3))+2.0D0*X(1) -++ CJAC(3,2)=2.0D0*X(2) -++ CJAC(3,3)=2.0D0*X(3)+(-2.0D0*X(1)) -++ CJAC(3,4)=0.0D0 -++ CJAC(3,5)=0.0D0 -++ CJAC(3,6)=0.0D0 -++ ENDIF -++ RETURN -++ END -++\end{verbatim} - -Asp55(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - FSTU ==> Union(fst:FST,void:"void") - SYMTAB ==> SymbolTable - FC ==> FortranCode - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - S ==> Symbol - FLOAT ==> Float - VEC ==> Vector - VF2 ==> VectorFunctions2 - MAT ==> Matrix - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression([],['X],MFLOAT) - MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR, - EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT) - SWU ==> Union(I:Expression Integer,F:Expression Float, - CF:Expression Complex Float,switch:Switch) - - Exports ==> FortranVectorFunctionCategory with - coerce : VEC FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - real : FSTU := ["real"::FST]$FSTU - integer : FSTU := ["integer"::FST]$FSTU - syms : SYMTAB := empty()$SYMTAB - declare!(MODE,fortranInteger(),syms)$SYMTAB - declare!(NCNLN,fortranInteger(),syms)$SYMTAB - declare!(N,fortranInteger(),syms)$SYMTAB - declare!(NROWJ,fortranInteger(),syms)$SYMTAB - needcType : FT := construct(integer,[NCNLN::Symbol],false)$FT - declare!(NEEDC,needcType,syms)$SYMTAB - xType : FT := construct(real,[N::Symbol],false)$FT - declare!(X,xType,syms)$SYMTAB - cType : FT := construct(real,[NCNLN::Symbol],false)$FT - declare!(C,cType,syms)$SYMTAB - cjacType : FT := construct(real,[NROWJ::Symbol,N::Symbol],false)$FT - declare!(CJAC,cjacType,syms)$SYMTAB - declare!(NSTATE,fortranInteger(),syms)$SYMTAB - iuType : FT := construct(integer,["*"::Symbol],false)$FT - declare!(IUSER,iuType,syms)$SYMTAB - uType : FT := construct(real,["*"::Symbol],false)$FT - declare!(USER,uType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$FSTU, - [MODE,NCNLN,N,NROWJ,NEEDC,X,C,CJAC,NSTATE,IUSER,USER],syms) - - -- Take a symbol, pull of the script and turn it into an integer!! - o2int(u:S):Integer == - o : OutputForm := first elt(scripts(u)$S,sub) - o pretend Integer - - localAssign(s:Symbol,dim:List POLY INT,u:FEXPR):FC == - assign(s,dim,(u::EXPR MFLOAT)$FEXPR)$FC - - makeCond(index:INT,fun:FEXPR,jac:VEC FEXPR):FC == - needc : EXPR INT := (subscript(NEEDC,[index::OutputForm])$S)::EXPR(INT) - sw : Switch := GT([needc]$SWU,[0::EXPR(INT)]$SWU)$Switch - ass : List FC := [localAssign(CJAC,[index::POLY INT,i::POLY INT],jac.i)_ - for i in 1..maxIndex(jac)] - cond(sw,block([localAssign(C,[index::POLY INT],fun),:ass])$FC)$FC - - coerce(u:VEC FEXPR):$ == - ncnln:Integer := maxIndex(u) - x:S := X::S - pu:List(S) := [] - -- Work out which variables appear in the expressions - for e in entries(u) repeat - pu := setUnion(pu,variables(e)$FEXPR) - scriptList : List Integer := map(o2int,pu)$ListFunctions2(S,Integer) - -- This should be the maximum X_n which occurs (there may be others - -- which don't): - n:Integer := reduce(max,scriptList)$List(Integer) - p:List(S) := [] - for j in 1..n repeat p:= cons(subscript(x,[j::OutputForm])$S,p) - p:= reverse(p) - jac:MAT FEXPR := _ - jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S)) - code : List FC := [makeCond(j,u.j,row(jac,j)) for j in 1..ncnln] - [:code,returns()$FC]::$ - - coerce(c:List FC):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FC):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - -@ -\section{domain ASP6 Asp6} -<<domain ASP6 Asp6>>= -)abbrev domain ASP6 Asp6 -++ Author: Mike Dewar and Godfrey Nolan and Grant Keady -++ Date Created: Mar 1993 -++ Date Last Updated: 18 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp6} produces Fortran for Type 6 ASPs, needed for NAG routines -++\axiomOpFrom{c05nbf}{c05Package}, \axiomOpFrom{c05ncf}{c05Package}. -++These represent vectors of functions of X(i) and look like: -++\begin{verbatim} -++ SUBROUTINE FCN(N,X,FVEC,IFLAG) -++ DOUBLE PRECISION X(N),FVEC(N) -++ INTEGER N,IFLAG -++ FVEC(1)=(-2.0D0*X(2))+(-2.0D0*X(1)**2)+3.0D0*X(1)+1.0D0 -++ FVEC(2)=(-2.0D0*X(3))+(-2.0D0*X(2)**2)+3.0D0*X(2)+(-1.0D0*X(1))+1. -++ &0D0 -++ FVEC(3)=(-2.0D0*X(4))+(-2.0D0*X(3)**2)+3.0D0*X(3)+(-1.0D0*X(2))+1. -++ &0D0 -++ FVEC(4)=(-2.0D0*X(5))+(-2.0D0*X(4)**2)+3.0D0*X(4)+(-1.0D0*X(3))+1. -++ &0D0 -++ FVEC(5)=(-2.0D0*X(6))+(-2.0D0*X(5)**2)+3.0D0*X(5)+(-1.0D0*X(4))+1. -++ &0D0 -++ FVEC(6)=(-2.0D0*X(7))+(-2.0D0*X(6)**2)+3.0D0*X(6)+(-1.0D0*X(5))+1. -++ &0D0 -++ FVEC(7)=(-2.0D0*X(8))+(-2.0D0*X(7)**2)+3.0D0*X(7)+(-1.0D0*X(6))+1. -++ &0D0 -++ FVEC(8)=(-2.0D0*X(9))+(-2.0D0*X(8)**2)+3.0D0*X(8)+(-1.0D0*X(7))+1. -++ &0D0 -++ FVEC(9)=(-2.0D0*X(9)**2)+3.0D0*X(9)+(-1.0D0*X(8))+1.0D0 -++ RETURN -++ END -++\end{verbatim} - -Asp6(name): Exports == Implementation where - name : Symbol - - FEXPR ==> FortranExpression([],['X],MFLOAT) - MFLOAT ==> MachineFloat - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - UFST ==> Union(fst:FST,void:"void") - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - VF2 ==> VectorFunctions2 - - Exports == Join(FortranVectorFunctionCategory, CoercibleFrom Vector FEXPR) - Implementation == add - - real : UFST := ["real"::FST]$UFST - syms : SYMTAB := empty()$SYMTAB - declare!(N,fortranInteger()$FT,syms)$SYMTAB - xType : FT := construct(real,[N],false)$FT - declare!(X,xType,syms)$SYMTAB - declare!(FVEC,xType,syms)$SYMTAB - declare!(IFLAG,fortranInteger()$FT,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$Union(fst:FST,void:"void"), - [N,X,FVEC,IFLAG],syms) - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VectorFunctions2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VectorFunctions2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VectorFunctions2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VectorFunctions2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VectorFunctions2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - fexpr2expr(u:FEXPR):EXPR MFLOAT == - (u::EXPR MFLOAT)$FEXPR - - coerce(u:VEC FEXPR):% == - v : VEC EXPR MFLOAT - v := map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT) - ([assign(FVEC,v)$FortranCode,returns()$FortranCode]$List(FortranCode))::$ - - coerce(c:List FortranCode):% == coerce(c)$Rep - - coerce(r:RSFC):% == coerce(r)$Rep - - coerce(c:FortranCode):% == coerce(c)$Rep - - coerce(u:%):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP7 Asp7} -<<domain ASP7 Asp7>>= -)abbrev domain ASP7 Asp7 -++ Author: Mike Dewar and Godfrey Nolan and Grant Keady -++ Date Created: Mar 1993 -++ Date Last Updated: 18 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp7} produces Fortran for Type 7 ASPs, needed for NAG routines -++\axiomOpFrom{d02bbf}{d02Package}, \axiomOpFrom{d02gaf}{d02Package}. -++These represent a vector of functions of the scalar X and -++the array Z, and look like: -++\begin{verbatim} -++ SUBROUTINE FCN(X,Z,F) -++ DOUBLE PRECISION F(*),X,Z(*) -++ F(1)=DTAN(Z(3)) -++ F(2)=((-0.03199999999999999D0*DCOS(Z(3))*DTAN(Z(3)))+(-0.02D0*Z(2) -++ &**2))/(Z(2)*DCOS(Z(3))) -++ F(3)=-0.03199999999999999D0/(X*Z(2)**2) -++ RETURN -++ END -++\end{verbatim} - -Asp7(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression(['X],['Y],MFLOAT) - UFST ==> Union(fst:FST,void:"void") - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - VF2 ==> VectorFunctions2 - - Exports ==> FortranVectorFunctionCategory with - coerce : Vector FEXPR -> % - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - real : UFST := ["real"::FST]$UFST - syms : SYMTAB := empty()$SYMTAB - declare!(X,fortranReal(),syms)$SYMTAB - yType : FT := construct(real,["*"::Symbol],false)$FT - declare!(Y,yType,syms)$SYMTAB - declare!(F,yType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST,[X,Y,F],syms) - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - fexpr2expr(u:FEXPR):EXPR MFLOAT == - (u::EXPR MFLOAT)$FEXPR - - coerce(u:Vector FEXPR ):% == - v : Vector EXPR MFLOAT - v:=map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT) - ([assign(F,v)$FortranCode,returns()$FortranCode]$List(FortranCode))::% - - coerce(c:List FortranCode):% == coerce(c)$Rep - - coerce(r:RSFC):% == coerce(r)$Rep - - coerce(c:FortranCode):% == coerce(c)$Rep - - coerce(u:%):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP73 Asp73} -<<domain ASP73 Asp73>>= -)abbrev domain ASP73 Asp73 -++ Author: Mike Dewar, Grant Keady and Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 30 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp73} produces Fortran for Type 73 ASPs, needed for NAG routine -++\axiomOpFrom{d03eef}{d03Package}, for example: -++\begin{verbatim} -++ SUBROUTINE PDEF(X,Y,ALPHA,BETA,GAMMA,DELTA,EPSOLN,PHI,PSI) -++ DOUBLE PRECISION ALPHA,EPSOLN,PHI,X,Y,BETA,DELTA,GAMMA,PSI -++ ALPHA=DSIN(X) -++ BETA=Y -++ GAMMA=X*Y -++ DELTA=DCOS(X)*DSIN(Y) -++ EPSOLN=Y+X -++ PHI=X -++ PSI=Y -++ RETURN -++ END -++\end{verbatim} - -Asp73(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FSTU ==> Union(fst:FST,void:"void") - FEXPR ==> FortranExpression(['X,'Y],[],MachineFloat) - FT ==> FortranType - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - VF2 ==> VectorFunctions2 - - Exports ==> FortranVectorFunctionCategory with - coerce : VEC FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - syms : SYMTAB := empty()$SYMTAB - declare!(X,fortranReal(),syms) $SYMTAB - declare!(Y,fortranReal(),syms) $SYMTAB - declare!(ALPHA,fortranReal(),syms)$SYMTAB - declare!(BETA,fortranReal(),syms) $SYMTAB - declare!(GAMMA,fortranReal(),syms) $SYMTAB - declare!(DELTA,fortranReal(),syms) $SYMTAB - declare!(EPSOLN,fortranReal(),syms) $SYMTAB - declare!(PHI,fortranReal(),syms) $SYMTAB - declare!(PSI,fortranReal(),syms) $SYMTAB - Rep := FortranProgram(name,["void"]$FSTU, - [X,Y,ALPHA,BETA,GAMMA,DELTA,EPSOLN,PHI,PSI],syms) - - -- To help the poor compiler! - localAssign(u:Symbol,v:FEXPR):FortranCode == - assign(u,(v::EXPR MachineFloat)$FEXPR)$FortranCode - - coerce(u:VEC FEXPR):$ == - maxIndex(u) ~= 7 => error "Vector is not of dimension 7" - [localAssign(ALPHA@Symbol,elt(u,1)),_ - localAssign(BETA@Symbol,elt(u,2)),_ - localAssign(GAMMA@Symbol,elt(u,3)),_ - localAssign(DELTA@Symbol,elt(u,4)),_ - localAssign(EPSOLN@Symbol,elt(u,5)),_ - localAssign(PHI@Symbol,elt(u,6)),_ - localAssign(PSI@Symbol,elt(u,7)),_ - returns()$FortranCode]$List(FortranCode)::$ - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - -@ -\section{domain ASP74 Asp74} -<<domain ASP74 Asp74>>= -)abbrev domain ASP74 Asp74 -++ Author: Mike Dewar and Godfrey Nolan -++ Date Created: Oct 1993 -++ Date Last Updated: 30 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory. -++ Description: -++\spadtype{Asp74} produces Fortran for Type 74 ASPs, needed for NAG routine -++\axiomOpFrom{d03eef}{d03Package}, for example: -++\begin{verbatim} -++ SUBROUTINE BNDY(X,Y,A,B,C,IBND) -++ DOUBLE PRECISION A,B,C,X,Y -++ INTEGER IBND -++ IF(IBND.EQ.0)THEN -++ A=0.0D0 -++ B=1.0D0 -++ C=-1.0D0*DSIN(X) -++ ELSEIF(IBND.EQ.1)THEN -++ A=1.0D0 -++ B=0.0D0 -++ C=DSIN(X)*DSIN(Y) -++ ELSEIF(IBND.EQ.2)THEN -++ A=1.0D0 -++ B=0.0D0 -++ C=DSIN(X)*DSIN(Y) -++ ELSEIF(IBND.EQ.3)THEN -++ A=0.0D0 -++ B=1.0D0 -++ C=-1.0D0*DSIN(Y) -++ ENDIF -++ END -++\end{verbatim} - -Asp74(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FSTU ==> Union(fst:FST,void:"void") - FT ==> FortranType - SYMTAB ==> SymbolTable - FC ==> FortranCode - PI ==> PositiveInteger - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression(['X,'Y],[],MFLOAT) - U ==> Union(I: Expression Integer,F: Expression Float,_ - CF: Expression Complex Float,switch:Switch) - VEC ==> Vector - MAT ==> Matrix - M2 ==> MatrixCategoryFunctions2 - MF2a ==> M2(FRAC POLY INT,VEC FRAC POLY INT,VEC FRAC POLY INT, - MAT FRAC POLY INT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2b ==> M2(FRAC POLY FLOAT,VEC FRAC POLY FLOAT,VEC FRAC POLY FLOAT, - MAT FRAC POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2c ==> M2(POLY INT,VEC POLY INT,VEC POLY INT,MAT POLY INT, - FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2d ==> M2(POLY FLOAT,VEC POLY FLOAT,VEC POLY FLOAT, - MAT POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2e ==> M2(EXPR INT,VEC EXPR INT,VEC EXPR INT,MAT EXPR INT, - FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2f ==> M2(EXPR FLOAT,VEC EXPR FLOAT,VEC EXPR FLOAT, - MAT EXPR FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - - Exports ==> FortranMatrixFunctionCategory with - coerce : MAT FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - syms : SYMTAB := empty()$SYMTAB - declare!(X,fortranReal(),syms)$SYMTAB - declare!(Y,fortranReal(),syms)$SYMTAB - declare!(A,fortranReal(),syms)$SYMTAB - declare!(B,fortranReal(),syms)$SYMTAB - declare!(C,fortranReal(),syms)$SYMTAB - declare!(IBND,fortranInteger(),syms)$SYMTAB - Rep := FortranProgram(name,["void"]$FSTU,[X,Y,A,B,C,IBND],syms) - - -- To help the poor compiler! - localAssign(u:Symbol,v:FEXPR):FC == assign(u,(v::EXPR MFLOAT)$FEXPR)$FC - - coerce(u:MAT FEXPR):$ == - (nrows(u) ~= 4 or ncols(u) ~= 3) => error "Not a 4X3 matrix" - flag:U := [IBND@Symbol::EXPR INT]$U - pt0:U := [0::EXPR INT]$U - pt1:U := [1::EXPR INT]$U - pt2:U := [2::EXPR INT]$U - pt3:U := [3::EXPR INT]$U - sw1: Switch := EQ(flag,pt0)$Switch - sw2: Switch := EQ(flag,pt1)$Switch - sw3: Switch := EQ(flag,pt2)$Switch - sw4: Switch := EQ(flag,pt3)$Switch - a11 : FC := localAssign(A,u(1,1)) - a12 : FC := localAssign(B,u(1,2)) - a13 : FC := localAssign(C,u(1,3)) - a21 : FC := localAssign(A,u(2,1)) - a22 : FC := localAssign(B,u(2,2)) - a23 : FC := localAssign(C,u(2,3)) - a31 : FC := localAssign(A,u(3,1)) - a32 : FC := localAssign(B,u(3,2)) - a33 : FC := localAssign(C,u(3,3)) - a41 : FC := localAssign(A,u(4,1)) - a42 : FC := localAssign(B,u(4,2)) - a43 : FC := localAssign(C,u(4,3)) - c : FC := cond(sw1,block([a11,a12,a13])$FC, - cond(sw2,block([a21,a22,a23])$FC, - cond(sw3,block([a31,a32,a33])$FC, - cond(sw4,block([a41,a42,a43])$FC)$FC)$FC)$FC)$FC - c::$ - - coerce(u:$):OutputForm == coerce(u)$Rep - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - retract(u:MAT FRAC POLY INT):$ == - v : MAT FEXPR := map(retract,u)$MF2a - v::$ - - retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT FRAC POLY FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2b - v::$ - - retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT EXPR INT):$ == - v : MAT FEXPR := map(retract,u)$MF2e - v::$ - - retractIfCan(u:MAT EXPR INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT EXPR FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2f - v::$ - - retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT POLY INT):$ == - v : MAT FEXPR := map(retract,u)$MF2c - v::$ - - retractIfCan(u:MAT POLY INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT POLY FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2d - v::$ - - retractIfCan(u:MAT POLY FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d - v case "failed" => "failed" - (v::MAT FEXPR)::$ - -@ -\section{domain ASP77 Asp77} -<<domain ASP77 Asp77>>= -)abbrev domain ASP77 Asp77 -++ Author: Mike Dewar, Grant Keady and Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 30 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranMatrixFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp77} produces Fortran for Type 77 ASPs, needed for NAG routine -++\axiomOpFrom{d02gbf}{d02Package}, for example: -++\begin{verbatim} -++ SUBROUTINE FCNF(X,F) -++ DOUBLE PRECISION X -++ DOUBLE PRECISION F(2,2) -++ F(1,1)=0.0D0 -++ F(1,2)=1.0D0 -++ F(2,1)=0.0D0 -++ F(2,2)=-10.0D0 -++ RETURN -++ END -++\end{verbatim} - -Asp77(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FSTU ==> Union(fst:FST,void:"void") - FT ==> FortranType - FC ==> FortranCode - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FC)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression(['X],[],MFLOAT) - VEC ==> Vector - MAT ==> Matrix - M2 ==> MatrixCategoryFunctions2 - MF2 ==> M2(FEXPR,VEC FEXPR,VEC FEXPR,Matrix FEXPR,EXPR MFLOAT, - VEC EXPR MFLOAT,VEC EXPR MFLOAT,Matrix EXPR MFLOAT) - MF2a ==> M2(FRAC POLY INT,VEC FRAC POLY INT,VEC FRAC POLY INT, - MAT FRAC POLY INT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2b ==> M2(FRAC POLY FLOAT,VEC FRAC POLY FLOAT,VEC FRAC POLY FLOAT, - MAT FRAC POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2c ==> M2(POLY INT,VEC POLY INT,VEC POLY INT,MAT POLY INT, - FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2d ==> M2(POLY FLOAT,VEC POLY FLOAT,VEC POLY FLOAT, - MAT POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2e ==> M2(EXPR INT,VEC EXPR INT,VEC EXPR INT,MAT EXPR INT, - FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2f ==> M2(EXPR FLOAT,VEC EXPR FLOAT,VEC EXPR FLOAT, - MAT EXPR FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - - - Exports ==> FortranMatrixFunctionCategory with - coerce : MAT FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - real : FSTU := ["real"::FST]$FSTU - syms : SYMTAB := empty()$SYMTAB - declare!(X,fortranReal(),syms)$SYMTAB - Rep := FortranProgram(name,["void"]$FSTU,[X,F],syms) - - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - localAssign(s:Symbol,j:MAT FEXPR):FortranCode == - j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2 - assign(s,j')$FortranCode - - coerce(u:MAT FEXPR):$ == - dimension := nrows(u)::POLY(INT) - locals : SYMTAB := empty() - declare!(F,[real,[dimension,dimension]$List(POLY(INT)),false]$FT,locals) - code' : List FC := [localAssign(F,u),returns()$FC] - ([locals,code']$RSFC)::$ - - coerce(c:List FC):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FC):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - retract(u:MAT FRAC POLY INT):$ == - v : MAT FEXPR := map(retract,u)$MF2a - v::$ - - retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT FRAC POLY FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2b - v::$ - - retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT EXPR INT):$ == - v : MAT FEXPR := map(retract,u)$MF2e - v::$ - - retractIfCan(u:MAT EXPR INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT EXPR FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2f - v::$ - - retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT POLY INT):$ == - v : MAT FEXPR := map(retract,u)$MF2c - v::$ - - retractIfCan(u:MAT POLY INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT POLY FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2d - v::$ - - retractIfCan(u:MAT POLY FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d - v case "failed" => "failed" - (v::MAT FEXPR)::$ - -@ -\section{domain ASP78 Asp78} -<<domain ASP78 Asp78>>= -)abbrev domain ASP78 Asp78 -++ Author: Mike Dewar, Grant Keady and Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 30 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp78} produces Fortran for Type 78 ASPs, needed for NAG routine -++\axiomOpFrom{d02gbf}{d02Package}, for example: -++\begin{verbatim} -++ SUBROUTINE FCNG(X,G) -++ DOUBLE PRECISION G(*),X -++ G(1)=0.0D0 -++ G(2)=0.0D0 -++ END -++\end{verbatim} - -Asp78(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FSTU ==> Union(fst:FST,void:"void") - FT ==> FortranType - FC ==> FortranCode - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FC)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - VF2 ==> VectorFunctions2 - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression(['X],[],MFLOAT) - - Exports ==> FortranVectorFunctionCategory with - coerce : VEC FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - real : FSTU := ["real"::FST]$FSTU - syms : SYMTAB := empty()$SYMTAB - declare!(X,fortranReal(),syms)$SYMTAB - gType : FT := construct(real,["*"::Symbol],false)$FT - declare!(G,gType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$FSTU,[X,G],syms) - - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - coerce(u:VEC FEXPR):$ == - u' : VEC EXPR MFLOAT := map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT) - (assign(G,u')$FC)::$ - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - coerce(c:List FC):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FC):$ == coerce(c)$Rep - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - -@ -\section{domain ASP8 Asp8} -<<domain ASP8 Asp8>>= -)abbrev domain ASP8 Asp8 -++ Author: Godfrey Nolan and Mike Dewar -++ Date Created: 11 February 1994 -++ Date Last Updated: 18 March 1994 -++ 31 May 1994 to use alternative interface. MCD -++ 30 June 1994 to handle the end condition correctly. MCD -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp8} produces Fortran for Type 8 ASPs, needed for NAG routine -++\axiomOpFrom{d02bbf}{d02Package}. This ASP prints intermediate values of the computed solution of -++an ODE and might look like: -++\begin{verbatim} -++ SUBROUTINE OUTPUT(XSOL,Y,COUNT,M,N,RESULT,FORWRD) -++ DOUBLE PRECISION Y(N),RESULT(M,N),XSOL -++ INTEGER M,N,COUNT -++ LOGICAL FORWRD -++ DOUBLE PRECISION X02ALF,POINTS(8) -++ EXTERNAL X02ALF -++ INTEGER I -++ POINTS(1)=1.0D0 -++ POINTS(2)=2.0D0 -++ POINTS(3)=3.0D0 -++ POINTS(4)=4.0D0 -++ POINTS(5)=5.0D0 -++ POINTS(6)=6.0D0 -++ POINTS(7)=7.0D0 -++ POINTS(8)=8.0D0 -++ COUNT=COUNT+1 -++ DO 25001 I=1,N -++ RESULT(COUNT,I)=Y(I) -++25001 CONTINUE -++ IF(COUNT.EQ.M)THEN -++ IF(FORWRD)THEN -++ XSOL=X02ALF() -++ ELSE -++ XSOL=-X02ALF() -++ ENDIF -++ ELSE -++ XSOL=POINTS(COUNT) -++ ENDIF -++ END -++\end{verbatim} - -Asp8(name): Exports == Implementation where - name : Symbol - - O ==> OutputForm - S ==> Symbol - FST ==> FortranScalarType - UFST ==> Union(fst:FST,void:"void") - FT ==> FortranType - FC ==> FortranCode - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - EX ==> Expression Integer - MFLOAT ==> MachineFloat - EXPR ==> Expression - PI ==> Polynomial Integer - EXU ==> Union(I: EXPR Integer,F: EXPR Float,CF: EXPR Complex Float, - switch: Switch) - - Exports ==> FortranVectorCategory - - Implementation ==> add - - real : UFST := ["real"::FST]$UFST - syms : SYMTAB := empty()$SYMTAB - declare!([COUNT,M,N],fortranInteger(),syms)$SYMTAB - declare!(XSOL,fortranReal(),syms)$SYMTAB - yType : FT := construct(real,[N],false)$FT - declare!(Y,yType,syms)$SYMTAB - declare!(FORWRD,fortranLogical(),syms)$SYMTAB - declare!(RESULT,construct(real,[M,N],false)$FT,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST,[XSOL,Y,COUNT,M,N,RESULT,FORWRD],syms) - - coerce(c:List FC):% == coerce(c)$Rep - - coerce(r:RSFC):% == coerce(r)$Rep - - coerce(c:FC):% == coerce(c)$Rep - - coerce(u:%):O == coerce(u)$Rep - - outputAsFortran(u:%):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - - f2ex(u:MFLOAT):EXPR MFLOAT == (u::EXPR MFLOAT)$EXPR(MFLOAT) - - coerce(points:Vector MFLOAT):% == - import PI - import EXPR Integer - -- Create some extra declarations - locals : SYMTAB := empty()$SYMTAB - nPol : PI := "N"::S::PI - iPol : PI := "I"::S::PI - countPol : PI := "COUNT"::S::PI - pointsDim : PI := max(#points,1)::PI - declare!(POINTS,[real,[pointsDim],false]$FT,locals)$SYMTAB - declare!(X02ALF,[real,[],true]$FT,locals)$SYMTAB - -- Now build up the code fragments - index : SegmentBinding PI := equation(I@S,1::PI..nPol)$SegmentBinding(PI) - ySym : EX := (subscript("Y"::S,[I::O])$S)::EX - loop := forLoop(index,assign(RESULT,[countPol,iPol],ySym)$FC)$FC - v:Vector EXPR MFLOAT - v := map(f2ex,points)$VectorFunctions2(MFLOAT,EXPR MFLOAT) - assign1 : FC := assign(POINTS,v)$FC - countExp: EX := COUNT@S::EX - newValue: EX := 1 + countExp - assign2 : FC := assign(COUNT,newValue)$FC - newSymbol : S := subscript(POINTS,[COUNT]@List(O))$S - assign3 : FC := assign(XSOL, newSymbol::EX )$FC - fphuge : EX := kernel(operator X02ALF,empty()$List(EX)) - assign4 : FC := assign(XSOL, fphuge)$FC - assign5 : FC := assign(XSOL, -fphuge)$FC - innerCond : FC := cond("FORWRD"::Symbol::Switch,assign4,assign5) - mExp : EX := M@S::EX - endCase : FC := cond(EQ([countExp]$EXU,[mExp]$EXU)$Switch,innerCond,assign3) - code' := [assign1, assign2, loop, endCase]$List(FC) - ([locals,code']$RSFC)::% - -@ -\section{domain ASP80 Asp80} -<<domain ASP80 Asp80>>= -)abbrev domain ASP80 Asp80 -++ Author: Mike Dewar and Godfrey Nolan -++ Date Created: Oct 1993 -++ Date Last Updated: 30 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranMatrixFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp80} produces Fortran for Type 80 ASPs, needed for NAG routine -++\axiomOpFrom{d02kef}{d02Package}, for example: -++\begin{verbatim} -++ SUBROUTINE BDYVAL(XL,XR,ELAM,YL,YR) -++ DOUBLE PRECISION ELAM,XL,YL(3),XR,YR(3) -++ YL(1)=XL -++ YL(2)=2.0D0 -++ YR(1)=1.0D0 -++ YR(2)=-1.0D0*DSQRT(XR+(-1.0D0*ELAM)) -++ RETURN -++ END -++\end{verbatim} - -Asp80(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FSTU ==> Union(fst:FST,void:"void") - FT ==> FortranType - FC ==> FortranCode - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression(['XL,'XR,'ELAM],[],MFLOAT) - VEC ==> Vector - MAT ==> Matrix - VF2 ==> VectorFunctions2 - M2 ==> MatrixCategoryFunctions2 - MF2a ==> M2(FRAC POLY INT,VEC FRAC POLY INT,VEC FRAC POLY INT, - MAT FRAC POLY INT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2b ==> M2(FRAC POLY FLOAT,VEC FRAC POLY FLOAT,VEC FRAC POLY FLOAT, - MAT FRAC POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2c ==> M2(POLY INT,VEC POLY INT,VEC POLY INT,MAT POLY INT, - FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2d ==> M2(POLY FLOAT,VEC POLY FLOAT,VEC POLY FLOAT, - MAT POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2e ==> M2(EXPR INT,VEC EXPR INT,VEC EXPR INT,MAT EXPR INT, - FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2f ==> M2(EXPR FLOAT,VEC EXPR FLOAT,VEC EXPR FLOAT, - MAT EXPR FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - - Exports ==> FortranMatrixFunctionCategory with - coerce : MAT FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - real : FSTU := ["real"::FST]$FSTU - syms : SYMTAB := empty()$SYMTAB - declare!(XL,fortranReal(),syms)$SYMTAB - declare!(XR,fortranReal(),syms)$SYMTAB - declare!(ELAM,fortranReal(),syms)$SYMTAB - yType : FT := construct(real,["3"::Symbol],false)$FT - declare!(YL,yType,syms)$SYMTAB - declare!(YR,yType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$FSTU, [XL,XR,ELAM,YL,YR],syms) - - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - vecAssign(s:Symbol,u:VEC FEXPR):FC == - u' : VEC EXPR MFLOAT := map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT) - assign(s,u')$FC - - coerce(u:MAT FEXPR):$ == - [vecAssign(YL,row(u,1)),vecAssign(YR,row(u,2)),returns()$FC]$List(FC)::$ - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - retract(u:MAT FRAC POLY INT):$ == - v : MAT FEXPR := map(retract,u)$MF2a - v::$ - - retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT FRAC POLY FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2b - v::$ - - retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT EXPR INT):$ == - v : MAT FEXPR := map(retract,u)$MF2e - v::$ - - retractIfCan(u:MAT EXPR INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT EXPR FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2f - v::$ - - retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT POLY INT):$ == - v : MAT FEXPR := map(retract,u)$MF2c - v::$ - - retractIfCan(u:MAT POLY INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT POLY FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2d - v::$ - - retractIfCan(u:MAT POLY FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d - v case "failed" => "failed" - (v::MAT FEXPR)::$ - -@ -\section{domain ASP9 Asp9} -<<domain ASP9 Asp9>>= -)abbrev domain ASP9 Asp9 -++ Author: Mike Dewar, Grant Keady and Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 18 March 1994 -++ 12 July 1994 added COMMON blocks for d02cjf, d02ejf -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp9} produces Fortran for Type 9 ASPs, needed for NAG routines -++\axiomOpFrom{d02bhf}{d02Package}, \axiomOpFrom{d02cjf}{d02Package}, \axiomOpFrom{d02ejf}{d02Package}. -++These ASPs represent a function of a scalar X and a vector Y, for example: -++\begin{verbatim} -++ DOUBLE PRECISION FUNCTION G(X,Y) -++ DOUBLE PRECISION X,Y(*) -++ G=X+Y(1) -++ RETURN -++ END -++\end{verbatim} -++If the user provides a constant value for G, then extra information is added -++via COMMON blocks used by certain routines. This specifies that the value -++returned by G in this case is to be ignored. - -Asp9(name): Exports == Implementation where - name : Symbol - - FEXPR ==> FortranExpression(['X],['Y],MFLOAT) - MFLOAT ==> MachineFloat - FC ==> FortranCode - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - UFST ==> Union(fst:FST,void:"void") - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - - Exports ==> FortranFunctionCategory with - coerce : FEXPR -> % - ++coerce(f) takes an object from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns it into an ASP. - - Implementation ==> add - - real : FST := "real"::FST - syms : SYMTAB := empty()$SYMTAB - declare!(X,fortranReal()$FT,syms)$SYMTAB - yType : FT := construct([real]$UFST,["*"::Symbol],false)$FT - declare!(Y,yType,syms)$SYMTAB - Rep := FortranProgram(name,[real]$UFST,[X,Y],syms) - - retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:FRAC POLY INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:EXPR FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:EXPR INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:POLY FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:POLY INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:POLY INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - coerce(u:FEXPR):% == - expr : Expression MachineFloat := (u::Expression(MachineFloat))$FEXPR - (retractIfCan(u)@Union(MFLOAT,"failed"))$FEXPR case "failed" => - coerce(expr)$Rep - locals : SYMTAB := empty() - charType : FT := construct(["character"::FST]$UFST,[6::POLY(INT)],false)$FT - declare!([CHDUM1,CHDUM2,GOPT1,CHDUM,GOPT2],charType,locals)$SYMTAB - common1 := common(CD02EJ,[CHDUM1,CHDUM2,GOPT1] )$FC - common2 := common(AD02CJ,[CHDUM,GOPT2] )$FC - assign1 := assign(GOPT1,"NOGOPT")$FC - assign2 := assign(GOPT2,"NOGOPT")$FC - result := assign(name,expr)$FC - code' : List FC := [common1,common2,assign1,assign2,result] - ([locals,code']$RSFC)::Rep - - coerce(c:List FortranCode):% == coerce(c)$Rep - - coerce(r:RSFC):% == coerce(r)$Rep - - coerce(c:FortranCode):% == coerce(c)$Rep - - coerce(u:%):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\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>> - -<<domain ASP1 Asp1>> -<<domain ASP10 Asp10>> -<<domain ASP12 Asp12>> -<<domain ASP19 Asp19>> -<<domain ASP20 Asp20>> -<<domain ASP24 Asp24>> -<<domain ASP27 Asp27>> -<<domain ASP28 Asp28>> -<<domain ASP29 Asp29>> -<<domain ASP30 Asp30>> -<<domain ASP31 Asp31>> -<<domain ASP33 Asp33>> -<<domain ASP34 Asp34>> -<<domain ASP35 Asp35>> -<<domain ASP4 Asp4>> -<<domain ASP41 Asp41>> -<<domain ASP42 Asp42>> -<<domain ASP49 Asp49>> -<<domain ASP50 Asp50>> -<<domain ASP55 Asp55>> -<<domain ASP6 Asp6>> -<<domain ASP7 Asp7>> -<<domain ASP73 Asp73>> -<<domain ASP74 Asp74>> -<<domain ASP77 Asp77>> -<<domain ASP78 Asp78>> -<<domain ASP8 Asp8>> -<<domain ASP80 Asp80>> -<<domain ASP9 Asp9>> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/cont.spad.pamphlet b/src/algebra/cont.spad.pamphlet deleted file mode 100644 index 9444f58f..00000000 --- a/src/algebra/cont.spad.pamphlet +++ /dev/null @@ -1,354 +0,0 @@ -\documentclass{article} -\usepackage{open-axiom} -\begin{document} -\title{\$SPAD/src/algebra cont.spad} -\author{Brian Dupee} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package ESCONT ExpertSystemContinuityPackage} -<<package ESCONT ExpertSystemContinuityPackage>>= -)abbrev package ESCONT ExpertSystemContinuityPackage -++ Author: Brian Dupee -++ Date Created: May 1994 -++ Date Last Updated: June 1995 -++ Basic Operations: problemPoints, singularitiesOf, zerosOf -++ Related Constructors: -++ Description: -++ ExpertSystemContinuityPackage is a package of functions for the use of domains -++ belonging to the category \axiomType{NumericalIntegration}. - -ExpertSystemContinuityPackage(): E == I where - EF2 ==> ExpressionFunctions2 - FI ==> Fraction Integer - EFI ==> Expression Fraction Integer - PFI ==> Polynomial Fraction Integer - DF ==> DoubleFloat - LDF ==> List DoubleFloat - EDF ==> Expression DoubleFloat - VEDF ==> Vector Expression DoubleFloat - SDF ==> Stream DoubleFloat - SS ==> Stream String - EEDF ==> Equation Expression DoubleFloat - LEDF ==> List Expression DoubleFloat - KEDF ==> Kernel Expression DoubleFloat - LKEDF ==> List Kernel Expression DoubleFloat - PDF ==> Polynomial DoubleFloat - FPDF ==> Fraction Polynomial DoubleFloat - OCDF ==> OrderedCompletion DoubleFloat - SOCDF ==> Segment OrderedCompletion DoubleFloat - NIA ==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF) - UP ==> UnivariatePolynomial - BO ==> BasicOperator - RS ==> Record(zeros: SDF,ones: SDF,singularities: SDF) - - E ==> with - - getlo : SOCDF -> DF - ++ getlo(u) gets the \axiomType{DoubleFloat} equivalent of - ++ the first endpoint of the range \axiom{u} - gethi : SOCDF -> DF - ++ gethi(u) gets the \axiomType{DoubleFloat} equivalent of - ++ the second endpoint of the range \axiom{u} - functionIsFracPolynomial?: NIA -> Boolean - ++ functionIsFracPolynomial?(args) tests whether the function - ++ can be retracted to \axiomType{Fraction(Polynomial(DoubleFloat))} - problemPoints:(EDF,Symbol,SOCDF) -> List DF - ++ problemPoints(f,var,range) returns a list of possible problem points - ++ by looking at the zeros of the denominator of the function \spad{f} - ++ if it can be retracted to \axiomType{Polynomial(DoubleFloat)}. - zerosOf:(EDF,List Symbol,SOCDF) -> SDF - ++ zerosOf(e,vars,range) returns a list of points - ++ (\axiomType{Doublefloat}) at which a NAG fortran version of \spad{e} - ++ will most likely produce an error. - singularitiesOf: (EDF,List Symbol,SOCDF) -> SDF - ++ singularitiesOf(e,vars,range) returns a list of points - ++ (\axiomType{Doublefloat}) at which a NAG fortran - ++ version of \spad{e} will most likely produce - ++ an error. This includes those points which evaluate to 0/0. - singularitiesOf: (Vector EDF,List Symbol,SOCDF) -> SDF - ++ singularitiesOf(v,vars,range) returns a list of points - ++ (\axiomType{Doublefloat}) at which a NAG fortran - ++ version of \spad{v} will most likely produce - ++ an error. This includes those points which evaluate to 0/0. - polynomialZeros:(PFI,Symbol,SOCDF) -> LDF - ++ polynomialZeros(fn,var,range) calculates the real zeros of the - ++ polynomial which are contained in the given interval. It returns - ++ a list of points (\axiomType{Doublefloat}) for which the univariate - ++ polynomial \spad{fn} is zero. - df2st:DF -> String - ++ df2st(n) coerces a \axiomType{DoubleFloat} to \axiomType{String} - ldf2lst:LDF -> List String - ++ ldf2lst(ln) coerces a List of \axiomType{DoubleFloat} to - ++ \axiomType{List}(\axiomType{String}) - sdf2lst:SDF -> List String - ++ sdf2lst(ln) coerces a Stream of \axiomType{DoubleFloat} to - ++ \axiomType{List}(\axiomType{String}) - - I ==> ExpertSystemToolsPackage add - - import ExpertSystemToolsPackage - - functionIsPolynomial?(args:NIA):Boolean == - -- tests whether the function can be retracted to a polynomial - (retractIfCan(args.fn)@Union(PDF,"failed"))$EDF case PDF - - isPolynomial?(f:EDF):Boolean == - -- tests whether the function can be retracted to a polynomial - (retractIfCan(f)@Union(PDF,"failed"))$EDF case PDF - - isConstant?(f:EDF):Boolean == - -- tests whether the function can be retracted to a constant (DoubleFloat) - (retractIfCan(f)@Union(DF,"failed"))$EDF case DF - - denominatorIsPolynomial?(args:NIA):Boolean == - -- tests if the denominator can be retracted to polynomial - a:= copy args - a.fn:=denominator(args.fn) - (functionIsPolynomial?(a))@Boolean - - denIsPolynomial?(f:EDF):Boolean == - -- tests if the denominator can be retracted to polynomial - (isPolynomial?(denominator f))@Boolean - - listInRange(l:LDF,range:SOCDF):LDF == - -- returns a list with only those elements internal to the range range - [t for t in l | in?(t,range)] - - loseUntil(l:SDF,a:DF):SDF == - empty?(l)$SDF => l - f := first(l)$SDF - (abs(f) <= abs(a)) => loseUntil(rest(l)$SDF,a) - l - - retainUntil(l:SDF,a:DF,b:DF,flag:Boolean):SDF == - empty?(l)$SDF => l - f := first(l)$SDF - (in?(f)$ExpertSystemContinuityPackage1(a,b)) => - concat(f,retainUntil(rest(l),a,b,false)) - flag => empty()$SDF - retainUntil(rest(l),a,b,true) - - streamInRange(l:SDF,range:SOCDF):SDF == - -- returns a stream with only those elements internal to the range range - a := getlo(range := dfRange(range)) - b := gethi(range) - explicitlyFinite?(l) => - select(in?$ExpertSystemContinuityPackage1(a,b),l)$SDF - negative?(a*b) => retainUntil(l,a,b,false) - negative?(a) => - l := loseUntil(l,b) - retainUntil(l,a,b,false) - l := loseUntil(l,a) - retainUntil(l,a,b,false) - - getStream(n:Symbol,s:String):SDF == - import RS - entry?(n,bfKeys()$BasicFunctions)$(List(Symbol)) => - c := bfEntry(n)$BasicFunctions - (s = "zeros")@Boolean => c.zeros - (s = "singularities")@Boolean => c.singularities - (s = "ones")@Boolean => c.ones - empty()$SDF - - polynomialZeros(fn:PFI,var:Symbol,range:SOCDF):LDF == - up := unmakeSUP(univariate(fn)$PFI)$UP(var,FI) - range := dfRange(range) - r:Record(left:FI,right:FI) := [df2fi(getlo(range)), df2fi(gethi(range))] - ans:List(Record(left:FI,right:FI)) := - realZeros(up,r,1/1000000000000000000)$RealZeroPackageQ(UP(var,FI)) - listInRange(dflist(ans),range) - - functionIsFracPolynomial?(args:NIA):Boolean == - -- tests whether the function can be retracted to a fraction - -- where both numerator and denominator are polynomial - (retractIfCan(args.fn)@Union(FPDF,"failed"))$EDF case FPDF - - problemPoints(f:EDF,var:Symbol,range:SOCDF):LDF == - (denIsPolynomial?(f))@Boolean => - c := retract(edf2efi(denominator(f)))@PFI - polynomialZeros(c,var,range) - empty()$LDF - - zerosOf(e:EDF,vars:List Symbol,range:SOCDF):SDF == - (u := isQuotient(e)) case EDF => - singularitiesOf(u,vars,range) - k := kernels(e)$EDF - ((nk := # k) = 0)@Boolean => empty()$SDF -- constant found. - (nk = 1)@Boolean => -- single expression found. - ker := first(k)$LKEDF - n := name(operator(ker)$KEDF)$BO - entry?(n,vars) => -- polynomial found. - c := retract(edf2efi(e))@PFI - coerce(polynomialZeros(c,n,range))$SDF - a := first(argument(ker)$KEDF)$LEDF - (not (n = log :: Symbol)@Boolean) and ((w := isPlus a) case LEDF) => - var:Symbol := first(variables(a)) - c:EDF := w.2 - c1:EDF := w.1 - entry?(c1,[b::EDF for b in vars]) and (one?(# vars)) => - c2:DF := edf2df c - c3 := c2 :: OCDF - varEdf := var :: EDF - varEqn := equation(varEdf,c1-c)$EEDF - range2 := (lo(range)+c3)..(hi(range)+c3) - s := zerosOf(subst(e,varEqn)$EDF,vars,range2) - st := map(#1-c2,s)$StreamFunctions2(DF,DF) - streamInRange(st,range) - zerosOf(a,vars,range) - (t := isPlus(e)$EDF) case LEDF => -- constant + expression - # t > 2 => empty()$SDF - entry?(a,[b::EDF for b in vars]) => -- finds entries like sqrt(x) - st := getStream(n,"ones") - o := edf2df(second(t)$LEDF) - one?(o) or one?(-o) => -- is it like (f(x) -/+ 1) - st := map(-#1/o,st)$StreamFunctions2(DF,DF) - streamInRange(st,range) - empty()$SDF - empty()$SDF - entry?(a,[b::EDF for b in vars]) => -- finds entries like sqrt(x) - st := getStream(n,"zeros") - streamInRange(st,range) - (n = tan :: Symbol)@Boolean => - concat([zerosOf(a,vars,range),singularitiesOf(a,vars,range)]) - (n = sin :: Symbol)@Boolean => - concat([zerosOf(a,vars,range),singularitiesOf(a,vars,range)]) - empty()$SDF - (t := isPlus(e)$EDF) case LEDF => empty()$SDF -- INCOMPLETE!!! - (v := isTimes(e)$EDF) case LEDF => - concat([zerosOf(u,vars,range) for u in v]) - empty()$SDF - - singularitiesOf(e:EDF,vars:List Symbol,range:SOCDF):SDF == - (u := isQuotient(e)) case EDF => - zerosOf(u,vars,range) - (t := isPlus e) case LEDF => - concat([singularitiesOf(u,vars,range) for u in t]) - (v := isTimes e) case LEDF => - concat([singularitiesOf(u,vars,range) for u in v]) - (k := mainKernel e) case KEDF => - n := name(operator k) - entry?(n,vars) => coerce(problemPoints(e,n,range))$SDF - a:EDF := (argument k).1 - (not (n = log :: Symbol)@Boolean) and ((w := isPlus a) case LEDF) => - var:Symbol := first(variables(a)) - c:EDF := w.2 - c1:EDF := w.1 - entry?(c1,[b::EDF for b in vars]) and (one?(# vars)) => - c2:DF := edf2df c - c3 := c2 :: OCDF - varEdf := var :: EDF - varEqn := equation(varEdf,c1-c)$EEDF - range2 := (lo(range)+c3)..(hi(range)+c3) - s := singularitiesOf(subst(e,varEqn)$EDF,vars,range2) - st := map(#1-c2,s)$StreamFunctions2(DF,DF) - streamInRange(st,range) - singularitiesOf(a,vars,range) - entry?(a,[b::EDF for b in vars]) => - st := getStream(n,"singularities") - streamInRange(st,range) - (n = log :: Symbol)@Boolean => - concat([zerosOf(a,vars,range),singularitiesOf(a,vars,range)]) - singularitiesOf(a,vars,range) - empty()$SDF - - singularitiesOf(v:VEDF,vars:List Symbol,range:SOCDF):SDF == - ls := [singularitiesOf(u,vars,range) for u in entries(v)$VEDF] - concat(ls)$SDF - -@ -\section{package ESCONT1 ExpertSystemContinuityPackage1} -<<package ESCONT1 ExpertSystemContinuityPackage1>>= -)abbrev package ESCONT1 ExpertSystemContinuityPackage1 -++ Author: Brian Dupee -++ Date Created: May 1994 -++ Date Last Updated: June 1995 -++ Basic Operations: problemPoints, singularitiesOf, zerosOf -++ Related Constructors: -++ Description: -++ ExpertSystemContinuityPackage1 exports a function to check range inclusion - -ExpertSystemContinuityPackage1(A:DF,B:DF): E == I where - EF2 ==> ExpressionFunctions2 - FI ==> Fraction Integer - EFI ==> Expression Fraction Integer - PFI ==> Polynomial Fraction Integer - DF ==> DoubleFloat - LDF ==> List DoubleFloat - EDF ==> Expression DoubleFloat - VEDF ==> Vector Expression DoubleFloat - SDF ==> Stream DoubleFloat - SS ==> Stream String - EEDF ==> Equation Expression DoubleFloat - LEDF ==> List Expression DoubleFloat - KEDF ==> Kernel Expression DoubleFloat - LKEDF ==> List Kernel Expression DoubleFloat - PDF ==> Polynomial DoubleFloat - FPDF ==> Fraction Polynomial DoubleFloat - OCDF ==> OrderedCompletion DoubleFloat - SOCDF ==> Segment OrderedCompletion DoubleFloat - NIA ==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF) - UP ==> UnivariatePolynomial - BO ==> BasicOperator - RS ==> Record(zeros: SDF,ones: SDF,singularities: SDF) - - E ==> with - - in?:DF -> Boolean - ++ in?(p) tests whether point p is internal to the range [\spad{A..B}] - - I ==> add - - in?(p:DF):Boolean == - a:Boolean := (p < B)$DF - b:Boolean := (A < p)$DF - (a and b)@Boolean - -@ -\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>> - -<<package ESCONT ExpertSystemContinuityPackage>> -<<package ESCONT1 ExpertSystemContinuityPackage1>> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/exposed.lsp.pamphlet b/src/algebra/exposed.lsp.pamphlet index 5108f68d..0e75f115 100644 --- a/src/algebra/exposed.lsp.pamphlet +++ b/src/algebra/exposed.lsp.pamphlet @@ -49,7 +49,7 @@ (in-package "BOOT") (defparameter |$globalExposureGroupAlist| '( -;;define the groups |basic| |naglink| |anna| |categories| |Hidden| |defaults| +;;define the groups |basic| |naglink| |categories| |Hidden| |defaults| (|basic| (|AddAst| . ADDAST) (|AlgebraicManipulations| . ALGMANIP) @@ -452,51 +452,11 @@ (|WuWenTsunTriangularSet| . WUTSET) ) (|naglink| - (|FortranCode| . FC) - (|FortranCodePackage1| . FCPAK1) - (|FortranExpression| . FEXPR) - (|FortranMachineTypeCategory| . FMTC) - (|FortranMatrixCategory| . FMC) - (|FortranMatrixFunctionCategory| . FMFUN) - (|FortranOutputStackPackage| . FOP) - (|FortranPackage| . FORT) - (|FortranProgramCategory| . FORTCAT) - (|FortranProgram| . FORTRAN) - (|FortranFunctionCategory| . FORTFN) (|FortranScalarType| . FST) (|FortranType| . FT) - (|FortranTemplate| . FTEM) - (|FortranVectorFunctionCategory| . FVFUN) - (|FortranVectorCategory| . FVC) - (|MachineComplex| . MCMPLX) - (|MachineFloat| . MFLOAT) - (|MachineInteger| . MINT) - (|MultiVariableCalculusFunctions| . MCALCFN) - (|PackedHermitianSequence| . PACKED) - (|Result| . RESULT) - (|SimpleFortranProgram| . SFORT) - (|Switch| . SWITCH) (|SymbolTable| . SYMTAB) - (|TemplateUtilities| . TEMUTL) (|TheSymbolTable| . SYMS) - (|ThreeDimensionalMatrix| . M3D)) -(|anna| - (|AttributeButtons| . ATTRBUT) - (|BasicFunctions| . BFUNCT) - (|ExpertSystemContinuityPackage| . ESCONT) - (|ExpertSystemContinuityPackage1| . ESCONT1) - (|ExpertSystemToolsPackage| . ESTOOLS) - (|ExpertSystemToolsPackage1| . ESTOOLS1) - (|ExpertSystemToolsPackage2| . ESTOOLS2) - (|NumericalIntegrationCategory| . NUMINT) - (|NumericalIntegrationProblem| . NIPROB) - (|NumericalODEProblem| . ODEPROB) - (|NumericalOptimizationCategory| . OPTCAT) - (|NumericalOptimizationProblem| . OPTPROB) - (|NumericalPDEProblem| . PDEPROB) - (|OrdinaryDifferentialEquationsSolverCategory| . ODECAT) - (|PartialDifferentialEquationsSolverCategory| . PDECAT) - (|RoutinesTable| . ROUTINE)) +) (|categories| (|AbelianGroup| . ABELGRP) (|AbelianMonoid| . ABELMON) @@ -1243,7 +1203,6 @@ '|basic| '|categories| '|naglink| -'|anna| ) (LIST ;;These constructors will be explicitly exposed diff --git a/src/algebra/fortcat.spad.pamphlet b/src/algebra/fortcat.spad.pamphlet deleted file mode 100644 index 84c2fd5c..00000000 --- a/src/algebra/fortcat.spad.pamphlet +++ /dev/null @@ -1,345 +0,0 @@ -\documentclass{article} -\usepackage{open-axiom} -\begin{document} -\title{\$SPAD/src/algebra fortcat.spad} -\author{Mike Dewar} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{category FORTFN FortranFunctionCategory} -<<category FORTFN FortranFunctionCategory>>= -)abbrev category FORTFN FortranFunctionCategory -++ Author: Mike Dewar -++ Date Created: 13 January 1994 -++ Date Last Updated: 18 March 1994 -++ Related Constructors: FortranProgramCategory. -++ Description: -++ \axiomType{FortranFunctionCategory} is the category of arguments to -++ NAG Library routines which return (sets of) function values. -FortranFunctionCategory():Category == FortranProgramCategory with - coerce : List FortranCode -> $ - ++ coerce(e) takes an object from \spadtype{List FortranCode} and - ++ uses it as the body of an ASP. - coerce : FortranCode -> $ - ++ coerce(e) takes an object from \spadtype{FortranCode} and - ++ uses it as the body of an ASP. - coerce : Record(localSymbols:SymbolTable,code:List(FortranCode)) -> $ - ++ coerce(e) takes the component of \spad{e} from - ++ \spadtype{List FortranCode} and uses it as the body of the ASP, - ++ making the declarations in the \spadtype{SymbolTable} component. - retract : Expression Float -> $ - ++ retract(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retractIfCan : Expression Float -> Union($,"failed") - ++ retractIfCan(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retract : Expression Integer -> $ - ++ retract(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retractIfCan : Expression Integer -> Union($,"failed") - ++ retractIfCan(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retract : Polynomial Float -> $ - ++ retract(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retractIfCan : Polynomial Float -> Union($,"failed") - ++ retractIfCan(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retract : Polynomial Integer -> $ - ++ retract(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retractIfCan : Polynomial Integer -> Union($,"failed") - ++ retractIfCan(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retract : Fraction Polynomial Float -> $ - ++ retract(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retractIfCan : Fraction Polynomial Float -> Union($,"failed") - ++ retractIfCan(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retract : Fraction Polynomial Integer -> $ - ++ retract(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retractIfCan : Fraction Polynomial Integer -> Union($,"failed") - ++ retractIfCan(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - - -- NB: These ASPs also have a coerce from an appropriate instantiation - -- of FortranExpression. - - -@ -\section{category FMC FortranMatrixCategory} -<<category FMC FortranMatrixCategory>>= -)abbrev category FMC FortranMatrixCategory -++ Author: Mike Dewar -++ Date Created: 21 March 1994 -++ Date Last Updated: -++ Related Constructors: FortranProgramCategory. -++ Description: -++ \axiomType{FortranMatrixCategory} provides support for -++ producing Functions and Subroutines when the input to these -++ is an AXIOM object of type \axiomType{Matrix} or in domains -++ involving \axiomType{FortranCode}. -FortranMatrixCategory():Category == FortranProgramCategory with - coerce : Matrix MachineFloat -> $ - ++ coerce(v) produces an ASP which returns the value of \spad{v}. - coerce : List FortranCode -> $ - ++ coerce(e) takes an object from \spadtype{List FortranCode} and - ++ uses it as the body of an ASP. - coerce : FortranCode -> $ - ++ coerce(e) takes an object from \spadtype{FortranCode} and - ++ uses it as the body of an ASP. - coerce : Record(localSymbols:SymbolTable,code:List(FortranCode)) -> $ - ++ coerce(e) takes the component of \spad{e} from - ++ \spadtype{List FortranCode} and uses it as the body of the ASP, - ++ making the declarations in the \spadtype{SymbolTable} component. - -@ -\section{category FORTCAT FortranProgramCategory} -<<category FORTCAT FortranProgramCategory>>= -)abbrev category FORTCAT FortranProgramCategory -++ Author: Mike Dewar -++ Date Created: November 1992 -++ Date Last Updated: -++ Basic Operations: -++ Related Constructors: FortranType, FortranCode, Switch -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ \axiomType{FortranProgramCategory} provides various models of -++ FORTRAN subprograms. These can be transformed into actual FORTRAN -++ code. -FortranProgramCategory():Category == Join(Type,CoercibleTo OutputForm) with - outputAsFortran : $ -> Void - ++ \axiom{outputAsFortran(u)} translates \axiom{u} into a legal FORTRAN - ++ subprogram. - -@ -\section{category FVC FortranVectorCategory} -<<category FVC FortranVectorCategory>>= -)abbrev category FVC FortranVectorCategory -++ Author: Mike Dewar -++ Date Created: October 1993 -++ Date Last Updated: 18 March 1994 -++ Related Constructors: FortranProgramCategory. -++ Description: -++ \axiomType{FortranVectorCategory} provides support for -++ producing Functions and Subroutines when the input to these -++ is an AXIOM object of type \axiomType{Vector} or in domains -++ involving \axiomType{FortranCode}. -FortranVectorCategory():Category == FortranProgramCategory with - coerce : Vector MachineFloat -> $ - ++ coerce(v) produces an ASP which returns the value of \spad{v}. - coerce : List FortranCode -> $ - ++ coerce(e) takes an object from \spadtype{List FortranCode} and - ++ uses it as the body of an ASP. - coerce : FortranCode -> $ - ++ coerce(e) takes an object from \spadtype{FortranCode} and - ++ uses it as the body of an ASP. - coerce : Record(localSymbols:SymbolTable,code:List(FortranCode)) -> $ - ++ coerce(e) takes the component of \spad{e} from - ++ \spadtype{List FortranCode} and uses it as the body of the ASP, - ++ making the declarations in the \spadtype{SymbolTable} component. - -@ -\section{category FMTC FortranMachineTypeCategory} -<<category FMTC FortranMachineTypeCategory>>= -)abbrev category FMTC FortranMachineTypeCategory -++ Author: Mike Dewar -++ Date Created: December 1993 -++ Date Last Updated: -++ Basic Operations: -++ Related Domains: -++ Also See: FortranExpression, MachineInteger, MachineFloat, MachineComplex -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: A category of domains which model machine arithmetic -++ used by machines in the AXIOM-NAG link. -FortranMachineTypeCategory():Category == Join(IntegralDomain,OrderedSet, - RetractableTo(Integer) ) - -@ -\section{category FMFUN FortranMatrixFunctionCategory} -<<category FMFUN FortranMatrixFunctionCategory>>= -)abbrev category FMFUN FortranMatrixFunctionCategory -++ Author: Mike Dewar -++ Date Created: March 18 1994 -++ Date Last Updated: -++ Related Constructors: FortranProgramCategory. -++ Description: -++ \axiomType{FortranMatrixFunctionCategory} provides support for -++ producing Functions and Subroutines representing matrices of -++ expressions. - -FortranMatrixFunctionCategory():Category == FortranProgramCategory with - coerce : List FortranCode -> $ - ++ coerce(e) takes an object from \spadtype{List FortranCode} and - ++ uses it as the body of an ASP. - coerce : FortranCode -> $ - ++ coerce(e) takes an object from \spadtype{FortranCode} and - ++ uses it as the body of an ASP. - coerce : Record(localSymbols:SymbolTable,code:List(FortranCode)) -> $ - ++ coerce(e) takes the component of \spad{e} from - ++ \spadtype{List FortranCode} and uses it as the body of the ASP, - ++ making the declarations in the \spadtype{SymbolTable} component. - retract : Matrix Expression Float -> $ - ++ retract(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retractIfCan : Matrix Expression Float -> Union($,"failed") - ++ retractIfCan(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retract : Matrix Expression Integer -> $ - ++ retract(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retractIfCan : Matrix Expression Integer -> Union($,"failed") - ++ retractIfCan(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retract : Matrix Polynomial Float -> $ - ++ retract(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retractIfCan : Matrix Polynomial Float -> Union($,"failed") - ++ retractIfCan(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retract : Matrix Polynomial Integer -> $ - ++ retract(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retractIfCan : Matrix Polynomial Integer -> Union($,"failed") - ++ retractIfCan(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retract : Matrix Fraction Polynomial Float -> $ - ++ retract(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retractIfCan : Matrix Fraction Polynomial Float -> Union($,"failed") - ++ retractIfCan(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retract : Matrix Fraction Polynomial Integer -> $ - ++ retract(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retractIfCan : Matrix Fraction Polynomial Integer -> Union($,"failed") - ++ retractIfCan(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - - -- NB: These ASPs also have a coerce from an appropriate instantiation - -- of Matrix FortranExpression. - -@ -\section{category FVFUN FortranVectorFunctionCategory} -<<category FVFUN FortranVectorFunctionCategory>>= -)abbrev category FVFUN FortranVectorFunctionCategory -++ Author: Mike Dewar -++ Date Created: 11 March 1994 -++ Date Last Updated: 18 March 1994 -++ Related Constructors: FortranProgramCategory. -++ Description: -++ \axiomType{FortranVectorFunctionCategory} is the catagory of arguments -++ to NAG Library routines which return the values of vectors of functions. -FortranVectorFunctionCategory():Category == FortranProgramCategory with - coerce : List FortranCode -> $ - ++ coerce(e) takes an object from \spadtype{List FortranCode} and - ++ uses it as the body of an ASP. - coerce : FortranCode -> $ - ++ coerce(e) takes an object from \spadtype{FortranCode} and - ++ uses it as the body of an ASP. - coerce : Record(localSymbols:SymbolTable,code:List(FortranCode)) -> $ - ++ coerce(e) takes the component of \spad{e} from - ++ \spadtype{List FortranCode} and uses it as the body of the ASP, - ++ making the declarations in the \spadtype{SymbolTable} component. - retract : Vector Expression Float -> $ - ++ retract(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retractIfCan : Vector Expression Float -> Union($,"failed") - ++ retractIfCan(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retract : Vector Expression Integer -> $ - ++ retract(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retractIfCan : Vector Expression Integer -> Union($,"failed") - ++ retractIfCan(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retract : Vector Polynomial Float -> $ - ++ retract(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retractIfCan : Vector Polynomial Float -> Union($,"failed") - ++ retractIfCan(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retract : Vector Polynomial Integer -> $ - ++ retract(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retractIfCan : Vector Polynomial Integer -> Union($,"failed") - ++ retractIfCan(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retract : Vector Fraction Polynomial Float -> $ - ++ retract(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retractIfCan : Vector Fraction Polynomial Float -> Union($,"failed") - ++ retractIfCan(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retract : Vector Fraction Polynomial Integer -> $ - ++ retract(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - retractIfCan : Vector Fraction Polynomial Integer -> Union($,"failed") - ++ retractIfCan(e) tries to convert \spad{e} into an ASP, checking that - ++ legal Fortran-77 is produced. - - -- NB: These ASPs also have a coerce from an appropriate instantiation - -- of Vector FortranExpression. - -@ -\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>> - -<<category FORTFN FortranFunctionCategory>> -<<category FMC FortranMatrixCategory>> -<<category FORTCAT FortranProgramCategory>> -<<category FVC FortranVectorCategory>> -<<category FMTC FortranMachineTypeCategory>> -<<category FMFUN FortranMatrixFunctionCategory>> -<<category FVFUN FortranVectorFunctionCategory>> - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/fortmac.spad.pamphlet b/src/algebra/fortmac.spad.pamphlet deleted file mode 100644 index 5684244c..00000000 --- a/src/algebra/fortmac.spad.pamphlet +++ /dev/null @@ -1,458 +0,0 @@ -\documentclass{article} -\usepackage{open-axiom} -\begin{document} -\title{\$SPAD/src/algebra fortmac.spad} -\author{Mike Dewar} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain MINT MachineInteger} -<<domain MINT MachineInteger>>= -)abbrev domain MINT MachineInteger -++ Author: Mike Dewar -++ Date Created: December 1993 -++ Date Last Updated: -++ Basic Operations: -++ Related Domains: -++ Also See: FortranExpression, FortranMachineTypeCategory, MachineFloat, -++ MachineComplex -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: A domain which models the integer representation -++ used by machines in the AXIOM-NAG link. -MachineInteger(): Exports == Implementation where - - S ==> String - - Exports ==> Join(FortranMachineTypeCategory,IntegerNumberSystem) with - maxint : PositiveInteger -> PositiveInteger - ++ maxint(u) sets the maximum integer in the model to u - maxint : () -> PositiveInteger - ++ maxint() returns the maximum integer in the model - coerce : Expression Integer -> Expression $ - ++ coerce(x) returns x with coefficients in the domain - - Implementation ==> Integer add - - MAXINT : PositiveInteger := 2**32 - - maxint():PositiveInteger == MAXINT - - maxint(new:PositiveInteger):PositiveInteger == - old := MAXINT - MAXINT := new - old - - coerce(u:Expression Integer):Expression($) == - map(coerce,u)$ExpressionFunctions2(Integer,$) - - coerce(u:Integer):$ == - import S - abs(u) > MAXINT => - message: S := concat [string u," > MAXINT(",string MAXINT,")"] - error message - per u - - retract(u:$):Integer == rep u - - retractIfCan(u:$):Union(Integer,"failed") == rep u - -@ -\section{domain MFLOAT MachineFloat} -<<domain MFLOAT MachineFloat>>= -)abbrev domain MFLOAT MachineFloat -++ Author: Mike Dewar -++ Date Created: December 1993 -++ Date Last Updated: -++ Basic Operations: -++ Related Domains: -++ Also See: FortranExpression, FortranMachineTypeCategory, MachineInteger, -++ MachineComplex -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: A domain which models the floating point representation -++ used by machines in the AXIOM-NAG link. -MachineFloat(): Exports == Implementation where - - PI ==> PositiveInteger - NNI ==> NonNegativeInteger - F ==> Float - I ==> Integer - S ==> String - FI ==> Fraction Integer - SUP ==> SparseUnivariatePolynomial - SF ==> DoubleFloat - - Exports ==> Join(FloatingPointSystem,FortranMachineTypeCategory,Field, - RetractableTo(Float),RetractableTo(Fraction(Integer)),CharacteristicZero) with - precision : PI -> PI - ++ precision(p) sets the number of digits in the model to p - precision : () -> PI - ++ precision() returns the number of digits in the model - base : PI -> PI - ++ base(b) sets the base of the model to b - maximumExponent : I -> I - ++ maximumExponent(e) sets the maximum exponent in the model to e - maximumExponent : () -> I - ++ maximumExponent() returns the maximum exponent in the model - minimumExponent : I -> I - ++ minimumExponent(e) sets the minimum exponent in the model to e - minimumExponent : () -> I - ++ minimumExponent() returns the minimum exponent in the model - coerce : $ -> F - ++ coerce(u) transforms a MachineFloat to a standard Float - coerce : MachineInteger -> $ - ++ coerce(u) transforms a MachineInteger into a MachineFloat - mantissa : $ -> I - ++ mantissa(u) returns the mantissa of u - exponent : $ -> I - ++ exponent(u) returns the exponent of u - changeBase : (I,I,PI) -> $ - ++ changeBase(exp,man,base) \undocumented{} - - Implementation ==> add - - import F - import FI - - Rep := Record(mantissa:I,exponent:I) - - -- Parameters of the Floating Point Representation - P : PI := 16 -- Precision - B : PI := 2 -- Base - EMIN : I := -1021 -- Minimum Exponent - EMAX : I := 1024 -- Maximum Exponent - - -- Useful constants - POWER : PI := 53 -- The maximum power of B which will yield P - -- decimal digits. - MMAX : PI := B**POWER - - - -- locals - locRound:(FI)->I - checkExponent:($)->$ - normalise:($)->$ - newPower:(PI,PI)->Void - - retractIfCan(u:$):Union(FI,"failed") == - mantissa(u)*(B/1)**(exponent(u)) - - wholePart(u:$):Integer == - man:I:=mantissa u - exp:I:=exponent u - f:= - positive? exp => man*B**(exp pretend PI) - zero? exp => man - wholePart(man/B**((-exp) pretend PI)) - normalise(u:$):$ == - -- We want the largest possible mantissa, to ensure a canonical - -- representation. - exp : I := exponent u - man : I := mantissa u - BB : I := B pretend I - sgn : I := sign man ; man := abs man - zero? man => [0,0]$Rep - if man < MMAX then - while man < MMAX repeat - exp := exp - 1 - man := man * BB - if man > MMAX then - q1:FI:= man/1 - BBF:FI:=BB/1 - while wholePart(q1) > MMAX repeat - q1:= q1 / BBF - exp:=exp + 1 - man := locRound(q1) - positive?(sgn) => checkExponent [man,exp]$Rep - checkExponent [-man,exp]$Rep - - mantissa(u:$):I == elt(u,mantissa)$Rep - exponent(u:$):I == elt(u,exponent)$Rep - - newPower(base:PI,prec:PI):Void == - power : PI := 1 - target : PI := 10**prec - current : PI := base - while (current := current*base) < target repeat power := power+1 - POWER := power - MMAX := B**POWER - - changeBase(exp:I,man:I,base:PI):$ == - newExp : I := 0 - f : FI := man*(base pretend I)::FI**exp - sign : I := sign f - f : FI := abs f - newMan : I := wholePart f - zero? f => [0,0]$Rep - BB : FI := (B pretend I)::FI - if newMan < MMAX then - while newMan < MMAX repeat - newExp := newExp - 1 - f := f*BB - newMan := wholePart f - if newMan > MMAX then - while newMan > MMAX repeat - newExp := newExp + 1 - f := f/BB - newMan := wholePart f - [sign*newMan,newExp]$Rep - - checkExponent(u:$):$ == - exponent(u) < EMIN or exponent(u) > EMAX => - message :S := concat(["Exponent out of range: ", - string EMIN, "..", string EMAX])$S - error message - u - - coerce(u:$):OutputForm == - coerce(u::F) - - coerce(u:MachineInteger):$ == - checkExponent changeBase(0,retract(u)@Integer,10) - - coerce(u:$):F == - oldDigits : PI := digits(P)$F - r : F := float(mantissa u,exponent u,B)$Float - digits(oldDigits)$F - r - - coerce(u:F):$ == - checkExponent changeBase(exponent(u)$F,mantissa(u)$F,base()$F) - - coerce(u:I):$ == - checkExponent changeBase(0,u,10) - - coerce(u:FI):$ == (numer u)::$/(denom u)::$ - - retract(u:$):FI == - value : Union(FI,"failed") := retractIfCan(u) - value case "failed" => error "Cannot retract to a Fraction Integer" - value::FI - - retract(u:$):F == u::F - - retractIfCan(u:$):Union(F,"failed") == u::F::Union(F,"failed") - - retractIfCan(u:$):Union(I,"failed") == - value:FI := mantissa(u)*(B pretend I)::FI**exponent(u) - zero? fractionPart(value) => wholePart(value)::Union(I,"failed") - "failed"::Union(I,"failed") - - retract(u:$):I == - result : Union(I,"failed") := retractIfCan u - result = "failed" => error "Not an Integer" - result::I - - precision(p: PI):PI == - old : PI := P - newPower(B,p) - P := p - old - - precision():PI == P - - base(b:PI):PI == - old : PI := b - newPower(b,P) - B := b - old - - base():PI == B - - maximumExponent(u:I):I == - old : I := EMAX - EMAX := u - old - - maximumExponent():I == EMAX - - minimumExponent(u:I):I == - old : I := EMIN - EMIN := u - old - - minimumExponent():I == EMIN - - 0 == [0,0]$Rep - 1 == changeBase(0,1,10) - - zero?(u:$):Boolean == u=[0,0]$Rep - - - - f1:$ - f2:$ - - - locRound(x:FI):I == - abs(fractionPart(x)) >= 1/2 => wholePart(x)+sign(x) - wholePart(x) - - recip f1 == - zero? f1 => "failed" - normalise [ locRound(B**(2*POWER)/mantissa f1),-(exponent f1 + 2*POWER)] - - f1 * f2 == - normalise [mantissa(f1)*mantissa(f2),exponent(f1)+exponent(f2)]$Rep - - f1 **(p:FI) == - ((f1::F)**p)::% - ---inline - f1 / f2 == - zero? f2 => error "division by zero" - zero? f1 => 0 - f1=f2 => 1 - normalise [locRound(mantissa(f1)*B**(2*POWER)/mantissa(f2)), - exponent(f1)-(exponent f2 + 2*POWER)] - - inv(f1) == 1/f1 - - f1 exquo f2 == f1/f2 - - divide(f1,f2) == [ f1/f2,0] - - f1 quo f2 == f1/f2 - f1 rem f2 == 0 - u:I * f1 == - normalise [u*mantissa(f1),exponent(f1)]$Rep - - f1 = f2 == mantissa(f1)=mantissa(f2) and exponent(f1)=exponent(f2) - - f1 + f2 == - m1 : I := mantissa f1 - m2 : I := mantissa f2 - e1 : I := exponent f1 - e2 : I := exponent f2 - e1 > e2 => ---insignificance - e1 > e2 + POWER + 2 => - zero? f1 => f2 - f1 - normalise [m1*(B pretend I)**((e1-e2) pretend NNI)+m2,e2]$Rep - e2 > e1 + POWER +2 => - zero? f2 => f1 - f2 - normalise [m2*(B pretend I)**((e2-e1) pretend NNI)+m1,e1]$Rep - - - f1 == [- mantissa f1,exponent f1]$Rep - - f1 - f2 == f1 + (-f2) - - f1 < f2 == - m1 : I := mantissa f1 - m2 : I := mantissa f2 - e1 : I := exponent f1 - e2 : I := exponent f2 - sign(m1) = sign(m2) => - e1 < e2 => true - e1 = e2 and m1 < m2 => true - false - sign(m1) = 1 => false - sign(m1) = 0 and sign(m2) = -1 => false - true - - characteristic:NNI == 0 - -@ -\section{domain MCMPLX MachineComplex} -<<domain MCMPLX MachineComplex>>= -)abbrev domain MCMPLX MachineComplex -++ Date Created: December 1993 -++ Date Last Updated: -++ Basic Operations: -++ Related Domains: -++ Also See: FortranExpression, FortranMachineTypeCategory, MachineInteger, -++ MachineFloat -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: A domain which models the complex number representation -++ used by machines in the AXIOM-NAG link. -MachineComplex():Exports == Implementation where - - Exports ==> Join (FortranMachineTypeCategory, - ComplexCategory(MachineFloat)) with - coerce : Complex Float -> $ - ++ coerce(u) transforms u into a MachineComplex - coerce : Complex Integer -> $ - ++ coerce(u) transforms u into a MachineComplex - coerce : Complex MachineFloat -> $ - ++ coerce(u) transforms u into a MachineComplex - coerce : Complex MachineInteger -> $ - ++ coerce(u) transforms u into a MachineComplex - coerce : $ -> Complex Float - ++ coerce(u) transforms u into a COmplex Float - - Implementation ==> Complex MachineFloat add - - coerce(u:Complex Float):$ == - complex(real(u)::MachineFloat,imag(u)::MachineFloat) - - coerce(u:Complex Integer):$ == - complex(real(u)::MachineFloat,imag(u)::MachineFloat) - - coerce(u:Complex MachineInteger):$ == - complex(real(u)::MachineFloat,imag(u)::MachineFloat) - - coerce(u:Complex MachineFloat):$ == - complex(real(u),imag(u)) - - coerce(u:$):Complex Float == - complex(real(u)::Float,imag(u)::Float) - -@ -\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>> - -<<domain MINT MachineInteger>> -<<domain MFLOAT MachineFloat>> -<<domain MCMPLX MachineComplex>> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/fortpak.spad.pamphlet b/src/algebra/fortpak.spad.pamphlet deleted file mode 100644 index 05d33441..00000000 --- a/src/algebra/fortpak.spad.pamphlet +++ /dev/null @@ -1,641 +0,0 @@ -\documentclass{article} -\usepackage{open-axiom} -\begin{document} -\title{\$SPAD/src/algebra fortpak.spad} -\author{Grant Keady, Godfrey Nolan, Mike Dewar, Themos Tsikas} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package FCPAK1 FortranCodePackage1} -<<package FCPAK1 FortranCodePackage1>>= -)abbrev package FCPAK1 FortranCodePackage1 -++ Author: Grant Keady and Godfrey Nolan -++ Date Created: April 1993 -++ Date Last Updated: -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ \spadtype{FortranCodePackage1} provides some utilities for -++ producing useful objects in FortranCode domain. -++ The Package may be used with the FortranCode domain and its -++ \spad{printCode} or possibly via an outputAsFortran. -++ (The package provides items of use in connection with ASPs -++ in the AXIOM-NAG link and, where appropriate, naming accords -++ with that in IRENA.) -++ The easy-to-use functions use Fortran loop variables I1, I2, -++ and it is users' responsibility to check that this is sensible. -++ The advanced functions use SegmentBinding to allow users control -++ over Fortran loop variable names. --- Later might add functions to build --- diagonalMatrix from List, i.e. the FC version of the corresponding --- AXIOM function from MatrixCategory; --- bandedMatrix, i.e. the full-matrix-FC version of the corresponding --- AXIOM function in BandedMatrix Domain --- bandedSymmetricMatrix, i.e. the full-matrix-FC version of the corresponding --- AXIOM function in BandedSymmetricMatrix Domain - -FortranCodePackage1: Exports == Implementation where - - NNI ==> NonNegativeInteger - PI ==> PositiveInteger - PIN ==> Polynomial(Integer) - SBINT ==> SegmentBinding(Integer) - SEGINT ==> Segment(Integer) - LSBINT ==> List(SegmentBinding(Integer)) - SBPIN ==> SegmentBinding(Polynomial(Integer)) - SEGPIN ==> Segment(Polynomial(Integer)) - LSBPIN ==> List(SegmentBinding(Polynomial(Integer))) - FC ==> FortranCode - EXPRESSION ==> Union(Expression Integer,Expression Float,Expression Complex Integer,Expression Complex Float) - - Exports == with - - zeroVector: (Symbol,PIN) -> FC - ++ zeroVector(s,p) \undocumented{} - - zeroMatrix: (Symbol,PIN,PIN) -> FC - ++ zeroMatrix(s,p,q) uses loop variables in the Fortran, I1 and I2 - - zeroMatrix: (Symbol,SBPIN,SBPIN) -> FC - ++ zeroMatrix(s,b,d) in this version gives the user control - ++ over names of Fortran variables used in loops. - - zeroSquareMatrix: (Symbol,PIN) -> FC - ++ zeroSquareMatrix(s,p) \undocumented{} - - identitySquareMatrix: (Symbol,PIN) -> FC - ++ identitySquareMatrix(s,p) \undocumented{} - - Implementation ==> add - import FC - - zeroVector(fname:Symbol,n:PIN):FC == - ue:Expression(Integer) := 0 - i1:Symbol := "I1"::Symbol - lp1:PIN := 1::PIN - hp1:PIN := n - segp1:SEGPIN:= segment(lp1,hp1)$SEGPIN - segbp1:SBPIN := equation(i1,segp1)$SBPIN - ip1:PIN := i1::PIN - indices:List(PIN) := [ip1] - fa:FC := forLoop(segbp1,assign(fname,indices,ue)$FC)$FC - fa - - zeroMatrix(fname:Symbol,m:PIN,n:PIN):FC == - ue:Expression(Integer) := 0 - i1:Symbol := "I1"::Symbol - lp1:PIN := 1::PIN - hp1:PIN := m - segp1:SEGPIN:= segment(lp1,hp1)$SEGPIN - segbp1:SBPIN := equation(i1,segp1)$SBPIN - i2:Symbol := "I2"::Symbol - hp2:PIN := n - segp2:SEGPIN:= segment(lp1,hp2)$SEGPIN - segbp2:SBPIN := equation(i2,segp2)$SBPIN - ip1:PIN := i1::PIN - ip2:PIN := i2::PIN - indices:List(PIN) := [ip1,ip2] - fa:FC :=forLoop(segbp1,forLoop(segbp2,assign(fname,indices,ue)$FC)$FC)$FC - fa - - zeroMatrix(fname:Symbol,segbp1:SBPIN,segbp2:SBPIN):FC == - ue:Expression(Integer) := 0 - i1:Symbol := variable(segbp1)$SBPIN - i2:Symbol := variable(segbp2)$SBPIN - ip1:PIN := i1::PIN - ip2:PIN := i2::PIN - indices:List(PIN) := [ip1,ip2] - fa:FC :=forLoop(segbp1,forLoop(segbp2,assign(fname,indices,ue)$FC)$FC)$FC - fa - - zeroSquareMatrix(fname:Symbol,n:PIN):FC == - ue:Expression(Integer) := 0 - i1:Symbol := "I1"::Symbol - lp1:PIN := 1::PIN - hp1:PIN := n - segp1:SEGPIN:= segment(lp1,hp1)$SEGPIN - segbp1:SBPIN := equation(i1,segp1)$SBPIN - i2:Symbol := "I2"::Symbol - segbp2:SBPIN := equation(i2,segp1)$SBPIN - ip1:PIN := i1::PIN - ip2:PIN := i2::PIN - indices:List(PIN) := [ip1,ip2] - fa:FC :=forLoop(segbp1,forLoop(segbp2,assign(fname,indices,ue)$FC)$FC)$FC - fa - - identitySquareMatrix(fname:Symbol,n:PIN):FC == - ue:Expression(Integer) := 0 - u1:Expression(Integer) := 1 - i1:Symbol := "I1"::Symbol - lp1:PIN := 1::PIN - hp1:PIN := n - segp1:SEGPIN:= segment(lp1,hp1)$SEGPIN - segbp1:SBPIN := equation(i1,segp1)$SBPIN - i2:Symbol := "I2"::Symbol - segbp2:SBPIN := equation(i2,segp1)$SBPIN - ip1:PIN := i1::PIN - ip2:PIN := i2::PIN - indice1:List(PIN) := [ip1,ip1] - indices:List(PIN) := [ip1,ip2] - fc:FC := forLoop(segbp2,assign(fname,indices,ue)$FC)$FC - f1:FC := assign(fname,indice1,u1)$FC - fl:List(FC) := [fc,f1] - fa:FC := forLoop(segbp1,block(fl)$FC)$FC - fa - -@ -\section{package NAGSP NAGLinkSupportPackage} -<<package NAGSP NAGLinkSupportPackage>>= -)abbrev package NAGSP NAGLinkSupportPackage -++ Author: Mike Dewar and Godfrey Nolan -++ Date Created: March 1993 -++ Date Last Updated: March 4 1994 -++ October 6 1994 -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: Support functions for the NAG Library Link functions -NAGLinkSupportPackage() : exports == implementation where - - exports ==> with - fortranCompilerName : () -> String - ++ fortranCompilerName() returns the name of the currently selected - ++ Fortran compiler - fortranLinkerArgs : () -> String - ++ fortranLinkerArgs() returns the current linker arguments - aspFilename : String -> String - ++ aspFilename("f") returns a String consisting of "f" suffixed with - ++ an extension identifying the current AXIOM session. - dimensionsOf : (Symbol, Matrix DoubleFloat) -> SExpression - ++ dimensionsOf(s,m) \undocumented{} - dimensionsOf : (Symbol, Matrix Integer) -> SExpression - ++ dimensionsOf(s,m) \undocumented{} - checkPrecision : () -> Boolean - ++ checkPrecision() \undocumented{} - restorePrecision : () -> Void - ++ restorePrecision() \undocumented{} - - implementation ==> add - makeAs: (Symbol,Symbol) -> Symbol - changeVariables: (Expression Integer,Symbol) -> Expression Integer - changeVariablesF: (Expression Float,Symbol) -> Expression Float - - import String - import Symbol - - checkPrecision():Boolean == - (_$fortranPrecision$Lisp = "single"::Symbol) and (_$nagEnforceDouble$Lisp) => - systemCommand("set fortran precision double")$MoreSystemCommands - if _$nagMessages$Lisp then - print("*** Warning: Resetting fortran precision to double")$PrintPackage - true - false - - restorePrecision():Void == - systemCommand("set fortran precision single")$MoreSystemCommands - if _$nagMessages$Lisp then - print("** Warning: Restoring fortran precision to single")$PrintPackage - - uniqueId : String := "" - counter : Integer := 0 - getUniqueId():String == - if uniqueId = "" then - uniqueId := concat(getEnv("HOST")$Lisp,getEnv("SPADNUM")$Lisp) - concat(uniqueId,string (counter:=counter+1)) - - fortranCompilerName() == string _$fortranCompilerName$Lisp - fortranLinkerArgs() == string _$fortranLibraries$Lisp - - aspFilename(f:String):String == concat ["/tmp/",f,getUniqueId(),".f"] - - dimensionsOf(u:Symbol,m:Matrix DoubleFloat):SExpression == - [u,nrows m,ncols m]$Lisp - dimensionsOf(u:Symbol,m:Matrix Integer):SExpression == - [u,nrows m,ncols m]$Lisp - -@ -\section{package FORT FortranPackage} -<<package FORT FortranPackage>>= -)abbrev package FORT FortranPackage - -++ Author: Mike Dewar -++ Date Created: October 6 1991 -++ Date Last Updated: 13 July 1994 -++ Basic Operations: linkToFortran -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: provides an interface to the boot code for calling Fortran -FortranPackage(): Exports == Implementation where - FST ==> FortranScalarType - SEX ==> SExpression - L ==> List - S ==> Symbol - FOP ==> FortranOutputStackPackage - U ==> Union(array:L S,scalar:S) - - Exports ==> with - linkToFortran: (S, L U, L L U, L S) -> SEX - ++ linkToFortran(s,l,ll,lv) \undocumented{} - linkToFortran: (S, L U, L L U, L S, S) -> SEX - ++ linkToFortran(s,l,ll,lv,t) \undocumented{} - linkToFortran: (S,L S,TheSymbolTable,L S) -> SEX - ++ linkToFortran(s,l,t,lv) \undocumented{} - outputAsFortran: FileName -> Void - ++ outputAsFortran(fn) \undocumented{} - setLegalFortranSourceExtensions: List String -> List String - ++ setLegalFortranSourceExtensions(l) \undocumented{} - - Implementation ==> add - - legalFortranSourceExtensions : List String := ["f"] - - setLegalFortranSourceExtensions(l:List String):List String == - legalFortranSourceExtensions := l - - checkExtension(fn : FileName) : String == - -- Does it end in a legal extension ? - stringFn := fn::String - not member?(extension fn,legalFortranSourceExtensions) => - error [stringFn,"is not a legal Fortran Source File."] - stringFn - - outputAsFortran(fn:FileName):Void == --- source : String := checkExtension fn - source : String := fn::String - not readable? fn => - popFortranOutputStack()$FOP - error([source,"is not readable"]@List(String)) - target : String := topFortranOutputStack()$FOP - command : String := - concat(["sys rm -f ",target," ; cp ",source," ",target])$String - systemCommand(command)$MoreSystemCommands - - linkToFortran(name:S,args:L U, decls:L L U, res:L(S)):SEX == - makeFort(name,args,decls,res,NIL$Lisp,NIL$Lisp)$Lisp - - linkToFortran(name:S,args:L U, decls:L L U, res:L(S),returnType:S):SEX == - makeFort(name,args,decls,res,returnType,NIL$Lisp)$Lisp - - dimensions(type:FortranType):SEX == - convert([convert(convert(u)@InputForm)@SEX _ - for u in dimensionsOf(type)])@SEX - - ftype(name:S,type:FortranType):SEX == - [name,scalarTypeOf(type),dimensions(type),external? type]$Lisp - - makeAspList(asp:S,syms:TheSymbolTable):SExpression== - symtab : SymbolTable := symbolTableOf(asp,syms) - [asp,returnTypeOf(asp,syms),argumentListOf(asp,syms), _ - [ftype(u,fortranTypeOf(u,symtab)) for u in parametersOf symtab]]$Lisp - - linkToFortran(name:S,aArgs:L S,syms:TheSymbolTable,res:L S):SEX == - arguments : L S := argumentListOf(name,syms)$TheSymbolTable - dummies : L S := setDifference(arguments,aArgs) - symbolTable:SymbolTable := symbolTableOf(name,syms) - symbolList := newTypeLists(symbolTable) - rt:Union(fst: FST,void: "void") := returnTypeOf(name,syms)$TheSymbolTable - - -- Look for arguments which are subprograms - asps :=[makeAspList(u,syms) for u in externalList(symbolTable)$SymbolTable] - rt case fst => - makeFort1(name,arguments,aArgs,dummies,symbolList,res,(rt.fst)::S,asps)$Lisp - makeFort1(name,arguments,aArgs,dummies,symbolList,res,NIL$Lisp,asps)$Lisp - -@ -\section{package FOP FortranOutputStackPackage} -<<package FOP FortranOutputStackPackage>>= -)abbrev package FOP FortranOutputStackPackage - -++ Author: Mike Dewar -++ Date Created: October 1992 -++ Date Last Updated: -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: Code to manipulate Fortran Output Stack -FortranOutputStackPackage() : specification == implementation where - - specification == with - - clearFortranOutputStack : () -> Stack String - ++ clearFortranOutputStack() clears the Fortran output stack - showFortranOutputStack : () -> Stack String - ++ showFortranOutputStack() returns the Fortran output stack - popFortranOutputStack : () -> Void - ++ popFortranOutputStack() pops the Fortran output stack - pushFortranOutputStack : FileName -> Void - ++ pushFortranOutputStack(f) pushes f onto the Fortran output stack - pushFortranOutputStack : String -> Void - ++ pushFortranOutputStack(f) pushes f onto the Fortran output stack - topFortranOutputStack : () -> String - ++ topFortranOutputStack() returns the top element of the Fortran - ++ output stack - - implementation == add - - import MoreSystemCommands - - -- A stack of filenames for Fortran output. We are sharing this with - -- the standard Fortran output code, so want to be a bit careful about - -- how we interact with what the user does independently. We get round - -- potential problems by always examining the top element of the stack - -- before we push. If the user has redirected output then we alter our - -- top value accordingly. - fortranOutputStack : Stack String := empty()@(Stack String) - - topFortranOutputStack():String == string(_$fortranOutputFile$Lisp) - - pushFortranOutputStack(fn:FileName):Void == - if empty? fortranOutputStack then - push!(string(_$fortranOutputFile$Lisp),fortranOutputStack) - else if not(top(fortranOutputStack)=string(_$fortranOutputFile$Lisp)) then - pop! fortranOutputStack - push!(string(_$fortranOutputFile$Lisp),fortranOutputStack) - push!( fn::String,fortranOutputStack) - systemCommand concat(["set output fortran quiet ", fn::String])$String - - pushFortranOutputStack(fn:String):Void == - if empty? fortranOutputStack then - push!(string(_$fortranOutputFile$Lisp),fortranOutputStack) - else if not(top(fortranOutputStack)=string(_$fortranOutputFile$Lisp)) then - pop! fortranOutputStack - push!(string(_$fortranOutputFile$Lisp),fortranOutputStack) - push!( fn,fortranOutputStack) - systemCommand concat(["set output fortran quiet ", fn])$String - - popFortranOutputStack():Void == - if not empty? fortranOutputStack then pop! fortranOutputStack - if empty? fortranOutputStack then push!("CONSOLE",fortranOutputStack) - systemCommand concat(["set output fortran quiet append ",_ - top fortranOutputStack])$String - - clearFortranOutputStack():Stack String == - fortranOutputStack := empty()@(Stack String) - - showFortranOutputStack():Stack String == - fortranOutputStack - -@ -\section{package TEMUTL TemplateUtilities} -<<package TEMUTL TemplateUtilities>>= -)abbrev package TEMUTL TemplateUtilities -++ Author: Mike Dewar -++ Date Created: October 1992 -++ Date Last Updated: -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: This package provides functions for template manipulation -TemplateUtilities(): Exports == Implementation where - - Exports == with - interpretString : String -> Any - ++ interpretString(s) treats a string as a piece of AXIOM input, by - ++ parsing and interpreting it. - stripCommentsAndBlanks : String -> String - ++ stripCommentsAndBlanks(s) treats s as a piece of AXIOM input, and - ++ removes comments, and leading and trailing blanks. - - Implementation == add - - import InputForm - - stripC(s:String,u:String):String == - i : Integer := position(u,s,1) - i = 0 => s - delete(s,i..) - - stripCommentsAndBlanks(s:String):String == - trim(stripC(stripC(s,"++"),"--"),char " ") - - parse(s:String):InputForm == - ncParseFromString(s)$Lisp::InputForm - - interpretString(s:String):Any == - interpret parse s - -@ -\section{package MCALCFN MultiVariableCalculusFunctions} -<<package MCALCFN MultiVariableCalculusFunctions>>= -)abbrev package MCALCFN MultiVariableCalculusFunctions -++ Author: Themos Tsikas, Grant Keady -++ Date Created: December 1992 -++ Date Last Updated: June 1993 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ \spadtype{MultiVariableCalculusFunctions} Package provides several -++ functions for multivariable calculus. -++ These include gradient, hessian and jacobian, -++ divergence and laplacian. -++ Various forms for banded and sparse storage of matrices are -++ included. -MultiVariableCalculusFunctions(S,F,FLAF,FLAS) : Exports == Implementation where - PI ==> PositiveInteger - NNI ==> NonNegativeInteger - - S: SetCategory - F: PartialDifferentialRing(S) - FLAS: FiniteLinearAggregate(S) - with finiteAggregate - FLAF: FiniteLinearAggregate(F) - - Exports ==> with - gradient: (F,FLAS) -> Vector F - ++ \spad{gradient(v,xlist)} - ++ computes the gradient, the vector of first partial derivatives, - ++ of the scalar field v, - ++ v a function of the variables listed in xlist. - divergence: (FLAF,FLAS) -> F - ++ \spad{divergence(vf,xlist)} - ++ computes the divergence of the vector field vf, - ++ vf a vector function of the variables listed in xlist. - laplacian: (F,FLAS) -> F - ++ \spad{laplacian(v,xlist)} - ++ computes the laplacian of the scalar field v, - ++ v a function of the variables listed in xlist. - hessian: (F,FLAS) -> Matrix F - ++ \spad{hessian(v,xlist)} - ++ computes the hessian, the matrix of second partial derivatives, - ++ of the scalar field v, - ++ v a function of the variables listed in xlist. - bandedHessian: (F,FLAS,NNI) -> Matrix F - ++ \spad{bandedHessian(v,xlist,k)} - ++ computes the hessian, the matrix of second partial derivatives, - ++ of the scalar field v, - ++ v a function of the variables listed in xlist, - ++ k is the semi-bandwidth, the number of nonzero subdiagonals, - ++ 2*k+1 being actual bandwidth. - ++ Stores the nonzero band in lower triangle in a matrix, - ++ dimensions k+1 by #xlist, - ++ whose rows are the vectors formed by diagonal, subdiagonal, etc. - ++ of the real, full-matrix, hessian. - ++ (The notation conforms to LAPACK/NAG-F07 conventions.) - -- At one stage it seemed a good idea to help the ASP<n> domains - -- with the types of their input arguments and this led to the - -- standard Gradient|Hessian|Jacobian functions. - --standardJacobian: (Vector(F),List(S)) -> Matrix F - -- ++ \spad{jacobian(vf,xlist)} - -- ++ computes the jacobian, the matrix of first partial derivatives, - -- ++ of the vector field vf, - -- ++ vf a vector function of the variables listed in xlist. - jacobian: (FLAF,FLAS) -> Matrix F - ++ \spad{jacobian(vf,xlist)} - ++ computes the jacobian, the matrix of first partial derivatives, - ++ of the vector field vf, - ++ vf a vector function of the variables listed in xlist. - bandedJacobian: (FLAF,FLAS,NNI,NNI) -> Matrix F - ++ \spad{bandedJacobian(vf,xlist,kl,ku)} - ++ computes the jacobian, the matrix of first partial derivatives, - ++ of the vector field vf, - ++ vf a vector function of the variables listed in xlist, - ++ kl is the number of nonzero subdiagonals, - ++ ku is the number of nonzero superdiagonals, - ++ kl+ku+1 being actual bandwidth. - ++ Stores the nonzero band in a matrix, - ++ dimensions kl+ku+1 by #xlist. - ++ The upper triangle is in the top ku rows, - ++ the diagonal is in row ku+1, - ++ the lower triangle in the last kl rows. - ++ Entries in a column in the band store correspond to entries - ++ in same column of full store. - ++ (The notation conforms to LAPACK/NAG-F07 conventions.) - - Implementation ==> add - localGradient(v:F,xlist:List(S)):Vector(F) == - vector([D(v,x) for x in xlist]) - gradient(v,xflas) == - --xlist:List(S) := [xflas(i) for i in 1 .. maxIndex(xflas)] - xlist:List(S) := parts(xflas) - localGradient(v,xlist) - localDivergence(vf:Vector(F),xlist:List(S)):F == - n: NNI - ans: F - -- Perhaps should report error if two args of min different - n:= min(#(xlist),((maxIndex(vf))::NNI))$NNI - ans:= 0 - for i in 1 .. n repeat ans := ans + D(vf(i),xlist(i)) - ans - divergence(vf,xflas) == - xlist:List(S) := parts(xflas) - n: NNI - ans: F - -- Perhaps should report error if two args of min different - n:= min(#(xlist),((maxIndex(vf))::NNI))$NNI - ans:= 0 - for i in 1 .. n repeat ans := ans + D(vf(i),xlist(i)) - ans - laplacian(v,xflas) == - xlist:List(S) := parts(xflas) - gv:Vector(F) := localGradient(v,xlist) - localDivergence(gv,xlist) - hessian(v,xflas) == - xlist:List(S) := parts(xflas) - matrix([[D(v,[x,y]) for x in xlist] for y in xlist]) - --standardJacobian(vf,xlist) == - -- i: PI - -- matrix([[D(vf(i),x) for x in xlist] for i in 1 .. maxIndex(vf)]) - jacobian(vf,xflas) == - xlist:List(S) := parts(xflas) - matrix([[D(vf(i),x) for x in xlist] for i in 1 .. maxIndex(vf)]) - bandedHessian(v,xflas,k) == - xlist:List(S) := parts(xflas) - n: NNI - bandM: Matrix F - n:= #(xlist) - bandM:= new(k+1,n,0) - for j in 1 .. n repeat setelt(bandM,1,j,D(v,xlist(j),2)) - for iw in 2 .. (k+1) repeat (_ - for j in 1 .. (n-iw+1) repeat (_ - setelt(bandM,iw,j,D(v,[xlist(j),xlist(j+iw-1)])) ) ) - bandM - bandedJacobian(vf,xflas,kl,ku) == - xlist:List(S) := parts(xflas) - n: NNI - bandM: Matrix F - n:= #(xlist) - bandM:= new(kl+ku+1,n,0) - for j in 1 .. n repeat setelt(bandM,ku+1,j,D(vf(j),xlist(j))) - for iw in (ku+2) .. (ku+kl+1) repeat (_ - for j in 1 .. (n-iw+ku+1) repeat (_ - setelt(bandM,iw,j,D(vf(j+iw-1-ku),xlist(j))) ) ) - for iw in 1 .. ku repeat (_ - for j in (ku+2-iw) .. n repeat (_ - setelt(bandM,iw,j,D(vf(j+iw-1-ku),xlist(j))) ) ) - bandM - -@ -\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>> - -<<package FCPAK1 FortranCodePackage1>> -<<package NAGSP NAGLinkSupportPackage>> -<<package FORT FortranPackage>> -<<package FOP FortranOutputStackPackage>> -<<package TEMUTL TemplateUtilities>> -<<package MCALCFN MultiVariableCalculusFunctions>> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/fortran.spad.pamphlet b/src/algebra/fortran.spad.pamphlet deleted file mode 100644 index 050960e0..00000000 --- a/src/algebra/fortran.spad.pamphlet +++ /dev/null @@ -1,1784 +0,0 @@ -\documentclass{article} -\usepackage{open-axiom} -\begin{document} -\title{src/algebra fortran.spad} -\author{Didier Pinchon, Mike Dewar, William Naylor} -\maketitle - -\begin{abstract} -\end{abstract} -\tableofcontents -\eject - -\section{domain RESULT Result} - -<<domain RESULT Result>>= -import Boolean -import Symbol -import OutputForm -import Any -import TableAggregate -)abbrev domain RESULT Result -++ Author: Didier Pinchon and Mike Dewar -++ Date Created: 8 April 1994 -++ Date Last Updated: 28 June 1994 -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: A domain used to return the results from a call to the NAG -++ Library. It prints as a list of names and types, though the user may -++ choose to display values automatically if he or she wishes. -Result():Exports==Implementation where - - O ==> OutputForm - - Exports ==> TableAggregate(Symbol,Any) with - showScalarValues : Boolean -> Boolean - ++ showScalarValues(true) forces the values of scalar components to be - ++ displayed rather than just their types. - showArrayValues : Boolean -> Boolean - ++ showArrayValues(true) forces the values of array components to be - ++ displayed rather than just their types. - finiteAggregate - - Implementation ==> Table(Symbol,Any) add - import SExpression - - -- Constant - colon := ": "::Symbol::O - elide := "..."::Symbol::O - - -- Flags - showScalarValuesFlag : Boolean := false - showArrayValuesFlag : Boolean := false - - cleanUpDomainForm(d:SExpression):O == - not list? d => d::O - #d=1 => (car d)::O - -- If the car is an atom then we have a domain constructor, if not - -- then we have some kind of value. Since we often can't print these - -- ****ers we just elide them. - not atom? car d => elide - prefix((car d)::O,[cleanUpDomainForm(u) for u in destruct cdr(d)]$List(O)) - - display(v:Any,d:SExpression):O == - not list? d => error "Domain form is non-list" - #d=1 => - showScalarValuesFlag => v::OutputForm - cleanUpDomainForm d - car(d) = convert("Complex"::Symbol)@SExpression => - showScalarValuesFlag => v::OutputForm - cleanUpDomainForm d - showArrayValuesFlag => v::OutputForm - cleanUpDomainForm d - - makeEntry(k:Symbol,v:Any):O == - hconcat [k::O,colon,display(v,dom v)] - - coerce(r:%):O == - bracket [makeEntry(key,r.key) for key in reverse! keys(r)] - - showArrayValues(b:Boolean):Boolean == showArrayValuesFlag := b - showScalarValues(b:Boolean):Boolean == showScalarValuesFlag := b - -@ - -\section{domain FC FortranCode} - -<<domain FC FortranCode>>= -import Void -import List -import Fraction -)abbrev domain FC FortranCode --- The FortranCode domain is used to represent operations which are to be --- translated into FORTRAN. -++ Author: Mike Dewar -++ Date Created: April 1991 -++ Date Last Updated: 22 March 1994 -++ 26 May 1994 Added common, MCD -++ 21 June 1994 Changed print to printStatement, MCD -++ 30 June 1994 Added stop, MCD -++ 12 July 1994 Added assign for String, MCD -++ 9 January 1995 Added fortran2Lines to getCall, MCD -++ Basic Operations: -++ Related Constructors: FortranProgram, Switch, FortranType -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This domain builds representations of program code segments for use with -++ the FortranProgram domain. -FortranCode(): public == private where - L ==> List - PI ==> PositiveInteger - PIN ==> Polynomial Integer - SEX ==> SExpression - O ==> OutputForm - OP ==> Union(Null:"null", - Assignment:"assignment", - Conditional:"conditional", - Return:"return", - Block:"block", - Comment:"comment", - Call:"call", - For:"for", - While:"while", - Repeat:"repeat", - Goto:"goto", - Continue:"continue", - ArrayAssignment:"arrayAssignment", - Save:"save", - Stop:"stop", - Common:"common", - Print:"print") - ARRAYASS ==> Record(var:Symbol, rand:O, ints2Floats?:Boolean) - EXPRESSION ==> Record(ints2Floats?:Boolean,expr:O) - ASS ==> Record(var:Symbol, - arrayIndex:L PIN, - rand:EXPRESSION - ) - COND ==> Record(switch: Switch(), - thenClause: $, - elseClause: $ - ) - RETURN ==> Record(empty?:Boolean,value:EXPRESSION) - BLOCK ==> List $ - COMMENT ==> List String - COMMON ==> Record(name:Symbol,contents:List Symbol) - CALL ==> String - FOR ==> Record(range:SegmentBinding PIN, span:PIN, body:$) - LABEL ==> SingleInteger - LOOP ==> Record(switch:Switch(),body:$) - PRINTLIST ==> List O - OPREC ==> Union(nullBranch:"null", assignmentBranch:ASS, - arrayAssignmentBranch:ARRAYASS, - conditionalBranch:COND, returnBranch:RETURN, - blockBranch:BLOCK, commentBranch:COMMENT, callBranch:CALL, - forBranch:FOR, labelBranch:LABEL, loopBranch:LOOP, - commonBranch:COMMON, printBranch:PRINTLIST) - - public == SetCategory with - forLoop: (SegmentBinding PIN,$) -> $ - ++ forLoop(i=1..10,c) creates a representation of a FORTRAN DO loop with - ++ \spad{i} ranging over the values 1 to 10. - forLoop: (SegmentBinding PIN,PIN,$) -> $ - ++ forLoop(i=1..10,n,c) creates a representation of a FORTRAN DO loop with - ++ \spad{i} ranging over the values 1 to 10 by n. - whileLoop: (Switch,$) -> $ - ++ whileLoop(s,c) creates a while loop in FORTRAN. - repeatUntilLoop: (Switch,$) -> $ - ++ repeatUntilLoop(s,c) creates a repeat ... until loop in FORTRAN. - goto: SingleInteger -> $ - ++ goto(l) creates a representation of a FORTRAN GOTO statement - continue: SingleInteger -> $ - ++ continue(l) creates a representation of a FORTRAN CONTINUE labelled - ++ with l - comment: String -> $ - ++ comment(s) creates a representation of the String s as a single FORTRAN - ++ comment. - comment: List String -> $ - ++ comment(s) creates a representation of the Strings s as a multi-line - ++ FORTRAN comment. - call: String -> $ - ++ call(s) creates a representation of a FORTRAN CALL statement - returns: () -> $ - ++ returns() creates a representation of a FORTRAN RETURN statement. - returns: Expression MachineFloat -> $ - ++ returns(e) creates a representation of a FORTRAN RETURN statement - ++ with a returned value. - returns: Expression MachineInteger -> $ - ++ returns(e) creates a representation of a FORTRAN RETURN statement - ++ with a returned value. - returns: Expression MachineComplex -> $ - ++ returns(e) creates a representation of a FORTRAN RETURN statement - ++ with a returned value. - returns: Expression Float -> $ - ++ returns(e) creates a representation of a FORTRAN RETURN statement - ++ with a returned value. - returns: Expression Integer -> $ - ++ returns(e) creates a representation of a FORTRAN RETURN statement - ++ with a returned value. - returns: Expression Complex Float -> $ - ++ returns(e) creates a representation of a FORTRAN RETURN statement - ++ with a returned value. - cond: (Switch,$) -> $ - ++ cond(s,e) creates a representation of the FORTRAN expression - ++ IF (s) THEN e. - cond: (Switch,$,$) -> $ - ++ cond(s,e,f) creates a representation of the FORTRAN expression - ++ IF (s) THEN e ELSE f. - assign: (Symbol,String) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Expression MachineInteger) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Expression MachineFloat) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Expression MachineComplex) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Matrix MachineInteger) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Matrix MachineFloat) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Matrix MachineComplex) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Vector MachineInteger) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Vector MachineFloat) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Vector MachineComplex) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Matrix Expression MachineInteger) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Matrix Expression MachineFloat) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Matrix Expression MachineComplex) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Vector Expression MachineInteger) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Vector Expression MachineFloat) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Vector Expression MachineComplex) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,L PIN,Expression MachineInteger) -> $ - ++ assign(x,l,y) creates a representation of the assignment of \spad{y} - ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of - ++ indices). - assign: (Symbol,L PIN,Expression MachineFloat) -> $ - ++ assign(x,l,y) creates a representation of the assignment of \spad{y} - ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of - ++ indices). - assign: (Symbol,L PIN,Expression MachineComplex) -> $ - ++ assign(x,l,y) creates a representation of the assignment of \spad{y} - ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of - ++ indices). - assign: (Symbol,Expression Integer) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Expression Float) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Expression Complex Float) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Matrix Expression Integer) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Matrix Expression Float) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Matrix Expression Complex Float) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Vector Expression Integer) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Vector Expression Float) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Vector Expression Complex Float) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,L PIN,Expression Integer) -> $ - ++ assign(x,l,y) creates a representation of the assignment of \spad{y} - ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of - ++ indices). - assign: (Symbol,L PIN,Expression Float) -> $ - ++ assign(x,l,y) creates a representation of the assignment of \spad{y} - ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of - ++ indices). - assign: (Symbol,L PIN,Expression Complex Float) -> $ - ++ assign(x,l,y) creates a representation of the assignment of \spad{y} - ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of - ++ indices). - block: List($) -> $ - ++ block(l) creates a representation of the statements in l as a block. - stop: () -> $ - ++ stop() creates a representation of a STOP statement. - save: () -> $ - ++ save() creates a representation of a SAVE statement. - printStatement: List O -> $ - ++ printStatement(l) creates a representation of a PRINT statement. - common: (Symbol,List Symbol) -> $ - ++ common(name,contents) creates a representation a named common block. - operation: $ -> OP - ++ operation(f) returns the name of the operation represented by \spad{f}. - code: $ -> OPREC - ++ code(f) returns the internal representation of the object represented - ++ by \spad{f}. - printCode: $ -> Void - ++ printCode(f) prints out \spad{f} in FORTRAN notation. - getCode: $ -> SEX - ++ getCode(f) returns a Lisp list of strings representing \spad{f} - ++ in Fortran notation. This is used by the FortranProgram domain. - setLabelValue:SingleInteger -> SingleInteger - ++ setLabelValue(i) resets the counter which produces labels to i - - private == add - import Void - import ASS - import COND - import RETURN - import L PIN - import O - import SEX - import FortranType - import TheSymbolTable - - Rep := Record(op: OP, data: OPREC) - - -- We need to be able to generate unique labels - labelValue:SingleInteger := 25000::SingleInteger - setLabelValue(u:SingleInteger):SingleInteger == labelValue := u - newLabel():SingleInteger == - labelValue := labelValue + 1$SingleInteger - labelValue - - commaSep(l:List String):List(String) == - [(l.1),:[:[",",u] for u in rest(l)]] - - getReturn(rec:RETURN):SEX == - returnToken : SEX := convert("RETURN"::Symbol::O)$SEX - elt(rec,empty?)$RETURN => - getStatement(returnToken,NIL$Lisp)$Lisp - rt : EXPRESSION := elt(rec,value)$RETURN - rv : O := elt(rt,expr)$EXPRESSION - getStatement([returnToken,convert(rv)$SEX]$Lisp, - elt(rt,ints2Floats?)$EXPRESSION )$Lisp - - getStop():SEX == - fortran2Lines(LIST("STOP")$Lisp)$Lisp - - getSave():SEX == - fortran2Lines(LIST("SAVE")$Lisp)$Lisp - - getCommon(u:COMMON):SEX == - fortran2Lines(APPEND(LIST("COMMON"," /",string (u.name),"/ ")$Lisp,_ - addCommas(u.contents)$Lisp)$Lisp)$Lisp - - getPrint(l:PRINTLIST):SEX == - ll : SEX := LIST("PRINT*")$Lisp - for i in l repeat - ll := APPEND(ll,CONS(",",expression2Fortran(i)$Lisp)$Lisp)$Lisp - fortran2Lines(ll)$Lisp - - getBlock(rec:BLOCK):SEX == - indentFortLevel(convert(1@Integer)$SEX)$Lisp - expr : SEX := LIST()$Lisp - for u in rec repeat - expr := APPEND(expr,getCode(u))$Lisp - indentFortLevel(convert(-1@Integer)$SEX)$Lisp - expr - - getBody(f:$):SEX == - operation(f) case Block => getCode f - indentFortLevel(convert(1@Integer)$SEX)$Lisp - expr := getCode f - indentFortLevel(convert(-1@Integer)$SEX)$Lisp - expr - - getElseIf(f:$):SEX == - rec := code f - expr := - fortFormatElseIf(elt(rec.conditionalBranch,switch)$COND::O)$Lisp - expr := - APPEND(expr,getBody elt(rec.conditionalBranch,thenClause)$COND)$Lisp - elseBranch := elt(rec.conditionalBranch,elseClause)$COND - not(operation(elseBranch) case Null) => - operation(elseBranch) case Conditional => - APPEND(expr,getElseIf elseBranch)$Lisp - expr := APPEND(expr, getStatement(ELSE::O,NIL$Lisp)$Lisp)$Lisp - expr := APPEND(expr, getBody elseBranch)$Lisp - expr - - getContinue(label:SingleInteger):SEX == - lab : O := label::O - if (width(lab) > 6) then error "Label too big" - cnt : O := "CONTINUE"::O - --sp : O := hspace(6-width lab) - sp : O := hspace(_$fortIndent$Lisp -width lab) - LIST(STRCONC(string(label)$String,sp,cnt)$Lisp)$Lisp - - getGoto(label:SingleInteger):SEX == - fortran2Lines( - LIST(STRCONC("GOTO ",string(label)$String)$Lisp)$Lisp)$Lisp - - getRepeat(repRec:LOOP):SEX == - sw : Switch := NOT elt(repRec,switch)$LOOP - lab := newLabel() - bod := elt(repRec,body)$LOOP - APPEND(getContinue lab,getBody bod, - fortFormatIfGoto(sw::O,lab)$Lisp)$Lisp - - getWhile(whileRec:LOOP):SEX == - sw := NOT elt(whileRec,switch)$LOOP - lab1 := newLabel() - lab2 := newLabel() - bod := elt(whileRec,body)$LOOP - APPEND(fortFormatLabelledIfGoto(sw::O,lab1,lab2)$Lisp, - getBody bod, getBody goto(lab1), getContinue lab2)$Lisp - - getArrayAssign(rec:ARRAYASS):SEX == - getfortarrayexp((rec.var)::O,rec.rand,rec.ints2Floats?)$Lisp - - getAssign(rec:ASS):SEX == - indices : L PIN := elt(rec,arrayIndex)$ASS - if indices = []::(L PIN) then - lhs := elt(rec,var)$ASS::O - else - lhs := cons(elt(rec,var)$ASS::PIN,indices)::O - -- Must get the index brackets correct: - lhs := (cdr car cdr convert(lhs)$SEX::SEX)::O -- Yuck! - elt(elt(rec,rand)$ASS,ints2Floats?)$EXPRESSION => - assignment2Fortran1(lhs,elt(elt(rec,rand)$ASS,expr)$EXPRESSION)$Lisp - integerAssignment2Fortran1(lhs,elt(elt(rec,rand)$ASS,expr)$EXPRESSION)$Lisp - - getCond(rec:COND):SEX == - expr := APPEND(fortFormatIf(elt(rec,switch)$COND::O)$Lisp, - getBody elt(rec,thenClause)$COND)$Lisp - elseBranch := elt(rec,elseClause)$COND - if not(operation(elseBranch) case Null) then - operation(elseBranch) case Conditional => - expr := APPEND(expr,getElseIf elseBranch)$Lisp - expr := APPEND(expr,getStatement(ELSE::O,NIL$Lisp)$Lisp, - getBody elseBranch)$Lisp - APPEND(expr,getStatement(ENDIF::O,NIL$Lisp)$Lisp)$Lisp - - getComment(rec:COMMENT):SEX == - convert([convert(concat("C ",c)$String)@SEX for c in rec])@SEX - - getCall(rec:CALL):SEX == - expr := concat("CALL ",rec)$String - #expr > 1320 => error "Fortran CALL too large" - fortran2Lines(convert([convert(expr)@SEX ])@SEX)$Lisp - - getFor(rec:FOR):SEX == - rnge : SegmentBinding PIN := elt(rec,range)$FOR - increment : PIN := elt(rec,span)$FOR - lab : SingleInteger := newLabel() - declare!(variable rnge,fortranInteger()) - expr := fortFormatDo(variable rnge, (lo segment rnge)::O,_ - (hi segment rnge)::O,increment::O,lab)$Lisp - APPEND(expr, getBody elt(rec,body)$FOR, getContinue(lab))$Lisp - - getCode(f:$):SEX == - opp:OP := operation f - rec:OPREC:= code f - opp case Assignment => getAssign(rec.assignmentBranch) - opp case ArrayAssignment => getArrayAssign(rec.arrayAssignmentBranch) - opp case Conditional => getCond(rec.conditionalBranch) - opp case Return => getReturn(rec.returnBranch) - opp case Block => getBlock(rec.blockBranch) - opp case Comment => getComment(rec.commentBranch) - opp case Call => getCall(rec.callBranch) - opp case For => getFor(rec.forBranch) - opp case Continue => getContinue(rec.labelBranch) - opp case Goto => getGoto(rec.labelBranch) - opp case Repeat => getRepeat(rec.loopBranch) - opp case While => getWhile(rec.loopBranch) - opp case Save => getSave() - opp case Stop => getStop() - opp case Print => getPrint(rec.printBranch) - opp case Common => getCommon(rec.commonBranch) - error "Unsupported program construct." - convert(0)@SEX - - printCode(f:$):Void == - displayLines1$Lisp getCode f - - code (f:$):OPREC == - elt(f,data)$Rep - - operation (f:$):OP == - elt(f,op)$Rep - - common(name':Symbol,contents':List Symbol):$ == - [["common"]$OP,[[name',contents']$COMMON]$OPREC]$Rep - - stop():$ == - [["stop"]$OP,["null"]$OPREC]$Rep - - save():$ == - [["save"]$OP,["null"]$OPREC]$Rep - - printStatement(l:List O):$ == - [["print"]$OP,[l]$OPREC]$Rep - - comment(s:List String):$ == - [["comment"]$OP,[s]$OPREC]$Rep - - comment(s:String):$ == - [["comment"]$OP,[list s]$OPREC]$Rep - - forLoop(r:SegmentBinding PIN,body':$):$ == - [["for"]$OP,[[r,(incr segment r)::PIN,body']$FOR]$OPREC]$Rep - - forLoop(r:SegmentBinding PIN,increment:PIN,body':$):$ == - [["for"]$OP,[[r,increment,body']$FOR]$OPREC]$Rep - - goto(l:SingleInteger):$ == - [["goto"]$OP,[l]$OPREC]$Rep - - continue(l:SingleInteger):$ == - [["continue"]$OP,[l]$OPREC]$Rep - - whileLoop(sw:Switch,b:$):$ == - [["while"]$OP,[[sw,b]$LOOP]$OPREC]$Rep - - repeatUntilLoop(sw:Switch,b:$):$ == - [["repeat"]$OP,[[sw,b]$LOOP]$OPREC]$Rep - - returns():$ == - v := [false,0::O]$EXPRESSION - [["return"]$OP,[[true,v]$RETURN]$OPREC]$Rep - - returns(v:Expression MachineInteger):$ == - [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep - - returns(v:Expression MachineFloat):$ == - [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep - - returns(v:Expression MachineComplex):$ == - [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep - - returns(v:Expression Integer):$ == - [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep - - returns(v:Expression Float):$ == - [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep - - returns(v:Expression Complex Float):$ == - [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep - - block(l:List $):$ == - [["block"]$OP,[l]$OPREC]$Rep - - cond(sw:Switch,thenC:$):$ == - [["conditional"]$OP, - [[sw,thenC,[["null"]$OP,["null"]$OPREC]$Rep]$COND]$OPREC]$Rep - - cond(sw:Switch,thenC:$,elseC:$):$ == - [["conditional"]$OP,[[sw,thenC,elseC]$COND]$OPREC]$Rep - - coerce(f : $):O == - (f.op)::O - - assign(v:Symbol,rhs:String):$ == - [["assignment"]$OP,[[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Matrix MachineInteger):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Matrix MachineFloat):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Matrix MachineComplex):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Vector MachineInteger):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Vector MachineFloat):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Vector MachineComplex):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Matrix Expression MachineInteger):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Matrix Expression MachineFloat):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Matrix Expression MachineComplex):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Vector Expression MachineInteger):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Vector Expression MachineFloat):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Vector Expression MachineComplex):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,index:L PIN,rhs:Expression MachineInteger):$ == - [["assignment"]$OP,[[v,index,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,index:L PIN,rhs:Expression MachineFloat):$ == - [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,index:L PIN,rhs:Expression MachineComplex):$ == - [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Expression MachineInteger):$ == - [["assignment"]$OP,[[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Expression MachineFloat):$ == - [["assignment"]$OP,[[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Expression MachineComplex):$ == - [["assignment"]$OP,[[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Matrix Expression Integer):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Matrix Expression Float):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Matrix Expression Complex Float):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Vector Expression Integer):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Vector Expression Float):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Vector Expression Complex Float):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,index:L PIN,rhs:Expression Integer):$ == - [["assignment"]$OP,[[v,index,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,index:L PIN,rhs:Expression Float):$ == - [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,index:L PIN,rhs:Expression Complex Float):$ == - [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Expression Integer):$ == - [["assignment"]$OP,[[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Expression Float):$ == - [["assignment"]$OP,[[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Expression Complex Float):$ == - [["assignment"]$OP,[[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - call(s:String):$ == - [["call"]$OP,[s]$OPREC]$Rep - -@ -\section{domain FORTRAN FortranProgram} -<<domain FORTRAN FortranProgram>>= -)abbrev domain FORTRAN FortranProgram -++ Author: Mike Dewar -++ Date Created: October 1992 -++ Date Last Updated: 13 January 1994 -++ 23 January 1995 Added support for intrinsic functions -++ Basic Operations: -++ Related Constructors: FortranType, FortranCode, Switch -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: \axiomType{FortranProgram} allows the user to build and manipulate simple -++ models of FORTRAN subprograms. These can then be transformed into actual FORTRAN -++ notation. -FortranProgram(name,returnType,arguments,symbols): Exports == Implement where - name : Symbol - returnType : Union(fst:FortranScalarType,void:"void") - arguments : List Symbol - symbols : SymbolTable - - FC ==> FortranCode - EXPR ==> Expression - INT ==> Integer - CMPX ==> Complex - MINT ==> MachineInteger - MFLOAT ==> MachineFloat - MCMPLX ==> MachineComplex - REP ==> Record(localSymbols : SymbolTable, code : List FortranCode) - - Exports ==> FortranProgramCategory with - coerce : FortranCode -> $ - ++ coerce(fc) \undocumented{} - coerce : List FortranCode -> $ - ++ coerce(lfc) \undocumented{} - coerce : REP -> $ - ++ coerce(r) \undocumented{} - coerce : EXPR MINT -> $ - ++ coerce(e) \undocumented{} - coerce : EXPR MFLOAT -> $ - ++ coerce(e) \undocumented{} - coerce : EXPR MCMPLX -> $ - ++ coerce(e) \undocumented{} - coerce : Equation EXPR MINT -> $ - ++ coerce(eq) \undocumented{} - coerce : Equation EXPR MFLOAT -> $ - ++ coerce(eq) \undocumented{} - coerce : Equation EXPR MCMPLX -> $ - ++ coerce(eq) \undocumented{} - coerce : EXPR INT -> $ - ++ coerce(e) \undocumented{} - coerce : EXPR Float -> $ - ++ coerce(e) \undocumented{} - coerce : EXPR CMPX Float -> $ - ++ coerce(e) \undocumented{} - coerce : Equation EXPR INT -> $ - ++ coerce(eq) \undocumented{} - coerce : Equation EXPR Float -> $ - ++ coerce(eq) \undocumented{} - coerce : Equation EXPR CMPX Float -> $ - ++ coerce(eq) \undocumented{} - - Implement ==> add - - Rep := REP - - import SExpression - import TheSymbolTable - import FortranCode - - makeRep(b:List FortranCode):$ == - construct(empty()$SymbolTable,b)$REP - - codeFrom(u:$):List FortranCode == - elt(u::Rep,code)$REP - - outputAsFortran(p:$):Void == - setLabelValue(25000::SingleInteger)$FC - -- Do this first to catch any extra type declarations: - tempName := "FPTEMP"::Symbol - newSubProgram(tempName) - initialiseIntrinsicList()$Lisp - body : List SExpression := [getCode(l)$FortranCode for l in codeFrom(p)] - intrinsics : SExpression := getIntrinsicList()$Lisp - endSubProgram() - fortFormatHead(returnType::OutputForm, name::OutputForm, _ - arguments::OutputForm)$Lisp - printTypes(symbols)$SymbolTable - printTypes((p::Rep).localSymbols)$SymbolTable - printTypes(tempName)$TheSymbolTable - fortFormatIntrinsics(intrinsics)$Lisp - clearTheSymbolTable(tempName) - for expr in body repeat displayLines1(expr)$Lisp - dispStatement(END::OutputForm)$Lisp - - mkString(l:List Symbol):String == - unparse(convert(l::OutputForm)@InputForm)$InputForm - - checkVariables(user:List Symbol,target:List Symbol):Void == - -- We don't worry about whether the user has subscripted the - -- variables or not. - setDifference(map(name$Symbol,user),target) ~= empty()$List(Symbol) => - s1 : String := mkString(user) - s2 : String := mkString(target) - error ["Incompatible variable lists:", s1, s2] - - coerce(u:EXPR MINT) : $ == - checkVariables(variables(u)$EXPR(MINT),arguments) - l : List(FC) := [assign(name,u)$FC,returns()$FC] - makeRep l - - coerce(u:Equation EXPR MINT) : $ == - retractIfCan(lhs u)@Union(Kernel(EXPR MINT),"failed") case "failed" => - error "left hand side is not a kernel" - vList : List Symbol := variables lhs u - #vList ~= #arguments => - error "Incorrect number of arguments" - veList : List EXPR MINT := [w::EXPR(MINT) for w in vList] - aeList : List EXPR MINT := [w::EXPR(MINT) for w in arguments] - eList : List Equation EXPR MINT := - [equation(w,v) for w in veList for v in aeList] - (subst(rhs u,eList))::$ - - coerce(u:EXPR MFLOAT) : $ == - checkVariables(variables(u)$EXPR(MFLOAT),arguments) - l : List(FC) := [assign(name,u)$FC,returns()$FC] - makeRep l - - coerce(u:Equation EXPR MFLOAT) : $ == - retractIfCan(lhs u)@Union(Kernel(EXPR MFLOAT),"failed") case "failed" => - error "left hand side is not a kernel" - vList : List Symbol := variables lhs u - #vList ~= #arguments => - error "Incorrect number of arguments" - veList : List EXPR MFLOAT := [w::EXPR(MFLOAT) for w in vList] - aeList : List EXPR MFLOAT := [w::EXPR(MFLOAT) for w in arguments] - eList : List Equation EXPR MFLOAT := - [equation(w,v) for w in veList for v in aeList] - (subst(rhs u,eList))::$ - - coerce(u:EXPR MCMPLX) : $ == - checkVariables(variables(u)$EXPR(MCMPLX),arguments) - l : List(FC) := [assign(name,u)$FC,returns()$FC] - makeRep l - - coerce(u:Equation EXPR MCMPLX) : $ == - retractIfCan(lhs u)@Union(Kernel EXPR MCMPLX,"failed") case "failed"=> - error "left hand side is not a kernel" - vList : List Symbol := variables lhs u - #vList ~= #arguments => - error "Incorrect number of arguments" - veList : List EXPR MCMPLX := [w::EXPR(MCMPLX) for w in vList] - aeList : List EXPR MCMPLX := [w::EXPR(MCMPLX) for w in arguments] - eList : List Equation EXPR MCMPLX := - [equation(w,v) for w in veList for v in aeList] - (subst(rhs u,eList))::$ - - - coerce(u:REP):$ == - u@Rep - - coerce(u:$):OutputForm == - coerce(name)$Symbol - - coerce(c:List FortranCode):$ == - makeRep c - - coerce(c:FortranCode):$ == - makeRep [c] - - coerce(u:EXPR INT) : $ == - checkVariables(variables(u)$EXPR(INT),arguments) - l : List(FC) := [assign(name,u)$FC,returns()$FC] - makeRep l - - coerce(u:Equation EXPR INT) : $ == - retractIfCan(lhs u)@Union(Kernel(EXPR INT),"failed") case "failed" => - error "left hand side is not a kernel" - vList : List Symbol := variables lhs u - #vList ~= #arguments => - error "Incorrect number of arguments" - veList : List EXPR INT := [w::EXPR(INT) for w in vList] - aeList : List EXPR INT := [w::EXPR(INT) for w in arguments] - eList : List Equation EXPR INT := - [equation(w,v) for w in veList for v in aeList] - (subst(rhs u,eList))::$ - - coerce(u:EXPR Float) : $ == - checkVariables(variables(u)$EXPR(Float),arguments) - l : List(FC) := [assign(name,u)$FC,returns()$FC] - makeRep l - - coerce(u:Equation EXPR Float) : $ == - retractIfCan(lhs u)@Union(Kernel(EXPR Float),"failed") case "failed" => - error "left hand side is not a kernel" - vList : List Symbol := variables lhs u - #vList ~= #arguments => - error "Incorrect number of arguments" - veList : List EXPR Float := [w::EXPR(Float) for w in vList] - aeList : List EXPR Float := [w::EXPR(Float) for w in arguments] - eList : List Equation EXPR Float := - [equation(w,v) for w in veList for v in aeList] - (subst(rhs u,eList))::$ - - coerce(u:EXPR Complex Float) : $ == - checkVariables(variables(u)$EXPR(Complex Float),arguments) - l : List(FC) := [assign(name,u)$FC,returns()$FC] - makeRep l - - coerce(u:Equation EXPR CMPX Float) : $ == - retractIfCan(lhs u)@Union(Kernel EXPR CMPX Float,"failed") case "failed"=> - error "left hand side is not a kernel" - vList : List Symbol := variables lhs u - #vList ~= #arguments => - error "Incorrect number of arguments" - veList : List EXPR CMPX Float := [w::EXPR(CMPX Float) for w in vList] - aeList : List EXPR CMPX Float := [w::EXPR(CMPX Float) for w in arguments] - eList : List Equation EXPR CMPX Float := - [equation(w,v) for w in veList for v in aeList] - (subst(rhs u,eList))::$ - -@ -\section{domain M3D ThreeDimensionalMatrix} -<<domain M3D ThreeDimensionalMatrix>>= -)abbrev domain M3D ThreeDimensionalMatrix -++ Author: William Naylor -++ Date Created: 20 October 1993 -++ Date Last Updated: 20 May 1994 -++ BasicFunctions: -++ Related Constructors: Matrix -++ Also See: PrimitiveArray -++ AMS Classification: -++ Keywords: -++ References: -++ Description: -++ This domain represents three dimensional matrices over a general object type -ThreeDimensionalMatrix(R) : Exports == Implementation where - - R : SetCategory - L ==> List - NNI ==> NonNegativeInteger - A1AGG ==> OneDimensionalArrayAggregate - ARRAY1 ==> OneDimensionalArray - PA ==> PrimitiveArray - INT ==> Integer - PI ==> PositiveInteger - - Exports ==> HomogeneousAggregate(R) with - - if R has Ring then - zeroMatrix : (NNI,NNI,NNI) -> $ - ++ zeroMatrix(i,j,k) create a matrix with all zero terms - identityMatrix : (NNI) -> $ - ++ identityMatrix(n) create an identity matrix - ++ we note that this must be square - plus : ($,$) -> $ - ++ plus(x,y) adds two matrices, term by term - ++ we note that they must be the same size - construct : (L L L R) -> $ - ++ construct(lll) creates a 3-D matrix from a List List List R lll - elt : ($,NNI,NNI,NNI) -> R - ++ elt(x,i,j,k) extract an element from the matrix x - setelt! :($,NNI,NNI,NNI,R) -> R - ++ setelt!(x,i,j,k,s) (or x.i.j.k:=s) sets a specific element of the array to some value of type R - coerce : (PA PA PA R) -> $ - ++ coerce(p) moves from the representation type - ++ (PrimitiveArray PrimitiveArray PrimitiveArray R) - ++ to the domain - coerce : $ -> (PA PA PA R) - ++ coerce(x) moves from the domain to the representation type - matrixConcat3D : (Symbol,$,$) -> $ - ++ matrixConcat3D(s,x,y) concatenates two 3-D matrices along a specified axis - matrixDimensions : $ -> Vector NNI - ++ matrixDimensions(x) returns the dimensions of a matrix - - Implementation ==> (PA PA PA R) add - - import (PA PA PA R) - import (PA PA R) - import (PA R) - import R - - matrix1,matrix2,resultMatrix : $ - - -- function to concatenate two matrices - -- the first argument must be a symbol, which is either i,j or k - -- to specify the direction in which the concatenation is to take place - matrixConcat3D(dir : Symbol,mat1 : $,mat2 : $) : $ == - not ((dir = (i::Symbol)) or (dir = (j::Symbol)) or (dir = (k::Symbol)))_ - => error "the axis of concatenation must be i,j or k" - mat1Dim := matrixDimensions(mat1) - mat2Dim := matrixDimensions(mat2) - iDim1 := mat1Dim.1 - jDim1 := mat1Dim.2 - kDim1 := mat1Dim.3 - iDim2 := mat2Dim.1 - jDim2 := mat2Dim.2 - kDim2 := mat2Dim.3 - matRep1 : (PA PA PA R) := copy(mat1 :: (PA PA PA R))$(PA PA PA R) - matRep2 : (PA PA PA R) := copy(mat2 :: (PA PA PA R))$(PA PA PA R) - retVal : $ - - if (dir = (i::Symbol)) then - -- j,k dimensions must agree - if (not ((jDim1 = jDim2) and (kDim1=kDim2))) - then - error "jxk do not agree" - else - retVal := (coerce(concat(matRep1,matRep2)$(PA PA PA R))$$)@$ - - if (dir = (j::Symbol)) then - -- i,k dimensions must agree - if (not ((iDim1 = iDim2) and (kDim1=kDim2))) - then - error "ixk do not agree" - else - for i in 0..(iDim1-1) repeat - setelt(matRep1,i,(concat(elt(matRep1,i)$(PA PA PA R)_ - ,elt(matRep2,i)$(PA PA PA R))$(PA PA R))@(PA PA R))$(PA PA PA R) - retVal := (coerce(matRep1)$$)@$ - - if (dir = (k::Symbol)) then - temp : (PA PA R) - -- i,j dimensions must agree - if (not ((iDim1 = iDim2) and (jDim1=jDim2))) - then - error "ixj do not agree" - else - for i in 0..(iDim1-1) repeat - temp := copy(elt(matRep1,i)$(PA PA PA R))$(PA PA R) - for j in 0..(jDim1-1) repeat - setelt(temp,j,concat(elt(elt(matRep1,i)$(PA PA PA R)_ - ,j)$(PA PA R),elt(elt(matRep2,i)$(PA PA PA R),j)$(PA PA R)_ - )$(PA R))$(PA PA R) - setelt(matRep1,i,temp)$(PA PA PA R) - retVal := (coerce(matRep1)$$)@$ - - retVal - - matrixDimensions(mat : $) : Vector NNI == - matRep : (PA PA PA R) := mat :: (PA PA PA R) - iDim : NNI := (#matRep)$(PA PA PA R) - matRep2 : PA PA R := elt(matRep,0)$(PA PA PA R) - jDim : NNI := (#matRep2)$(PA PA R) - matRep3 : (PA R) := elt(matRep2,0)$(PA PA R) - kDim : NNI := (#matRep3)$(PA R) - retVal : Vector NNI := new(3,0)$(Vector NNI) - retVal.1 := iDim - retVal.2 := jDim - retVal.3 := kDim - retVal - - coerce(matrixRep : (PA PA PA R)) : $ == matrixRep pretend $ - - coerce(mat : $) : (PA PA PA R) == mat pretend (PA PA PA R) - - -- i,j,k must be with in the bounds of the matrix - elt(mat : $,i : NNI,j : NNI,k : NNI) : R == - matDims := matrixDimensions(mat) - iLength := matDims.1 - jLength := matDims.2 - kLength := matDims.3 - ((i > iLength) or (j > jLength) or (k > kLength) or (i=0) or (j=0) or_ -(k=0)) => error "coordinates must be within the bounds of the matrix" - matrixRep : PA PA PA R := mat :: (PA PA PA R) - elt(elt(elt(matrixRep,i-1)$(PA PA PA R),j-1)$(PA PA R),k-1)$(PA R) - - setelt!(mat : $,i : NNI,j : NNI,k : NNI,val : R)_ - : R == - matDims := matrixDimensions(mat) - iLength := matDims.1 - jLength := matDims.2 - kLength := matDims.3 - ((i > iLength) or (j > jLength) or (k > kLength) or (i=0) or (j=0) or_ -(k=0)) => error "coordinates must be within the bounds of the matrix" - matrixRep : PA PA PA R := mat :: (PA PA PA R) - row2 : PA PA R := copy(elt(matrixRep,i-1)$(PA PA PA R))$(PA PA R) - row1 : PA R := copy(elt(row2,j-1)$(PA PA R))$(PA R) - setelt(row1,k-1,val)$(PA R) - setelt(row2,j-1,row1)$(PA PA R) - setelt(matrixRep,i-1,row2)$(PA PA PA R) - val - - if R has Ring then - zeroMatrix(iLength:NNI,jLength:NNI,kLength:NNI) : $ == - (new(iLength,new(jLength,new(kLength,(0$R))$(PA R))$(PA PA R))$(PA PA PA R)) :: $ - - identityMatrix(iLength:NNI) : $ == - retValueRep : PA PA PA R := zeroMatrix(iLength,iLength,iLength)$$ :: (PA PA PA R) - row1 : PA R - row2 : PA PA R - row1empty : PA R := new(iLength,0$R)$(PA R) - row2empty : PA PA R := new(iLength,copy(row1empty)$(PA R))$(PA PA R) - for count in 0..(iLength-1) repeat - row1 := copy(row1empty)$(PA R) - setelt(row1,count,1$R)$(PA R) - row2 := copy(row2empty)$(PA PA R) - setelt(row2,count,copy(row1)$(PA R))$(PA PA R) - setelt(retValueRep,count,copy(row2)$(PA PA R))$(PA PA PA R) - retValueRep :: $ - - - plus(mat1 : $,mat2 :$) : $ == - - mat1Dims := matrixDimensions(mat1) - iLength1 := mat1Dims.1 - jLength1 := mat1Dims.2 - kLength1 := mat1Dims.3 - - mat2Dims := matrixDimensions(mat2) - iLength2 := mat2Dims.1 - jLength2 := mat2Dims.2 - kLength2 := mat2Dims.3 - - -- check that the dimensions are the same - (not (iLength1 = iLength2) or not (jLength1 = jLength2) or not(kLength1 = kLength2))_ - => error "error the matrices are different sizes" - - sum : R - row1 : (PA R) := new(kLength1,0$R)$(PA R) - row2 : (PA PA R) := new(jLength1,copy(row1)$(PA R))$(PA PA R) - row3 : (PA PA PA R) := new(iLength1,copy(row2)$(PA PA R))$(PA PA PA R) - - for i in 1..iLength1 repeat - for j in 1..jLength1 repeat - for k in 1..kLength1 repeat - sum := (elt(mat1,i,j,k)::R +$R_ - elt(mat2,i,j,k)::R) - setelt(row1,k-1,sum)$(PA R) - setelt(row2,j-1,copy(row1)$(PA R))$(PA PA R) - setelt(row3,i-1,copy(row2)$(PA PA R))$(PA PA PA R) - - resultMatrix := (row3 pretend $) - - resultMatrix - - construct(listRep : L L L R) : $ == - - (#listRep)$(L L L R) = 0 => error "empty list" - (#(listRep.1))$(L L R) = 0 => error "empty list" - (#((listRep.1).1))$(L R) = 0 => error "empty list" - iLength := (#listRep)$(L L L R) - jLength := (#(listRep.1))$(L L R) - kLength := (#((listRep.1).1))$(L R) - - --first check that the matrix is in the correct form - for subList in listRep repeat - not((#subList)$(L L R) = jLength) => error_ - "can not have an irregular shaped matrix" - for subSubList in subList repeat - not((#(subSubList))$(L R) = kLength) => error_ - "can not have an irregular shaped matrix" - - row1 : (PA R) := new(kLength,((listRep.1).1).1)$(PA R) - row2 : (PA PA R) := new(jLength,copy(row1)$(PA R))$(PA PA R) - row3 : (PA PA PA R) := new(iLength,copy(row2)$(PA PA R))$(PA PA PA R) - - for i in 1..iLength repeat - for j in 1..jLength repeat - for k in 1..kLength repeat - - element := elt(elt(elt(listRep,i)$(L L L R),j)$(L L R),k)$(L R) - setelt(row1,k-1,element)$(PA R) - setelt(row2,j-1,copy(row1)$(PA R))$(PA PA R) - setelt(row3,i-1,copy(row2)$(PA PA R))$(PA PA PA R) - - resultMatrix := (row3 pretend $) - - resultMatrix - -@ -\section{domain SFORT SimpleFortranProgram} -<<domain SFORT SimpleFortranProgram>>= -)abbrev domain SFORT SimpleFortranProgram - -++ Author: Mike Dewar -++ Date Created: November 1992 -++ Date Last Updated: -++ Basic Operations: -++ Related Constructors: FortranType, FortranCode, Switch -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ \axiomType{SimpleFortranProgram(f,type)} provides a simple model of some -++ FORTRAN subprograms, making it possible to coerce objects of various -++ domains into a FORTRAN subprogram called \axiom{f}. -++ These can then be translated into legal FORTRAN code. -SimpleFortranProgram(R,FS): Exports == Implementation where - R : SetCategory - FS : FunctionSpace(R) - - FST ==> FortranScalarType - - Exports ==> FortranProgramCategory with - fortran : (Symbol,FST,FS) -> $ - ++fortran(fname,ftype,body) builds an object of type - ++\axiomType{FortranProgramCategory}. The three arguments specify - ++the name, the type and the body of the program. - - Implementation ==> add - - Rep := Record(name : Symbol, type : FST, body : FS ) - - fortran(fname, ftype, res) == - construct(fname,ftype,res)$Rep - - nameOf(u:$):Symbol == u . name - - typeOf(u:$):Union(FST,"void") == u . type - - bodyOf(u:$):FS == u . body - - argumentsOf(u:$):List Symbol == variables(bodyOf u)$FS - - coerce(u:$):OutputForm == - coerce(nameOf u)$Symbol - - outputAsFortran(u:$):Void == - ftype := (checkType(typeOf(u)::OutputForm)$Lisp)::OutputForm - fname := nameOf(u)::OutputForm - args := argumentsOf(u) - nargs:=args::OutputForm - val := bodyOf(u)::OutputForm - fortFormatHead(ftype,fname,nargs)$Lisp - fortFormatTypes(ftype,args)$Lisp - dispfortexp1$Lisp ["="::OutputForm, fname, val]@List(OutputForm) - dispfortexp1$Lisp "RETURN"::OutputForm - dispfortexp1$Lisp "END"::OutputForm - -@ -\section{domain SWITCH Switch} -<<domain SWITCH Switch>>= -)abbrev domain SWITCH Switch - -++ Author: Mike Dewar -++ Date Created: April 1991 -++ Date Last Updated: March 1994 -++ 30.6.94 Added coercion from Symbol MCD -++ Basic Operations: -++ Related Constructors: FortranProgram, FortranCode, FortranTypes -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This domain builds representations of boolean expressions for use with -++ the \axiomType{FortranCode} domain. -Switch():public == private where - EXPR ==> Union(I:Expression Integer,F:Expression Float, - CF:Expression Complex Float,switch:%) - - public == CoercibleTo OutputForm with - coerce : Symbol -> $ - ++ coerce(s) \undocumented{} - LT : (EXPR,EXPR) -> $ - ++ LT(x,y) returns the \axiomType{Switch} expression representing \spad{x<y}. - GT : (EXPR,EXPR) -> $ - ++ GT(x,y) returns the \axiomType{Switch} expression representing \spad{x>y}. - LE : (EXPR,EXPR) -> $ - ++ LE(x,y) returns the \axiomType{Switch} expression representing \spad{x<=y}. - GE : (EXPR,EXPR) -> $ - ++ GE(x,y) returns the \axiomType{Switch} expression representing \spad{x>=y}. - OR : (EXPR,EXPR) -> $ - ++ OR(x,y) returns the \axiomType{Switch} expression representing \spad{x or y}. - EQ : (EXPR,EXPR) -> $ - ++ EQ(x,y) returns the \axiomType{Switch} expression representing \spad{x = y}. - AND : (EXPR,EXPR) -> $ - ++ AND(x,y) returns the \axiomType{Switch} expression representing \spad{x and y}. - NOT : EXPR -> $ - ++ NOT(x) returns the \axiomType{Switch} expression representing \spad{\~~x}. - NOT : $ -> $ - ++ NOT(x) returns the \axiomType{Switch} expression representing \spad{\~~x}. - - private == add - Rep := Record(op:BasicOperator,rands:List EXPR) - - -- Public function definitions - - nullOp : BasicOperator := operator NULL - - coerce(s:%):OutputForm == - rat := (s . op)::OutputForm - ran := [u::OutputForm for u in s.rands] - (s . op) = nullOp => first ran - #ran = 1 => - prefix(rat,ran) - infix(rat,ran) - - coerce(s:Symbol):$ == [nullOp,[[s::Expression(Integer)]$EXPR]$List(EXPR)]$Rep - - NOT(r:EXPR):% == - [operator("~"::Symbol),[r]$List(EXPR)]$Rep - - NOT(r:%):% == - [operator("~"::Symbol),[[r]$EXPR]$List(EXPR)]$Rep - - LT(r1:EXPR,r2:EXPR):% == - [operator("<"::Symbol),[r1,r2]$List(EXPR)]$Rep - - GT(r1:EXPR,r2:EXPR):% == - [operator(">"::Symbol),[r1,r2]$List(EXPR)]$Rep - - LE(r1:EXPR,r2:EXPR):% == - [operator("<="::Symbol),[r1,r2]$List(EXPR)]$Rep - - GE(r1:EXPR,r2:EXPR):% == - [operator(">="::Symbol),[r1,r2]$List(EXPR)]$Rep - - AND(r1:EXPR,r2:EXPR):% == - [operator("and"::Symbol),[r1,r2]$List(EXPR)]$Rep - - OR(r1:EXPR,r2:EXPR):% == - [operator("or"::Symbol),[r1,r2]$List(EXPR)]$Rep - - EQ(r1:EXPR,r2:EXPR):% == - [operator("EQ"::Symbol),[r1,r2]$List(EXPR)]$Rep - -@ -\section{domain FTEM FortranTemplate} -<<domain FTEM FortranTemplate>>= -)abbrev domain FTEM FortranTemplate -++ Author: Mike Dewar -++ Date Created: October 1992 -++ Date Last Updated: -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: Code to manipulate Fortran templates -FortranTemplate() : specification == implementation where - - specification == FileCategory(FileName, String) with - - processTemplate : (FileName, FileName) -> FileName - ++ processTemplate(tp,fn) processes the template tp, writing the - ++ result out to fn. - processTemplate : (FileName) -> FileName - ++ processTemplate(tp) processes the template tp, writing the - ++ result to the current FORTRAN output stream. - fortranLiteralLine : String -> Void - ++ fortranLiteralLine(s) writes s to the current Fortran output stream, - ++ followed by a carriage return - fortranLiteral : String -> Void - ++ fortranLiteral(s) writes s to the current Fortran output stream - fortranCarriageReturn : () -> Void - ++ fortranCarriageReturn() produces a carriage return on the current - ++ Fortran output stream - - implementation == TextFile add - - import TemplateUtilities - import FortranOutputStackPackage - - Rep := TextFile - - fortranLiteralLine(s:String):Void == - %writeLine(s,_$fortranOutputStream$Lisp)$Foreign(Builtin) - - fortranLiteral(s:String):Void == - %writeString(s,_$fortranOutputStream$Lisp)$Foreign(Builtin) - - fortranCarriageReturn():Void == - %writeNewline(_$fortranOutputStream$Lisp)$Foreign(Builtin) - - writePassiveLine!(line:String):Void == - -- We might want to be a bit clever here and look for new SubPrograms etc. - fortranLiteralLine line - - processTemplate(tp:FileName, fn:FileName):FileName == - pushFortranOutputStack(fn) - processTemplate(tp) - popFortranOutputStack() - fn - - getLine(fp:TextFile):String == - line : String := stripCommentsAndBlanks readLine!(fp) - while not empty?(line) and elt(line,maxIndex line) = char "__" repeat - setelt(line,maxIndex line,char " ") - line := concat(line, stripCommentsAndBlanks readLine!(fp))$String - line - - processTemplate(tp:FileName):FileName == - fp : TextFile := open(tp,"input") - active : Boolean := true - line : String - endInput : Boolean := false - while not (endInput or endOfFile? fp) repeat - if active then - line := getLine fp - line = "endInput" => endInput := true - if line = "beginVerbatim" then - active := false - else - not empty? line => interpretString line - else - line := readLine!(fp) - if line = "endVerbatim" then - active := true - else - writePassiveLine! line - close!(fp) - if not active then - error concat(["Missing `endVerbatim' line in ",tp::String])$String - string(_$fortranOutputFile$Lisp)::FileName - -@ -\section{domain FEXPR FortranExpression} -<<domain FEXPR FortranExpression>>= -)abbrev domain FEXPR FortranExpression -++ Author: Mike Dewar -++ Date Created: December 1993 -++ Date Last Updated: 19 May 1994 -++ 7 July 1994 added %power to f77Functions -++ 12 July 1994 added RetractableTo(R) -++ Basic Operations: -++ Related Domains: -++ Also See: FortranMachineTypeCategory, MachineInteger, MachineFloat, -++ MachineComplex -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: A domain of expressions involving functions which can be -++ translated into standard Fortran-77, with some extra extensions from -++ the NAG Fortran Library. -FortranExpression(basicSymbols,subscriptedSymbols,R): - Exports==Implementation where - basicSymbols : List Symbol - subscriptedSymbols : List Symbol - R : FortranMachineTypeCategory - - EXPR ==> Expression - EXF2 ==> ExpressionFunctions2 - S ==> Symbol - L ==> List - BO ==> BasicOperator - FRAC ==> Fraction - POLY ==> Polynomial - - Exports ==> Join(ExpressionSpace,Algebra(R),RetractableTo(R), - PartialDifferentialRing(Symbol)) with - retract : EXPR R -> $ - ++ retract(e) takes e and transforms it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retractIfCan : EXPR R -> Union($,"failed") - ++ retractIfCan(e) takes e and tries to transform it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retract : S -> $ - ++ retract(e) takes e and transforms it into a FortranExpression - ++ checking that it is one of the given basic symbols - ++ or subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retractIfCan : S -> Union($,"failed") - ++ retractIfCan(e) takes e and tries to transform it into a FortranExpression - ++ checking that it is one of the given basic symbols - ++ or subscripted symbols which correspond to scalar and array - ++ parameters respectively. - coerce : $ -> EXPR R - ++ coerce(x) \undocumented{} - if (R has RetractableTo(Integer)) then - retract : EXPR Integer -> $ - ++ retract(e) takes e and transforms it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retractIfCan : EXPR Integer -> Union($,"failed") - ++ retractIfCan(e) takes e and tries to transform it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retract : FRAC POLY Integer -> $ - ++ retract(e) takes e and transforms it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retractIfCan : FRAC POLY Integer -> Union($,"failed") - ++ retractIfCan(e) takes e and tries to transform it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retract : POLY Integer -> $ - ++ retract(e) takes e and transforms it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retractIfCan : POLY Integer -> Union($,"failed") - ++ retractIfCan(e) takes e and tries to transform it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - if (R has RetractableTo(Float)) then - retract : EXPR Float -> $ - ++ retract(e) takes e and transforms it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retractIfCan : EXPR Float -> Union($,"failed") - ++ retractIfCan(e) takes e and tries to transform it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retract : FRAC POLY Float -> $ - ++ retract(e) takes e and transforms it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retractIfCan : FRAC POLY Float -> Union($,"failed") - ++ retractIfCan(e) takes e and tries to transform it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retract : POLY Float -> $ - ++ retract(e) takes e and transforms it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retractIfCan : POLY Float -> Union($,"failed") - ++ retractIfCan(e) takes e and tries to transform it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - abs : $ -> $ - ++ abs(x) represents the Fortran intrinsic function ABS - sqrt : $ -> $ - ++ sqrt(x) represents the Fortran intrinsic function SQRT - exp : $ -> $ - ++ exp(x) represents the Fortran intrinsic function EXP - log : $ -> $ - ++ log(x) represents the Fortran intrinsic function LOG - log10 : $ -> $ - ++ log10(x) represents the Fortran intrinsic function LOG10 - sin : $ -> $ - ++ sin(x) represents the Fortran intrinsic function SIN - cos : $ -> $ - ++ cos(x) represents the Fortran intrinsic function COS - tan : $ -> $ - ++ tan(x) represents the Fortran intrinsic function TAN - asin : $ -> $ - ++ asin(x) represents the Fortran intrinsic function ASIN - acos : $ -> $ - ++ acos(x) represents the Fortran intrinsic function ACOS - atan : $ -> $ - ++ atan(x) represents the Fortran intrinsic function ATAN - sinh : $ -> $ - ++ sinh(x) represents the Fortran intrinsic function SINH - cosh : $ -> $ - ++ cosh(x) represents the Fortran intrinsic function COSH - tanh : $ -> $ - ++ tanh(x) represents the Fortran intrinsic function TANH - pi : () -> $ - ++ pi(x) represents the NAG Library function X01AAF which returns - ++ an approximation to the value of pi - variables : $ -> L S - ++ variables(e) return a list of all the variables in \spad{e}. - useNagFunctions : () -> Boolean - ++ useNagFunctions() indicates whether NAG functions are being used - ++ for mathematical and machine constants. - useNagFunctions : Boolean -> Boolean - ++ useNagFunctions(v) sets the flag which controls whether NAG functions - ++ are being used for mathematical and machine constants. The previous - ++ value is returned. - - Implementation ==> EXPR R add - - -- The standard FORTRAN-77 intrinsic functions, plus nthRoot which - -- can be translated into an arithmetic expression: - f77Functions : L S := [abs,sqrt,exp,log,log10,sin,cos,tan,asin,acos, - atan,sinh,cosh,tanh,nthRoot,%power] - nagFunctions : L S := [pi, X01AAF] - useNagFunctionsFlag : Boolean := true - - -- Local functions to check for "unassigned" symbols etc. - - mkEqn(s1:Symbol,s2:Symbol):Equation EXPR(R) == - equation(s2::EXPR(R),script(s1,scripts(s2))::EXPR(R)) - - fixUpSymbols(u:EXPR R):Union(EXPR R,"failed") == - -- If its a univariate expression then just fix it up: - syms : L S := variables(u) - one?(#basicSymbols) and zero?(#subscriptedSymbols) => - not one?(#syms) => "failed" - subst(u,equation(first(syms)::EXPR(R),first(basicSymbols)::EXPR(R))) - -- We have one variable but it is subscripted: - zero?(#basicSymbols) and one?(#subscriptedSymbols) => - -- Make sure we don't have both X and X_i - for s in syms repeat - not scripted?(s) => return "failed" - not one?(#(syms:=removeDuplicates! [name(s) for s in syms]))=> "failed" - sym : Symbol := first subscriptedSymbols - subst(u,[mkEqn(sym,i) for i in variables(u)]) - "failed" - - extraSymbols?(u:EXPR R):Boolean == - syms : L S := [name(v) for v in variables(u)] - extras : L S := setDifference(syms, - setUnion(basicSymbols,subscriptedSymbols)) - not empty? extras - - checkSymbols(u:EXPR R):EXPR(R) == - syms : L S := [name(v) for v in variables(u)] - extras : L S := setDifference(syms, - setUnion(basicSymbols,subscriptedSymbols)) - not empty? extras => - m := fixUpSymbols(u) - m case EXPR(R) => m::EXPR(R) - error ["Extra symbols detected:",[string(v) for v in extras]$L(String)] - u - - notSymbol?(v:BO):Boolean == - s : S := name v - member?(s,basicSymbols) or - scripted?(s) and member?(name s,subscriptedSymbols) => false - true - - extraOperators?(u:EXPR R):Boolean == - ops : L S := [name v for v in operators(u) | notSymbol?(v)] - if useNagFunctionsFlag then - fortranFunctions : L S := append(f77Functions,nagFunctions) - else - fortranFunctions : L S := f77Functions - extras : L S := setDifference(ops,fortranFunctions) - not empty? extras - - checkOperators(u:EXPR R):Void == - ops : L S := [name v for v in operators(u) | notSymbol?(v)] - if useNagFunctionsFlag then - fortranFunctions : L S := append(f77Functions,nagFunctions) - else - fortranFunctions : L S := f77Functions - extras : L S := setDifference(ops,fortranFunctions) - not empty? extras => - error ["Non FORTRAN-77 functions detected:",[string(v) for v in extras]] - - checkForNagOperators(u:EXPR R):$ == - useNagFunctionsFlag => - import Pi - import PiCoercions(R) - piOp : BasicOperator := operator X01AAF - piSub : Equation EXPR R := - equation(pi()$Pi::EXPR(R),kernel(piOp,0::EXPR(R))$EXPR(R)) - per subst(u,piSub) - per u - - -- Conditional retractions: - - if R has RetractableTo(Integer) then - - retractIfCan(u:POLY Integer):Union($,"failed") == - retractIfCan((u::EXPR Integer)$EXPR(Integer))@Union($,"failed") - - retract(u:POLY Integer):$ == - retract((u::EXPR Integer)$EXPR(Integer))@$ - - retractIfCan(u:FRAC POLY Integer):Union($,"failed") == - retractIfCan((u::EXPR Integer)$EXPR(Integer))@Union($,"failed") - - retract(u:FRAC POLY Integer):$ == - retract((u::EXPR Integer)$EXPR(Integer))@$ - - int2R(u:Integer):R == u::R - - retractIfCan(u:EXPR Integer):Union($,"failed") == - retractIfCan(map(int2R,u)$EXF2(Integer,R))@Union($,"failed") - - retract(u:EXPR Integer):$ == - retract(map(int2R,u)$EXF2(Integer,R))@$ - - if R has RetractableTo(Float) then - - retractIfCan(u:POLY Float):Union($,"failed") == - retractIfCan((u::EXPR Float)$EXPR(Float))@Union($,"failed") - - retract(u:POLY Float):$ == - retract((u::EXPR Float)$EXPR(Float))@$ - - retractIfCan(u:FRAC POLY Float):Union($,"failed") == - retractIfCan((u::EXPR Float)$EXPR(Float))@Union($,"failed") - - retract(u:FRAC POLY Float):$ == - retract((u::EXPR Float)$EXPR(Float))@$ - - float2R(u:Float):R == (u::R) - - retractIfCan(u:EXPR Float):Union($,"failed") == - retractIfCan(map(float2R,u)$EXF2(Float,R))@Union($,"failed") - - retract(u:EXPR Float):$ == - retract(map(float2R,u)$EXF2(Float,R))@$ - - -- Exported Functions - - useNagFunctions():Boolean == useNagFunctionsFlag - useNagFunctions(v:Boolean):Boolean == - old := useNagFunctionsFlag - useNagFunctionsFlag := v - old - - log10(x:$):$ == - kernel(operator log10,x) - - pi():$ == kernel(operator X01AAF,0) - - coerce(u:$):EXPR R == rep u - - retractIfCan(u:EXPR R):Union($,"failed") == - if (extraSymbols? u) then - m := fixUpSymbols(u) - m case "failed" => return "failed" - u := m::EXPR(R) - extraOperators? u => "failed" - checkForNagOperators(u) - - retract(u:EXPR R):$ == - u:=checkSymbols(u) - checkOperators(u) - checkForNagOperators(u) - - retractIfCan(u:Symbol):Union($,"failed") == - not (member?(u,basicSymbols) or - scripted?(u) and member?(name u,subscriptedSymbols)) => "failed" - per (u::EXPR(R)) - - retract(u:Symbol):$ == - res : Union($,"failed") := retractIfCan(u) - res case "failed" => error ["Illegal Symbol Detected:",u::String] - res - -@ -\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>> - -<<domain RESULT Result>> -<<domain FC FortranCode>> -<<domain FORTRAN FortranProgram>> -<<domain M3D ThreeDimensionalMatrix>> -<<domain SFORT SimpleFortranProgram>> -<<domain SWITCH Switch>> -<<domain FTEM FortranTemplate>> -<<domain FEXPR FortranExpression>> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/functions.spad.pamphlet b/src/algebra/functions.spad.pamphlet deleted file mode 100644 index 63b0e5ea..00000000 --- a/src/algebra/functions.spad.pamphlet +++ /dev/null @@ -1,120 +0,0 @@ -\documentclass{article} -\usepackage{open-axiom} -\begin{document} -\title{\$SPAD/src/algebra functions.spad} -\author{Brian Dupee} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain BFUNCT BasicFunctions} -<<domain BFUNCT BasicFunctions>>= -)abbrev domain BFUNCT BasicFunctions -++ Author: Brian Dupee -++ Date Created: August 1994 -++ Date Last Updated: April 1996 -++ Basic Operations: bfKeys, bfEntry -++ Description: A Domain which implements a table containing details of -++ points at which particular functions have evaluation problems. -DF ==> DoubleFloat -SDF ==> Stream DoubleFloat -RS ==> Record(zeros: SDF, ones: SDF, singularities: SDF) - -BasicFunctions(): E == I where - E ==> SetCategory with - bfKeys:() -> List Symbol - ++ bfKeys() returns the names of each function in the - ++ \axiomType{BasicFunctions} table - bfEntry:Symbol -> RS - ++ bfEntry(k) returns the entry in the \axiomType{BasicFunctions} table - ++ corresponding to \spad{k} - finiteAggregate - - I ==> add - - Rep := Table(Symbol,RS) - import Rep, SDF - - f(x:DF):DF == - positive?(x) => -x - -x+1 - - bf():$ == - import RS - dpi := pi()$DF - ndpi:SDF := map(#1*dpi,(z := generate(f,0))) -- [n pi for n in Z] - n1dpi:SDF := map(-(2*(#1)-1)*dpi/2,z) -- [(n+1) pi /2] - n2dpi:SDF := map(2*#1*dpi,z) -- [2 n pi for n in Z] - n3dpi:SDF := map(-(4*(#1)-1)*dpi/4,z) - n4dpi:SDF := map(-(4*(#1)-1)*dpi/2,z) - sinEntry:RS := [ndpi, n4dpi, empty()$SDF] - cosEntry:RS := [n1dpi, n2dpi, esdf := empty()$SDF] - tanEntry:RS := [ndpi, n3dpi, n1dpi] - asinEntry:RS := [construct([0$DF])$SDF, - construct([float(8414709848078965,-16,10)$DF]), esdf] - acosEntry:RS := [construct([1$DF])$SDF, - construct([float(54030230586813977,-17,10)$DF]), esdf] - atanEntry:RS := [construct([0$DF])$SDF, - construct([float(15574077246549023,-16,10)$DF]), esdf] - secEntry:RS := [esdf, n2dpi, n1dpi] - cscEntry:RS := [esdf, n4dpi, ndpi] - cotEntry:RS := [n1dpi, n3dpi, ndpi] - logEntry:RS := [construct([1$DF])$SDF,esdf, construct([0$DF])$SDF] - entryList:List(Record(key:Symbol,entry:RS)) := - [['sin, sinEntry], ['cos, cosEntry], - ['tan, tanEntry], ['sec, secEntry], - ['csc, cscEntry], ['cot, cotEntry], - ['asin, asinEntry], ['acos, acosEntry], - ['atan, atanEntry], ['log, logEntry]] - construct(entryList)$Rep - - bfKeys():List Symbol == keys(bf())$Rep - - bfEntry(k:Symbol):RS == qelt(bf(),k)$Rep - -@ -\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>> - -<<domain BFUNCT BasicFunctions>> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/routines.spad.pamphlet b/src/algebra/routines.spad.pamphlet deleted file mode 100644 index 5b67f754..00000000 --- a/src/algebra/routines.spad.pamphlet +++ /dev/null @@ -1,647 +0,0 @@ -\documentclass{article} -\usepackage{open-axiom} -\begin{document} -\title{\$SPAD/src/algebra routines.spad} -\author{Brian Dupee} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain ROUTINE RoutinesTable} -<<domain ROUTINE RoutinesTable>>= -)abbrev domain ROUTINE RoutinesTable -++ Author: Brian Dupee -++ Date Created: August 1994 -++ Date Last Updated: December 1997 -++ Basic Operations: routines, getMeasure -++ Related Constructors: TableAggregate(Symbol,Any) -++ Description: -++ \axiomType{RoutinesTable} implements a database and associated tuning -++ mechanisms for a set of known NAG routines -RoutinesTable(): E == I where - F ==> Float - ST ==> String - LST ==> List String - Rec ==> Record(key:Symbol,entry:Any) - RList ==> List(Record(key:Symbol,entry:Any)) - IFL ==> List(Record(ifail:Integer,instruction:ST)) - Entry ==> Record(chapter:ST, type:ST, domainName: ST, - defaultMin:F, measure:F, failList:IFL, explList:LST) - - E ==> TableAggregate(Symbol,Any) with - - concat:(%,%) -> % - ++ concat(x,y) merges two tables x and y - routines:() -> % - ++ routines() initialises a database of known NAG routines - selectIntegrationRoutines:% -> % - ++ selectIntegrationRoutines(R) chooses only those routines from - ++ the database which are for integration - selectOptimizationRoutines:% -> % - ++ selectOptimizationRoutines(R) chooses only those routines from - ++ the database which are for integration - selectPDERoutines:% -> % - ++ selectPDERoutines(R) chooses only those routines from the - ++ database which are for the solution of PDE's - selectODEIVPRoutines:% -> % - ++ selectODEIVPRoutines(R) chooses only those routines from the - ++ database which are for the solution of ODE's - selectFiniteRoutines:% -> % - ++ selectFiniteRoutines(R) chooses only those routines from the - ++ database which are designed for use with finite expressions - selectSumOfSquaresRoutines:% -> % - ++ selectSumOfSquaresRoutines(R) chooses only those routines from the - ++ database which are designed for use with sums of squares - selectNonFiniteRoutines:% -> % - ++ selectNonFiniteRoutines(R) chooses only those routines from the - ++ database which are designed for use with non-finite expressions. - selectMultiDimensionalRoutines:% -> % - ++ selectMultiDimensionalRoutines(R) chooses only those routines from - ++ the database which are designed for use with multi-dimensional - ++ expressions - changeThreshhold:(%,Symbol,F) -> % - ++ changeThreshhold(R,s,newValue) changes the value below which, - ++ given a NAG routine generating a higher measure, the routines will - ++ make no attempt to generate a measure. - changeMeasure:(%,Symbol,F) -> % - ++ changeMeasure(R,s,newValue) changes the maximum value for a - ++ measure of the given NAG routine. - getMeasure:(%,Symbol) -> F - ++ getMeasure(R,s) gets the current value of the maximum measure for - ++ the given NAG routine. - getExplanations:(%,ST) -> LST - ++ getExplanations(R,s) gets the explanations of the output parameters for - ++ the given NAG routine. - deleteRoutine!:(%,Symbol) -> % - ++ deleteRoutine!(R,s) destructively deletes the given routine from - ++ the current database of NAG routines - showTheRoutinesTable:() -> % - ++ showTheRoutinesTable() returns the current table of NAG routines. - recoverAfterFail:(%,ST,Integer) -> Union(ST,"failed") - ++ recoverAfterFail(routs,routineName,ifailValue) acts on the - ++ instructions given by the ifail list - finiteAggregate - - I ==> Result add - - Rep := Result - import Rep - - theRoutinesTable:% := routines() - - showTheRoutinesTable():% == theRoutinesTable - - integrationRoutine?(r:Record(key:Symbol,entry:Any)):Boolean == - (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry => - elt(a,chapter) = "Integration" - false - - selectIntegrationRoutines(R:%):% == select(integrationRoutine?,R) - - optimizationRoutine?(r:Record(key:Symbol,entry:Any)):Boolean == - (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry => - elt(a,chapter) = "Optimization" - false - - selectOptimizationRoutines(R:%):% == select(optimizationRoutine?,R) - - PDERoutine?(r:Record(key:Symbol,entry:Any)):Boolean == - (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry => - elt(a,chapter) = "PDE" - false - - selectPDERoutines(R:%):% == select(PDERoutine?,R) - - ODERoutine?(r:Record(key:Symbol,entry:Any)):Boolean == - (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry => - elt(a,chapter) = "ODE" - false - - selectODEIVPRoutines(R:%):% == select(ODERoutine?,R) - - sumOfSquaresRoutine?(r:Record(key:Symbol,entry:Any)):Boolean == - (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry => - elt(a,type) = "SS" - false - - selectSumOfSquaresRoutines(R:%):% == select(sumOfSquaresRoutine?,R) - - finiteRoutine?(r:Record(key:Symbol,entry:Any)):Boolean == - (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry => - elt(a,type) = "One-dimensional finite" - false - - selectFiniteRoutines(R:%):% == select(finiteRoutine?,R) - - infiniteRoutine?(r:Record(key:Symbol,entry:Any)):Boolean == - (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry => - elt(a,type) = "One-dimensional infinite" - false - - semiInfiniteRoutine?(r:Record(key:Symbol,entry:Any)):Boolean == - (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry => - elt(a,type) = "One-dimensional semi-infinite" - false - - nonFiniteRoutine?(r:Record(key:Symbol,entry:Any)):Boolean == - (semiInfiniteRoutine?(r) or infiniteRoutine?(r)) - - selectNonFiniteRoutines(R:%):% == select(nonFiniteRoutine?,R) - - multiDimensionalRoutine?(r:Record(key:Symbol,entry:Any)):Boolean == - (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry => - elt(a,type) = "Multi-dimensional" - false - - selectMultiDimensionalRoutines(R:%):% == select(multiDimensionalRoutine?,R) - - concat(a:%,b:%):% == - membersOfa := (members(a)@List(Record(key:Symbol,entry:Any))) - membersOfb := (members(b)@List(Record(key:Symbol,entry:Any))) - allMembers:= - concat(membersOfa,membersOfb)$List(Record(key:Symbol,entry:Any)) - construct(allMembers) - - changeThreshhold(R:%,s:Symbol,newValue:F):% == - (a := search(s,R)) case Any => - e := retract(a)$AnyFunctions1(Entry) - e.defaultMin := newValue - a := coerce(e)$AnyFunctions1(Entry) - insert!([s,a],R) - error("changeThreshhold","Cannot find routine of that name")$ErrorFunctions - - changeMeasure(R:%,s:Symbol,newValue:F):% == - (a := search(s,R)) case Any => - e := retract(a)$AnyFunctions1(Entry) - e.measure := newValue - a := coerce(e)$AnyFunctions1(Entry) - insert!([s,a],R) - error("changeMeasure","Cannot find routine of that name")$ErrorFunctions - - getMeasure(R:%,s:Symbol):F == - (a := search(s,R)) case Any => - e := retract(a)$AnyFunctions1(Entry) - e.measure - error("getMeasure","Cannot find routine of that name")$ErrorFunctions - - deleteRoutine!(R:%,s:Symbol):% == - (a := search(s,R)) case Any => - e:Record(key:Symbol,entry:Any) := [s,a] - remove!(e,R) - error("deleteRoutine!","Cannot find routine of that name")$ErrorFunctions - - routines():% == - f := "One-dimensional finite" - s := "One-dimensional semi-infinite" - i := "One-dimensional infinite" - m := "Multi-dimensional" - int := "Integration" - ode := "ODE" - pde := "PDE" - opt := "Optimization" - d01ajfExplList:LST := ["result: Calculated value of the integral", - "iw: iw(1) contains the actual number of sub-intervals used, the rest is workspace", - "w: contains the end-points of the sub-intervals used along with the integral contributions and error estimates over the sub-intervals", - "abserr: the estimate of the absolute error of the result", - "ifail: the error warning parameter", - "method: details of the method used and measures of all methods", - "attributes: a list of the attributes pertaining to the integrand which had some bearing on the choice of method"] - d01asfExplList:LST := ["result: Calculated value of the integral", - "iw: iw(1) contains the actual number of sub-intervals used, the rest is workspace", - "lst: contains the actual number of sub-intervals used", - "erlst: contains the error estimates over the sub-intervals", - "rslst: contains the integral contributions of the sub-intervals", - "ierlst: contains the error flags corresponding to the values in rslst", - "abserr: the estimate of the absolute error of the result", - "ifail: the error warning parameter", - "method: details of the method used and measures of all methods", - "attributes: a list of the attributes pertaining to the integrand which had some bearing on the choice of method"] - d01fcfExplList:LST := ["result: Calculated value of the integral", - "acc: the estimate of the relative error of the result", - "minpts: the number of integrand evaluations", - "ifail: the error warning parameter", - "method: details of the method used and measures of all methods", - "attributes: a list of the attributes pertaining to the integrand which had some bearing on the choice of method"] - d01transExplList:LST := ["result: Calculated value of the integral", - "abserr: the estimate of the absolute error of the result", - "method: details of the method and transformation used and measures of all methods", - "d01***AnnaTypeAnswer: the individual results from the routines", - "attributes: a list of the attributes pertaining to the integrand which had some bearing on the choice of method"] - d02bhfExplList:LST := ["x: the value of x at the end of the calculation", - "y: the computed values of Y\[1\]..Y\[n\] at x", - "tol: the (possible) estimate of the error; this is not guarunteed", - "ifail: the error warning parameter", - "method: details of the method used and measures of all methods", - "intensityFunctions: a list of the attributes and values pertaining to the ODE which had some bearing on the choice of method"] - d02bbfExplList:LST := concat(["result: the computed values of the solution at the required points"],d02bhfExplList)$LST - d03eefExplList:LST := ["See the NAG On-line Documentation for D03EEF/D03EDF", - "u: the computed solution u[i][j] is returned in u(i+(j-1)*ngx),for i = 1,2,..ngx; j = 1,2,..ngy"] - e04fdfExplList:LST := ["x: the position of the minimum", - "objf: the value of the objective function at x", - "ifail: the error warning parameter", - "method: details of the method used and measures of all methods", - "attributes: a list of the attributes pertaining to the function or functions which had some bearing on the choice of method"] - e04dgfExplList:LST := concat(e04fdfExplList, - ["objgrd: the values of the derivatives at x", - "iter: the number of iterations performed"])$LST - e04jafExplList:LST := concat(e04fdfExplList, - ["bu: the values of the upper bounds used", - "bl: the values of the lower bounds used"])$LST - e04ucfExplList:LST := concat(e04dgfExplList, - ["istate: the status of every constraint at x", - "clamda: the QP multipliers for the last QP sub-problem", - "For other output parameters see the NAG On-line Documentation for E04UCF"])$LST - e04mbfExplList:LST := concat(e04fdfExplList, - ["istate: the status of every constraint at x", - "clamda: the Lagrange multipliers for each constraint"])$LST - d01ajfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], [4,"delete"], - [5,"delete"], [6,"delete"]] - d01akfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], [4,"delete"]] - d01alfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], [4,"delete"], - [5,"delete"], [6,"delete"], [7,"delete"]] - d01amfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], [4,"delete"], - [5,"delete"], [6,"delete"]] - d01anfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], [4,"delete"], - [5,"delete"], [6,"delete"], [7,"delete"]] - d01apfIfail:IFL := - [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], [4,"delete"], [5,"delete"]] - d01aqfIfail:IFL := - [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], [4,"delete"], [5,"delete"]] - d01asfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], [4,"delete"], - [5,"delete"], [6,"delete"], [7,"delete"], [8,"delete"], [9,"delete"]] - d01fcfIfail:IFL := [[1,"delete"], [2,"incrFunEvals"], [3,"delete"]] - d01gbfIfail:IFL := [[1,"delete"], [2,"incrFunEvals"]] - d02bbfIfail:IFL := - [[1,"delete"], [2,"decrease tolerance"], [3,"increase tolerance"], - [4,"delete"], [5,"delete"], [6,"delete"], [7,"delete"]] - d02bhfIfail:IFL := - [[1,"delete"], [2,"decrease tolerance"], [3,"increase tolerance"], - [4,"no action"], [5,"delete"], [6,"delete"], [7,"delete"]] - d02cjfIfail:IFL := - [[1,"delete"], [2,"decrease tolerance"], [3,"increase tolerance"], - [4,"delete"], [5,"delete"], [6,"no action"], [7,"delete"]] - d02ejfIfail:IFL := - [[1,"delete"], [2,"decrease tolerance"], [3,"increase tolerance"], - [4,"delete"], [5,"delete"], [6,"no action"], [7,"delete"], [8,"delete"], - [9,"delete"]] - e04dgfIfail:IFL := [[3,"delete"], [4,"no action"], [6,"delete"], - [7,"delete"], [8,"delete"], [9,"delete"]] - e04fdfIfail:IFL := - [[1,"delete"], [2,"delete"], [3,"delete"], [4,"delete"], - [5,"no action"], [6,"no action"], [7,"delete"], [8,"delete"]] - e04gcfIfail:IFL := [[1,"delete"], [2,"delete"], [3,"delete"], [4,"delete"], - [5,"no action"], [6,"no action"], [7,"delete"], [8,"delete"], [9,"delete"]] - e04jafIfail:IFL := [[1,"delete"], [2,"delete"], [3,"delete"], [4,"delete"], - [5,"no action"], [6,"no action"], [7,"delete"], [8,"delete"], [9,"delete"]] - e04mbfIfail:IFL := - [[1,"delete"], [2,"delete"], [3,"delete"], [4,"delete"], [5,"delete"]] - e04nafIfail:IFL := - [[1,"delete"], [2,"delete"], [3,"delete"], [4,"delete"], [5,"delete"], - [6,"delete"], [7,"delete"], [8,"delete"], [9,"delete"]] - e04ucfIfail:IFL := [[1,"delete"], [2,"delete"], [3,"delete"], [4,"delete"], - [5,"delete"], [6,"delete"], [7,"delete"], [8,"delete"], [9,"delete"]] - d01ajfEntry:Entry := [int, f, "d01ajfAnnaType",0.4,0.4,d01ajfIfail,d01ajfExplList] - d01akfEntry:Entry := [int, f, "d01akfAnnaType",0.6,1.0,d01akfIfail,d01ajfExplList] - d01alfEntry:Entry := [int, f, "d01alfAnnaType",0.6,0.6,d01alfIfail,d01ajfExplList] - d01amfEntry:Entry := [int, i, "d01amfAnnaType",0.5,0.5,d01amfIfail,d01ajfExplList] - d01anfEntry:Entry := [int, f, "d01anfAnnaType",0.6,0.9,d01anfIfail,d01ajfExplList] - d01apfEntry:Entry := [int, f, "d01apfAnnaType",0.7,0.7,d01apfIfail,d01ajfExplList] - d01aqfEntry:Entry := [int, f, "d01aqfAnnaType",0.6,0.7,d01aqfIfail,d01ajfExplList] - d01asfEntry:Entry := [int, s, "d01asfAnnaType",0.6,0.9,d01asfIfail,d01asfExplList] - d01transEntry:Entry:=[int, i, "d01TransformFunctionType",0.6,0.9,[],d01transExplList] - d01gbfEntry:Entry := [int, m, "d01gbfAnnaType",0.6,0.6,d01gbfIfail,d01fcfExplList] - d01fcfEntry:Entry := [int, m, "d01fcfAnnaType",0.5,0.5,d01fcfIfail,d01fcfExplList] - d02bbfEntry:Entry := [ode, "IVP", "d02bbfAnnaType",0.7,0.5,d02bbfIfail,d02bbfExplList] - d02bhfEntry:Entry := [ode, "IVP", "d02bhfAnnaType",0.7,0.49,d02bhfIfail,d02bhfExplList] - d02cjfEntry:Entry := [ode, "IVP", "d02cjfAnnaType",0.7,0.5,d02cjfIfail,d02bbfExplList] - d02ejfEntry:Entry := [ode, "IVP", "d02ejfAnnaType",0.7,0.5,d02ejfIfail,d02bbfExplList] - d03eefEntry:Entry := [pde, "2", "d03eefAnnaType",0.6,0.5,[],d03eefExplList] - --d03fafEntry:Entry := [pde, "3", "d03fafAnnaType",0.6,0.5,[],[]] - e04dgfEntry:Entry := [opt, "CGA", "e04dgfAnnaType",0.4,0.4,e04dgfIfail,e04dgfExplList] - e04fdfEntry:Entry := [opt, "SS", "e04fdfAnnaType",0.7,0.7,e04fdfIfail,e04fdfExplList] - e04gcfEntry:Entry := [opt, "SS", "e04gcfAnnaType",0.8,0.8,e04gcfIfail,e04fdfExplList] - e04jafEntry:Entry := [opt, "QNA", "e04jafAnnaType",0.5,0.5,e04jafIfail,e04jafExplList] - e04mbfEntry:Entry := [opt, "LP", "e04mbfAnnaType",0.7,0.7,e04mbfIfail,e04mbfExplList] - e04nafEntry:Entry := [opt, "QP", "e04nafAnnaType",0.7,0.7,e04nafIfail,e04mbfExplList] - e04ucfEntry:Entry := [opt, "SQP", "e04ucfAnnaType",0.6,0.6,e04ucfIfail,e04ucfExplList] - rl:RList := - [["d01apf" :: Symbol, coerce(d01apfEntry)$AnyFunctions1(Entry)],_ - ["d01aqf" :: Symbol, coerce(d01aqfEntry)$AnyFunctions1(Entry)],_ - ["d01alf" :: Symbol, coerce(d01alfEntry)$AnyFunctions1(Entry)],_ - ["d01anf" :: Symbol, coerce(d01anfEntry)$AnyFunctions1(Entry)],_ - ["d01akf" :: Symbol, coerce(d01akfEntry)$AnyFunctions1(Entry)],_ - ["d01ajf" :: Symbol, coerce(d01ajfEntry)$AnyFunctions1(Entry)],_ - ["d01asf" :: Symbol, coerce(d01asfEntry)$AnyFunctions1(Entry)],_ - ["d01amf" :: Symbol, coerce(d01amfEntry)$AnyFunctions1(Entry)],_ - ["d01transform" :: Symbol, coerce(d01transEntry)$AnyFunctions1(Entry)],_ - ["d01gbf" :: Symbol, coerce(d01gbfEntry)$AnyFunctions1(Entry)],_ - ["d01fcf" :: Symbol, coerce(d01fcfEntry)$AnyFunctions1(Entry)],_ - ["d02bbf" :: Symbol, coerce(d02bbfEntry)$AnyFunctions1(Entry)],_ - ["d02bhf" :: Symbol, coerce(d02bhfEntry)$AnyFunctions1(Entry)],_ - ["d02cjf" :: Symbol, coerce(d02cjfEntry)$AnyFunctions1(Entry)],_ - ["d02ejf" :: Symbol, coerce(d02ejfEntry)$AnyFunctions1(Entry)],_ - ["d03eef" :: Symbol, coerce(d03eefEntry)$AnyFunctions1(Entry)],_ - --["d03faf" :: Symbol, coerce(d03fafEntry)$AnyFunctions1(Entry)], - ["e04dgf" :: Symbol, coerce(e04dgfEntry)$AnyFunctions1(Entry)],_ - ["e04fdf" :: Symbol, coerce(e04fdfEntry)$AnyFunctions1(Entry)],_ - ["e04gcf" :: Symbol, coerce(e04gcfEntry)$AnyFunctions1(Entry)],_ - ["e04jaf" :: Symbol, coerce(e04jafEntry)$AnyFunctions1(Entry)],_ - ["e04mbf" :: Symbol, coerce(e04mbfEntry)$AnyFunctions1(Entry)],_ - ["e04naf" :: Symbol, coerce(e04nafEntry)$AnyFunctions1(Entry)],_ - ["e04ucf" :: Symbol, coerce(e04ucfEntry)$AnyFunctions1(Entry)]] - construct(rl) - - getIFL(s:Symbol,l:%):Union(IFL,"failed") == - o := search(s,l)$% - o case "failed" => "failed" - e := retractIfCan(o)$AnyFunctions1(Entry) - e case "failed" => "failed" - e.failList - - getInstruction(l:IFL,ifailValue:Integer):Union(ST,"failed") == - output := empty()$ST - for i in 1..#l repeat - if ((l.i).ifail=ifailValue)@Boolean then - output := (l.i).instruction - empty?(output)$ST => "failed" - output - - recoverAfterFail(routs:%,routineName:ST, - ifailValue:Integer):Union(ST,"failed") == - name := routineName :: Symbol - failedList := getIFL(name,routs) - failedList case "failed" => "failed" - empty? failedList => "failed" - instr := getInstruction(failedList,ifailValue) - instr case "failed" => concat(routineName," failed")$ST - (instr = "delete")@Boolean => - deleteRoutine!(routs,name) - concat(routineName," failed - trying alternatives")$ST - instr - - getExplanations(R:%,routineName:ST):LST == - name := routineName :: Symbol - (a := search(name,R)) case Any => - e := retract(a)$AnyFunctions1(Entry) - e.explList - empty()$LST - -@ -\section{domain ATTRBUT AttributeButtons} -<<domain ATTRBUT AttributeButtons>>= -)abbrev domain ATTRBUT AttributeButtons -++ Author: Brian Dupee -++ Date Created: April 1996 -++ Date Last Updated: December 1997 -++ Basic Operations: increase, decrease, getButtonValue, setButtonValue -++ Related Constructors: Table(String,Float) -++ Description: -++ \axiomType{AttributeButtons} implements a database and associated -++ adjustment mechanisms for a set of attributes. -++ -++ For ODEs these attributes are "stiffness", "stability" (i.e. how much -++ affect the cosine or sine component of the solution has on the stability of -++ the result), "accuracy" and "expense" (i.e. how expensive is the evaluation -++ of the ODE). All these have bearing on the cost of calculating the -++ solution given that reducing the step-length to achieve greater accuracy -++ requires considerable number of evaluations and calculations. -++ -++ The effect of each of these attributes can be altered by increasing or -++ decreasing the button value. -++ -++ For Integration there is a button for increasing and decreasing the preset -++ number of function evaluations for each method. This is automatically used -++ by ANNA when a method fails due to insufficient workspace or where the -++ limit of function evaluations has been reached before the required -++ accuracy is achieved. -++ -AttributeButtons(): E == I where - F ==> Float - ST ==> String - LST ==> List String - Rec ==> Record(key:Symbol,entry:Any) - RList ==> List(Record(key:Symbol,entry:Any)) - IFL ==> List(Record(ifail:Integer,instruction:ST)) - Entry ==> Record(chapter:ST, type:ST, domainName: ST, - defaultMin:F, measure:F, failList:IFL, explList:LST) - - - E ==> SetCategory with - - increase:(ST,ST) -> F - ++ \axiom{increase(routineName,attributeName)} increases the value - ++ for the effect of the attribute \axiom{attributeName} with routine - ++ \axiom{routineName}. - ++ - ++ \axiom{attributeName} should be one of the values - ++ "stiffness", "stability", "accuracy", "expense" or - ++ "functionEvaluations". - increase:(ST) -> F - ++ \axiom{increase(attributeName)} increases the value for the - ++ effect of the attribute \axiom{attributeName} with all routines. - ++ - ++ \axiom{attributeName} should be one of the values - ++ "stiffness", "stability", "accuracy", "expense" or - ++ "functionEvaluations". - decrease:(ST,ST) -> F - ++ \axiom{decrease(routineName,attributeName)} decreases the value - ++ for the effect of the attribute \axiom{attributeName} with routine - ++ \axiom{routineName}. - ++ - ++ \axiom{attributeName} should be one of the values - ++ "stiffness", "stability", "accuracy", "expense" or - ++ "functionEvaluations". - decrease:(ST) -> F - ++ \axiom{decrease(attributeName)} decreases the value for the - ++ effect of the attribute \axiom{attributeName} with all routines. - ++ - ++ \axiom{attributeName} should be one of the values - ++ "stiffness", "stability", "accuracy", "expense" or - ++ "functionEvaluations". - getButtonValue:(ST,ST) -> F - ++ \axiom{getButtonValue(routineName,attributeName)} returns the - ++ current value for the effect of the attribute \axiom{attributeName} - ++ with routine \axiom{routineName}. - ++ - ++ \axiom{attributeName} should be one of the values - ++ "stiffness", "stability", "accuracy", "expense" or - ++ "functionEvaluations". - resetAttributeButtons:() -> Void - ++ \axiom{resetAttributeButtons()} resets the Attribute buttons to a - ++ neutral level. - setAttributeButtonStep:(F) -> F - ++ \axiom{setAttributeButtonStep(n)} sets the value of the steps for - ++ increasing and decreasing the button values. \axiom{n} must be - ++ greater than 0 and less than 1. The preset value is 0.5. - setButtonValue:(ST,F) -> F - ++ \axiom{setButtonValue(attributeName,n)} sets the - ++ value of all buttons of attribute \spad{attributeName} - ++ to \spad{n}. \spad{n} must be in the range [0..1]. - ++ - ++ \axiom{attributeName} should be one of the values - ++ "stiffness", "stability", "accuracy", "expense" or - ++ "functionEvaluations". - setButtonValue:(ST,ST,F) -> F - ++ \axiom{setButtonValue(attributeName,routineName,n)} sets the - ++ value of the button of attribute \spad{attributeName} to routine - ++ \spad{routineName} to \spad{n}. \spad{n} must be in the range [0..1]. - ++ - ++ \axiom{attributeName} should be one of the values - ++ "stiffness", "stability", "accuracy", "expense" or - ++ "functionEvaluations". - finiteAggregate - - I ==> add - - Rep := StringTable(F) - import Rep - - buttons:() -> $ - - buttons():$ == - eList := empty()$List(Record(key:ST,entry:F)) - l1:List String := ["stability","stiffness","accuracy","expense"] - l2:List String := ["functionEvaluations"] - ro1 := selectODEIVPRoutines(r := routines()$RoutinesTable)$RoutinesTable - ro2 := selectIntegrationRoutines(r)$RoutinesTable - k1:List String := [string(i)$Symbol for i in keys(ro1)$RoutinesTable] - k2:List String := [string(i)$Symbol for i in keys(ro2)$RoutinesTable] - for i in k1 repeat - for j in l1 repeat - e:Record(key:ST,entry:F) := [i j,0.5] - eList := cons(e,eList)$List(Record(key:ST,entry:F)) - for i in k2 repeat - for j in l2 repeat - e:Record(key:ST,entry:F) := [i j,0.5] - eList := cons(e,eList)$List(Record(key:ST,entry:F)) - construct(eList)$Rep - - attributeButtons:$ := buttons() - - attributeStep:F := 0.5 - - setAttributeButtonStep(n:F):F == - positive?(n)$F and (n<1$F) => attributeStep:F := n - error("setAttributeButtonStep","New value must be in (0..1)")$ErrorFunctions - - resetAttributeButtons():Void == - attributeButtons := buttons() - - setButtonValue(routineName:ST,attributeName:ST,n:F):F == - f := search(routineName attributeName,attributeButtons)$Rep - f case Float => - n>=0$F and n<=1$F => - setelt(attributeButtons,routineName attributeName,n)$Rep - error("setAttributeButtonStep","New value must be in [0..1]")$ErrorFunctions - error("setButtonValue","attribute name " attributeName - " not found for routine " routineName)$ErrorFunctions - - setButtonValue(attributeName:ST,n:F):F == - ro1 := selectODEIVPRoutines(r := routines()$RoutinesTable)$RoutinesTable - ro2 := selectIntegrationRoutines(r)$RoutinesTable - l1:List String := ["stability","stiffness","accuracy","expense"] - l2:List String := ["functionEvaluations"] - if attributeName="functionEvaluations" then - for i in keys(ro2)$RoutinesTable repeat - setButtonValue(string(i)$Symbol,attributeName,n) - else - for i in keys(ro1)$RoutinesTable repeat - setButtonValue(string(i)$Symbol,attributeName,n) - n - - increase(routineName:ST,attributeName:ST):F == - f := search(routineName attributeName,attributeButtons)$Rep - f case Float => - newValue:F := (1$F-attributeStep)*f+attributeStep - setButtonValue(routineName,attributeName,newValue) - error("increase","attribute name " attributeName - " not found for routine " routineName)$ErrorFunctions - - increase(attributeName:ST):F == - ro1 := selectODEIVPRoutines(r := routines()$RoutinesTable)$RoutinesTable - ro2 := selectIntegrationRoutines(r)$RoutinesTable - l1:List String := ["stability","stiffness","accuracy","expense"] - l2:List String := ["functionEvaluations"] - if attributeName="functionEvaluations" then - for i in keys(ro2)$RoutinesTable repeat - increase(string(i)$Symbol,attributeName) - else - for i in keys(ro1)$RoutinesTable repeat - increase(string(i)$Symbol,attributeName) - getButtonValue(string(i)$Symbol,attributeName) - - decrease(routineName:ST,attributeName:ST):F == - f := search(routineName attributeName,attributeButtons)$Rep - f case Float => - newValue:F := (1$F-attributeStep)*f - setButtonValue(routineName,attributeName,newValue) - error("increase","attribute name " attributeName - " not found for routine " routineName)$ErrorFunctions - - decrease(attributeName:ST):F == - ro1 := selectODEIVPRoutines(r := routines()$RoutinesTable)$RoutinesTable - ro2 := selectIntegrationRoutines(r)$RoutinesTable - l1:List String := ["stability","stiffness","accuracy","expense"] - l2:List String := ["functionEvaluations"] - if attributeName="functionEvaluations" then - for i in keys(ro2)$RoutinesTable repeat - decrease(string(i)$Symbol,attributeName) - else - for i in keys(ro1)$RoutinesTable repeat - decrease(string(i)$Symbol,attributeName) - getButtonValue(string(i)$Symbol,attributeName) - - - getButtonValue(routineName:ST,attributeName:ST):F == - f := search(routineName attributeName,attributeButtons)$Rep - f case Float => f - error("getButtonValue","attribute name " attributeName - " not found for routine " routineName)$ErrorFunctions - -@ -\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>> - -<<domain ROUTINE RoutinesTable>> -<<domain ATTRBUT AttributeButtons>> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} |