aboutsummaryrefslogtreecommitdiff
path: root/src/interp/clammed.boot.pamphlet
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2007-09-20 14:50:49 +0000
committerdos-reis <gdr@axiomatics.org>2007-09-20 14:50:49 +0000
commit0850ca5458cb09b2d04cec162558500e9a05cf4a (patch)
treeaa76b50f08c662dab9a49b6ee9f0dc7318139ea1 /src/interp/clammed.boot.pamphlet
parent6f8caa148526efc14239febdc12f91165389a8ea (diff)
downloadopen-axiom-0850ca5458cb09b2d04cec162558500e9a05cf4a.tar.gz
Revert commits to the wrong tree.
Diffstat (limited to 'src/interp/clammed.boot.pamphlet')
-rw-r--r--src/interp/clammed.boot.pamphlet229
1 files changed, 229 insertions, 0 deletions
diff --git a/src/interp/clammed.boot.pamphlet b/src/interp/clammed.boot.pamphlet
new file mode 100644
index 00000000..d0689739
--- /dev/null
+++ b/src/interp/clammed.boot.pamphlet
@@ -0,0 +1,229 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp clammed.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+-- - Redistributions of source code must retain the above copyright
+-- notice, this list of conditions and the following disclaimer.
+--
+-- - Redistributions in binary form must reproduce the above copyright
+-- notice, this list of conditions and the following disclaimer in
+-- the documentation and/or other materials provided with the
+-- distribution.
+--
+-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- names of its contributors may be used to endorse or promote products
+-- derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% Functions on $clamList
+
+-- These files are read in by the system so that they can be cached
+-- properly. Otherwise, must read in compiled versions and then
+-- recompile these, resulting in wasted BPI space.
+
+canCoerceFrom(mr,m) ==
+ -- bind flag for recording/reporting instantiations
+ -- (see recordInstantiation)
+ $insideCanCoerceFrom: local := [mr,m]
+ canCoerceFrom0(mr,m)
+
+canCoerce(t1, t2) ==
+ val := canCoerce1(t1, t2) => val
+ t1 is ['Variable, :.] =>
+ newMode := getMinimalVarMode(t1, nil)
+ canCoerce1(t1, newMode) and canCoerce1(newMode, t2)
+ nil
+
+--------------------> NEW DEFINITION (see interop.boot.pamphlet)
+coerceConvertMmSelection(funName,m1,m2) ==
+ -- calls selectMms with $Coerce=NIL and tests for required
+ -- target type. funName is either 'coerce or 'convert.
+ $declaredMode : local:= NIL
+ $reportBottomUpFlag : local:= NIL
+ l := selectMms1(funName,m2,[m1],[m1],NIL)
+ mmS := [x for x in l | x is [sig,:.] and hasCorrectTarget(m2,sig) and
+ isEqualOrSubDomain(m1, first rest rest sig)]
+ mmS and CAR mmS
+
+hasFileProperty(p,id,abbrev) == hasFilePropertyNoCache(p,id,abbrev)
+
+isValidType form ==
+ -- returns true IFF form is a type whose arguments satisfy the
+ -- predicate of the type constructor
+ -- Note that some forms are said to be invalid because they would
+ -- cause problems with the interpreter. Thus things like P P I
+ -- are not valid.
+ STRINGP form => true
+ IDENTP form => false
+ form in '((Mode) (Domain) (SubDomain (Domain))) => true
+ form is ['Record,:selectors] =>
+ and/[isValidType type for [:.,type] in selectors]
+ form is ['Enumeration,:args] =>
+ null (and/[IDENTP x for x in args]) => false
+ ((# args) = (# REMDUP args)) => true
+ false
+ form is ['Mapping,:mapargs] =>
+ null mapargs => NIL
+ and/[isValidType type for type in mapargs]
+ form is ['Union,:args] =>
+ -- check for a tagged union
+ args and first args is [":",:.] =>
+ and/[isValidType type for [:.,type] in args]
+ null (and/[isValidType arg for arg in args]) => NIL
+ ((# args) = (# REMDUP args)) => true
+ sayKeyedMsg("S2IR0005",[form])
+ NIL
+
+ badDoubles := CONS($QuotientField, '(Gaussian Complex Polynomial Expression))
+ form is [T1, [T2, :.]] and T1 = T2 and member(T1, badDoubles) => NIL
+
+ form is [=$QuotientField,D] and not isPartialMode(D) and
+ ofCategory(D,'(Field)) => NIL
+ form is ['UnivariatePolynomial, x, ['UnivariatePolynomial, y, .]] and x=y =>
+ NIL
+ form = '(Complex (AlgebraicNumber)) => NIL
+ form is ['Expression, ['Kernel, . ]] => NIL
+ form is [op,:argl] =>
+ null constructor? op => nil
+ cosig := GETDATABASE(op, 'COSIG)
+ cosig and null rest cosig => -- niladic constructor
+ null argl => true
+ false
+ null (sig := getConstructorSignature form) => nil
+ [.,:cl] := sig
+ -- following line is needed to deal with mutable domains
+ if # cl ^= # argl and GENSYMP last argl then argl:= DROP(-1,argl)
+ # cl ^= # argl => nil
+ cl:= replaceSharps(cl,form)
+ and/[isValid for x in argl for c in cl] where isValid ==
+ categoryForm?(c) =>
+ evalCategory(x,MSUBSTQ(x,'_$,c)) and isValidType x
+ not GETDATABASE(opOf x,'CONSTRUCTORKIND) = 'domain
+
+selectMms1(op,tar,args1,args2,$Coerce) ==
+ -- for new compiler/old world compatibility, sometimes have to look
+ -- for operations given two names.
+
+ -- NEW COMPILER COMPATIBILITY ON
+
+ op = "^" or op = "**" =>
+ APPEND(selectMms2("**",tar,args1,args2,$Coerce),
+ selectMms2("^",tar,args1,args2,$Coerce))
+
+ -- NEW COMPILER COMPATIBILITY OFF
+
+ selectMms2(op,tar,args1,args2,$Coerce)
+
+
+resolveTT(t1,t2) ==
+ -- resolves two types
+ -- this symmetric resolve looks for a type t to which both t1 and t2
+ -- can be coerced
+ -- if resolveTT fails, the result will be NIL
+ startTimingProcess 'resolve
+ t1 := eqType t1
+ t2 := eqType t2
+ null (t := resolveTT1(t1,t2)) =>
+ stopTimingProcess 'resolve
+ nil
+ isValidType (t := eqType t) =>
+ stopTimingProcess 'resolve
+ t
+ stopTimingProcess 'resolve
+ nil
+
+isLegitimateMode(t,hasPolyMode,polyVarList) ==
+ -- returns true IFF t is a valid type. i.e. if t has no repeated
+ -- variables, or two levels of Polynomial
+ null t => true -- a terminating condition with underDomainOf
+ t = $EmptyMode => true
+ STRINGP t => true
+ ATOM t => false
+
+ badDoubles := CONS($QuotientField, '(Gaussian Complex Polynomial Expression))
+ t is [T1, [T2, :.]] and T1 = T2 and member(T1, badDoubles) => NIL
+
+ t is [=$QuotientField,D] and not isPartialMode(D) and
+ ofCategory(D,'(Field)) => NIL
+ t = '(Complex (AlgebraicNumber)) => NIL
+
+ t := equiType t
+ vl := isPolynomialMode t =>
+ if vl^='all then
+ var:= or/[(x in polyVarList => x;nil) for x in vl] => return false
+ listOfDuplicates vl => return false
+ polyVarList:= union(vl,polyVarList)
+ hasPolyMode => false
+ con := CAR t
+ poly? := (con = 'Polynomial or con = 'Expression)
+ isLegitimateMode(underDomainOf t,poly?,polyVarList)
+
+ constructor? first t =>
+ isLegitimateMode(underDomainOf t,hasPolyMode,polyVarList) => t
+ t is ['Mapping,:ml] =>
+ null ml => NIL
+ -- first arg is target, which can be Void
+ null isLegitimateMode(first ml,nil,nil) => NIL
+ for m in rest ml repeat
+ m = $Void =>
+ return NIL
+ null isLegitimateMode(m,nil,nil) => return NIL
+ true
+ t is ['Union,:ml] =>
+ -- check for tagged union
+ ml and first ml is [":",:.] => isLegitimateRecordOrTaggedUnion ml
+ null (and/[isLegitimateMode(m,nil,nil) for m in ml]) => NIL
+ ((# ml) = (# REMDUP ml)) => true
+ NIL
+ t is ['Record,:r] => isLegitimateRecordOrTaggedUnion r
+ t is ['Enumeration,:r] =>
+ null (and/[IDENTP x for x in r]) => false
+ ((# r) = (# REMDUP r)) => true
+ false
+ false
+
+underDomainOf t ==
+ t = $RationalNumber => $Integer
+ not PAIRP t => NIL
+ d := deconstructT t
+ 1 = #d => NIL
+ u := getUnderModeOf(t) => u
+ last d
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}