diff options
29 files changed, 76 insertions, 66 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 78c3334f..66b06063 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,22 @@ 2011-09-07 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/lisplib.boot (finalizeLisplib): Finalize documentaion + only if not bootstrapping. + (isFunctor): Tidy. + * interp/g-util.boot (superType): Tidy. + * interp/database.boot (getDualSignature): Rename from + getDualSignatureFromDB. Adjust callers. + * interp/c-util.boot (isKnownCategory): Remove. + (diagnoseUnknownType): Use isCategoryForm. + * interp/bootlex.lisp (GET-INTEGER-IN-RADIX): Use SPAD_SYNTAX_ERROR. + * interp/metalex.lisp (GET-STRING-TOKEN): Likewise. + * interp/parsing.lisp (MUST): Likewise. + * algebra/boolean.spad.pamphlet (Refrence) [coerce]: Bypass + conversion to Identifier. + * algebra/domain.spad.pamphlet (ContructorKind): Tidy. + +2011-09-07 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/nruncomp.boot (NRTaddInner): Use the dual signature. * interp/lisplib.boot (writeDualSignature): New. (finalizeLisplib): Likewise. diff --git a/src/algebra/boolean.spad.pamphlet b/src/algebra/boolean.spad.pamphlet index a7ffceb4..7562b3b5 100644 --- a/src/algebra/boolean.spad.pamphlet +++ b/src/algebra/boolean.spad.pamphlet @@ -427,7 +427,7 @@ Reference(S:Type): Type with if S has SetCategory then coerce p == - prefix('ref::Identifier::OutputForm, [p.value::OutputForm]) + prefix('ref::OutputForm, [p.value::OutputForm]) @ diff --git a/src/algebra/domain.spad.pamphlet b/src/algebra/domain.spad.pamphlet index dc9ea2f8..4fc644c9 100644 --- a/src/algebra/domain.spad.pamphlet +++ b/src/algebra/domain.spad.pamphlet @@ -29,9 +29,9 @@ ConstructorKind(): Public == Private where domain: % ++ `domain' is the kind of domain constructors package: % ++ `package' is the kind of package constructors. Private == add - category == 'category : % - domain == 'domain : % - package == 'package : % + category == %categoryKind$Foreign(Builtin) + domain == %domainKind$Foreign(Builtin) + package == %packageKind$Foreign(Builtin) k1 = k2 == %peq(k1,k2)$Foreign(Builtin) coerce(k: %): OutputForm == k : OutputForm diff --git a/src/interp/bootlex.lisp b/src/interp/bootlex.lisp index 2032c0c8..31022c0a 100644 --- a/src/interp/bootlex.lisp +++ b/src/interp/bootlex.lisp @@ -319,7 +319,7 @@ or the chracters ?, !, ' or %" ;; digits forming that integer token. (defun get-integer-in-radix (buf r) (unless (> r 1) - (meta-syntax-error)) + (spad_syntax_error)) (let ((mark (1+ (size buf)))) (tagbody lp (suffix (current-char) buf) @@ -327,7 +327,7 @@ or the chracters ?, !, ' or %" (dig (|rdigit?| nxt))) (when dig (unless (< dig r) - (meta-syntax-error)) + (spad_syntax_error)) (advance-char) (go lp)))) (parse-integer buf :start mark :radix r))) diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot index 50776276..63c27d71 100644 --- a/src/interp/br-con.boot +++ b/src/interp/br-con.boot @@ -578,7 +578,7 @@ kDomainName(htPage,kind,name,nargs) == htpSetProperty(htPage,'inputAreaList,inputAreaList) conname := makeSymbol name args := [kArgumentCheck(domain?,x) or nil for x in inputAreaList - for domain? in rest getDualSignatureFromDB conname] + for domain? in rest getDualSignature conname] or/[null x for x in args] => (n := +/[1 for x in args | x]) > 0 => ['error,nil,'"\centerline{You gave values for only {\em ",n,'" } of the {\em ",#args,'"}}",'"\centerline{parameters of {\sf ",name,'"}}\vspace{1}\centerline{Please enter either {\em all} or {\em none} of the type parameters}"] @@ -624,7 +624,7 @@ kisValidType typeForm == kCheckArgumentNumbers t == [conname,:args] := t - cosig := KDR getDualSignatureFromDB conname + cosig := KDR getDualSignature conname #cosig ~= #args => false and/[foo for domain? in cosig for x in args] where foo() == domain? => kCheckArgumentNumbers x diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot index 5144fba7..0aab1e84 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -197,7 +197,7 @@ fromHeading htPage == upOp := symbolName opOf updomain ['" {\em from} ",:dbConformGen dnForm,'" {\em under} \ops{",upOp,'"}{",:$pn,:upFence,'"}"] domname := htpProperty(htPage,'domname) - numberOfUnderlyingDomains := #[x for x in rest getDualSignatureFromDB(opOf domname) | x] + numberOfUnderlyingDomains := #[x for x in rest getDualSignature(opOf domname) | x] -- numberOfUnderlyingDomains = 1 and -- KDR domname and (dn := dbExtractUnderlyingDomain domname) => -- ['" {\em from} ",:pickitForm(domname,dn)] @@ -220,7 +220,7 @@ conform2StringList(form,opFn,argFn,exception) == special := op in '(Union Record Mapping) cosig := special => ['T for x in args] - rest getDualSignatureFromDB op + rest getDualSignature op atypes := special => cosig getConstructorModemap(op).mmSource @@ -266,7 +266,7 @@ dbOuttran form == else op := form args := nil - cosig := rest getDualSignatureFromDB op + cosig := rest getDualSignature op atypes := getConstructorModemap(op).mmSource argl := [fn for x in args for atype in atypes for pred in cosig] where fn() == pred => x @@ -882,7 +882,7 @@ getRegistry(op,sig) == evalableConstructor2HtString domform == if vector? domform then domform := devaluate domform conname := first domform - coSig := rest getDualSignatureFromDB conname + coSig := rest getDualSignature conname --entries are T for arguments which are domains; NIL for computational objects and/[x for x in coSig] => form2HtString(domform,nil,true) arglist := [unquote x for x in rest domform] where diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot index 547b193c..a06b0f8f 100644 --- a/src/interp/br-saturn.boot +++ b/src/interp/br-saturn.boot @@ -938,7 +938,7 @@ addParameterTemplates(page, conform) == kPageArgs([op,:args],[.,.,:source]) == htSaySaturn '"\begin{tabular}{p{.25in}lp{0in}}" firstTime := true - coSig := rest getDualSignatureFromDB op + coSig := rest getDualSignature op for x in args for t in source for pred in coSig repeat if firstTime then firstTime := false else @@ -1170,7 +1170,7 @@ operationIsNiladicConstructor op == ++ Like operationIsNiladicConstructor() except that we just want ++ to know whether `op' is a constructor, arity is unimportant. operationIsConstructor op == - ident? op => getDualSignatureFromDB op + ident? op => getDualSignature op nil --------------> NEW DEFINITION (see br-op2.boot.pamphlet) diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot index 7ee5c8ca..026ff895 100644 --- a/src/interp/br-search.boot +++ b/src/interp/br-search.boot @@ -317,7 +317,7 @@ mkGrepPattern1(x,:options) == --called by mkGrepPattern (and grepConstructName?) conform2OutputForm(form) == [op,:args] := form null args => form - cosig := rest getDualSignatureFromDB op + cosig := rest getDualSignature op atypes := getConstructorModemap(op).mmSource sargl := [fn for x in args for atype in atypes for pred in cosig] where fn() == pp [x,atype,pred] diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot index a77aab7c..100ee96d 100644 --- a/src/interp/c-doc.boot +++ b/src/interp/c-doc.boot @@ -432,7 +432,7 @@ checkIsValidType form == main where [op,:args] := form conname := (constructor? op => op; abbreviation? op) null conname => nil - fn(form,getDualSignatureFromDB conname) + fn(form,getDualSignature conname) fn(form,coSig) == #form ~= #coSig => form or/[null checkIsValidType x for x in rest form for flag in rest coSig | flag] diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index be49e6fc..75a8ec60 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -683,24 +683,12 @@ TrimCF() == --% -isKnownCategory: (%Mode,%Env) -> %Boolean -isKnownCategory(c,e) == - c = $Type => true - c = $Category => true - [ctor,:args] := c - ctor = "Join" => true -- don't check arguments yet. - ctor = "SubsetCategory" => true -- ditto - get(ctor,"isCategory",e) => true - false - ---TRACE isKnownCategory - ++ Returns non-nil if `t' is a known type in the environement `e'. diagnoseUnknownType(t,e) == t isnt [.,:.] => t in '($ constant) => t t' := assoc(t,getDomainsInScope e) => t' - (m := getmode(t,e)) and isKnownCategory(m,$CategoryFrame) => t + (m := getmode(t,e)) and isCategoryForm(m,$CategoryFrame) => t string? t => t -- ??? We should not to check for $$ at this stage. -- ??? This is a bug in the compiler that needs to be fixed. diff --git a/src/interp/clammed.boot b/src/interp/clammed.boot index 022c31f9..79e9e788 100644 --- a/src/interp/clammed.boot +++ b/src/interp/clammed.boot @@ -109,7 +109,7 @@ isValidType form == form is ['Expression, ['Kernel, . ]] => nil form is [op,:argl] => not constructor? op => nil - cosig := getDualSignatureFromDB op + cosig := getDualSignature op cosig and null rest cosig => -- niladic constructor null argl => true false diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp index cd43e7d8..d434ba69 100644 --- a/src/interp/daase.lisp +++ b/src/interp/daase.lisp @@ -761,7 +761,7 @@ (format t "~&~a: ~a~%" 'constructorkind (|getConstructorKindFromDB| constructor)) (format t "~a: ~a~%" 'cosig - (|getDualSignatureFromDB| constructor)) + (|getDualSignature| constructor)) (format t "~a: ~a~%" 'operation (|getOperationFromDB| constructor)) (format t "~a: ~%" 'constructormodemap) diff --git a/src/interp/database.boot b/src/interp/database.boot index 22af0aac..632867f3 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -113,13 +113,14 @@ getConstructorArgsFromDB ctor == ++ returns a list of Boolean values indicating whether the ++ parameter type at the corresponding position is a category. -getDualSignatureFromDB: %Constructor -> %Form -getDualSignatureFromDB ctor == - GETDATABASE(ctor,"COSIG") +getDualSignature: %Constructor -> %Form +getDualSignature ctor == + db := constructorDB ctor or return nil + dbDualSignature db or GETDATABASE(ctor,'COSIG) getConstructorPredicates: %Constructor -> %List %Thing getConstructorPredicates ctor == - dbPredicates loadDBIfnecessary constructorDB ctor + dbPredicates loadDBIfNecessary constructorDB ctor getConstructorParentsFromDB: %Constructor -> %List %Constructor getConstructorParentsFromDB ctor == @@ -131,7 +132,7 @@ getSuperDomainFromDB ctor == getConstructorAttributes: %Constructor -> %Form getConstructorAttributes ctor == - dbAttributes loadDBIfnecessary constructorDB ctor + dbAttributes loadDBIfNecessary constructorDB ctor niladicConstructor?: %Constructor -> %Boolean niladicConstructor? ctor == @@ -829,7 +830,7 @@ printAllInitdbInfo(srcdir,dbfile) == dbLoaded? db == dbLoadPath db ~= nil -loadDBIfnecessary db == +loadDBIfNecessary db == ctor := dbConstructor db dbLoaded? db => db loadLib ctor or return nil diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index c1e8e281..6b76c32e 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -119,9 +119,9 @@ superType: %Mode -> %Maybe %Mode superType dom == dom = "$" => superType $functorForm dom isnt [ctor,:args] => nil - [super,.] := - (db := constructorDB ctor) and dbBeingDefined? db => - dbSuperDomain db or return nil + [super,.] := + db := constructorDB ctor or return nil + dbBeingDefined? db => dbSuperDomain db or return nil getSuperDomainFromDB ctor or return nil sublisFormal(args,super,$AtVariables) diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot index 2c7e4283..1a0e5ec0 100644 --- a/src/interp/i-coerce.boot +++ b/src/interp/i-coerce.boot @@ -1067,7 +1067,7 @@ coerceIntByMapInner(arg,[u1,:u2]) == coerceOrThrowFailure(arg,u1,u2) valueArgsEqual?(t1, t2) == -- returns true if the object-valued arguments to t1 and t2 are the same -- under coercion - coSig := rest getDualSignatureFromDB first t1 + coSig := rest getDualSignature first t1 constrSig := rest getConstructorSignature first t1 tl1 := replaceSharps(constrSig, t1) tl2 := replaceSharps(constrSig, t2) diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot index 8b10a9ac..c6fafef5 100644 --- a/src/interp/i-eval.boot +++ b/src/interp/i-eval.boot @@ -59,7 +59,7 @@ mkEvalable form == constructor? op and argl = nil => form loadIfNecessary op kind:= getConstructorKindFromDB op - cosig := getDualSignatureFromDB op => + cosig := getDualSignature op => [op,:[val for x in argl for typeFlag in rest cosig]] where val() == typeFlag => kind = "category" => MKQ x diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot index a09c86d4..9b1bd614 100644 --- a/src/interp/i-funsel.boot +++ b/src/interp/i-funsel.boot @@ -1250,7 +1250,7 @@ coerceTypeArgs(t1, t2, SL) == -- if needed. t1 isnt [con1, :args1] or t2 isnt [con2, :args2] => t2 con1 ~= con2 => t2 - coSig := rest getDualSignatureFromDB first t1 + coSig := rest getDualSignature first t1 and/coSig => t2 csub1 := constructSubst t1 csub2 := constructSubst t2 diff --git a/src/interp/i-resolv.boot b/src/interp/i-resolv.boot index bada82b8..217d81ad 100644 --- a/src/interp/i-resolv.boot +++ b/src/interp/i-resolv.boot @@ -341,7 +341,7 @@ resolveTTRed3(t) == (and/[member(x,a) for x in b] and "and"/[member(x,b) for x in a]) and a [(x isnt [.,:.] and x ) or ((not cs and x and not interpOp? x and x) or resolveTTRed3 x) or return nil - for x in t for cs in getDualSignatureFromDB first t ] + for x in t for cs in getDualSignature t.op ] interpOp?(op) == cons?(op) and @@ -755,7 +755,7 @@ replaceLast(A,t) == destructT(functor)== -- provides a list of booleans, which indicate whether the arguments -- to the functor are category forms or not - getDualSignatureFromDB opOf functor + getDualSignature opOf functor constructTowerT(t,TL) == -- t is a type, TL a list of constructors and argument lists diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index b992cc6c..abdf8e04 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -610,7 +610,8 @@ finalizeLisplib(ctor,libName) == writeAbbreviation(db,$libFile) writePrincipals(ctor,removeZeroOne dbPrincipals db,$libFile) writeAncestors(ctor,removeZeroOne dbAncestors db,$libFile) - lisplibWrite('"documentation",finalizeDocumentation ctor,$libFile) + if not $bootStrapMode then + lisplibWrite('"documentation",finalizeDocumentation ctor,$libFile) if $profileCompiler then profileWrite() leaveIfErrors(libName,kind) true @@ -803,12 +804,10 @@ isFunctor x == op in '(SubDomain Union Record Enumeration) => true --FIXME: above should use builtinFunctionName?. Change when --FIXME: Mapping acquire first class functorship. - getConstructorAbbreviationFromDB op => - if getConstructorKindFromDB op = "category" - then updateCategoryFrameForCategory op - else updateCategoryFrameForConstructor op - get(op,'isFunctor,$CategoryFrame) - nil + kind := getConstructorKindFromDB op + kind = nil or kind = 'category => false + updateCategoryFrameForConstructor op + get(op,'isFunctor,$CategoryFrame) --% diff --git a/src/interp/metalex.lisp b/src/interp/metalex.lisp index a5ab0393..6ba27c7c 100644 --- a/src/interp/metalex.lisp +++ b/src/interp/metalex.lisp @@ -684,7 +684,7 @@ as keywords.") (#\Return (moan "String should fit on one line!") (advance-char) - (meta-syntax-error) + (spad_syntax_error) (return nil)) (t (suffix (current-char) buf) (advance-char)))))))) @@ -707,7 +707,7 @@ as keywords.") (#\Return (moan "String should fit on one line!") (advance-char) - (meta-syntax-error) + (spad_syntax_error) (return nil)) (t (suffix (current-char) buf) (advance-char)))))))) diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 65ada6f5..0215f047 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -303,7 +303,7 @@ NRTaddInner x == builtinConstructor? x.op or x.op is "[||]" => for y in x.args repeat NRTinnerGetLocalIndex y - cosig := getDualSignatureFromDB x.op => + cosig := getDualSignature x.op => for y in x.args for t in cosig.source | y isnt '$ and t repeat NRTinnerGetLocalIndex y keyedSystemError("S2NR0003",[x]) diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index e6dcba83..f5afe44c 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -391,7 +391,7 @@ lazyMatch(source,lazyt,dollar,domain) == for [.,stag,s] in sargl for [.,atag,a] in argl] generalizedBuiltinConstructor? op => and/[lazyMatchArg(s,a,dollar,domain) for s in sargl for a in argl] - coSig := getDualSignatureFromDB op + coSig := getDualSignature op null coSig => error ["bad Constructor op", op] and/[lazyMatchArg2(s,a,dollar,domain,flag) for s in sargl for a in argl for flag in rest coSig] @@ -409,7 +409,7 @@ lazyMatch(source,lazyt,dollar,domain) == lazyMatchArgDollarCheck(s,d,dollarName,domainName) == #s ~= #d => nil - scoSig := getDualSignatureFromDB opOf s or return nil + scoSig := getDualSignature opOf s or return nil if opOf s in '(Union Mapping Record) then scoSig := [true for x in s] and/[fn for x in rest s for arg in rest d for xt in rest scoSig] where @@ -471,7 +471,7 @@ newExpandLocalTypeForm([functorName,:argl],dollar,domain) == functorName is "QUOTE" => [functorName,:argl] builtinConstructor? functorName => [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,true) for a in argl]] - coSig := getDualSignatureFromDB functorName or + coSig := getDualSignature functorName or error ["unknown constructor name", functorName] [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,flag) for a in argl for flag in rest coSig]] diff --git a/src/interp/parsing.lisp b/src/interp/parsing.lisp index 81d34c83..52374f11 100644 --- a/src/interp/parsing.lisp +++ b/src/interp/parsing.lisp @@ -148,7 +148,7 @@ the stack, then stack a NIL. Return the value of prod." prodvalue))))) (defmacro must (dothis &optional (this-is nil) (in-rule nil)) - `(or ,dothis (meta-syntax-error ,this-is ,in-rule))) + `(or ,dothis (spad_syntax_error ,this-is ,in-rule))) ; Optional means that if it is present in the token stream, that is a good thing, ; otherwise don't worry (like [ foo ] in BNF notation). @@ -250,7 +250,7 @@ the stack, then stack a NIL. Return the value of prod." (or (funcall procfun (pop-stack-1)))) (go top)) ((compfin) (return 't)) ) - (meta-syntax-error) + (spad_syntax_error) (go top))) (defun termchr () "Is CHR a terminating character?" diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot index bc2366ec..2aefc81d 100644 --- a/src/interp/sys-constants.boot +++ b/src/interp/sys-constants.boot @@ -702,3 +702,8 @@ $OperatorFunctionNames == "+", "-", ">", ">=", "=", "~=", "<", "<=", "#", "~", "not", "case", "and", "or", "<<", ">>", "/\", "\/" ] +--% +%categoryKind == 'category +%domainKind == 'domain +%packageKind == 'package + diff --git a/src/share/algebra/browse.daase b/src/share/algebra/browse.daase index 892061de..4c8aa1d0 100644 --- a/src/share/algebra/browse.daase +++ b/src/share/algebra/browse.daase @@ -1,5 +1,5 @@ -(2276909 . 3524395028) +(2276909 . 3524422413) (-18 A S) ((|constructor| (NIL "One-dimensional-array aggregates serves as models for one-dimensional arrays. Categorically,{} these aggregates are finite linear aggregates with the \\spadatt{shallowlyMutable} property,{} that is,{} any component of the array may be changed without affecting the identity of the overall array. Array data structures are typically represented by a fixed area in storage and therefore cannot efficiently grow or shrink on demand as can list structures (see however \\spadtype{FlexibleArray} for a data structure which is a cross between a list and an array). Iteration over,{} and access to,{} elements of arrays is extremely fast (and often can be optimized to open-code). Insertion and deletion however is generally slow since an entirely new data structure must be created for the result."))) NIL diff --git a/src/share/algebra/category.daase b/src/share/algebra/category.daase index eaa75040..f2f00f2b 100644 --- a/src/share/algebra/category.daase +++ b/src/share/algebra/category.daase @@ -1,5 +1,5 @@ -(207263 . 3524395032) +(207263 . 3524422417) ((((-877)) . T)) ((((-877)) . T)) ((((-877)) . T)) diff --git a/src/share/algebra/compress.daase b/src/share/algebra/compress.daase index 22c83bd1..1368142b 100644 --- a/src/share/algebra/compress.daase +++ b/src/share/algebra/compress.daase @@ -1,5 +1,5 @@ -(30 . 3524395027) +(30 . 3524422412) (4428 |Enumeration| |Mapping| |Record| |Union| |ofCategory| |isDomain| ATTRIBUTE |package| |domain| |category| CATEGORY |nobranch| AND |Join| |ofType| SIGNATURE "failed" "algebra" |OneDimensionalArrayAggregate&| diff --git a/src/share/algebra/interp.daase b/src/share/algebra/interp.daase index 3b7ab6bc..4668906c 100644 --- a/src/share/algebra/interp.daase +++ b/src/share/algebra/interp.daase @@ -1,5 +1,5 @@ -(3096904 . 3524395039) +(3096904 . 3524422425) ((-1935 (((-114) (-1 (-114) |#2| |#2|) $) 86 T ELT) (((-114) $) NIL T ELT)) (-1933 (($ (-1 (-114) |#2| |#2|) $) 18 T ELT) (($ $) NIL T ELT)) (-4218 ((|#2| $ (-558) |#2|) NIL T ELT) ((|#2| $ (-1255 (-558)) |#2|) 44 T ELT)) (-2510 (($ $) 80 T ELT)) (-4272 ((|#2| (-1 |#2| |#2| |#2|) $ |#2| |#2|) 52 T ELT) ((|#2| (-1 |#2| |#2| |#2|) $ |#2|) 50 T ELT) ((|#2| (-1 |#2| |#2| |#2|) $) 49 T ELT)) (-3839 (((-558) (-1 (-114) |#2|) $) 27 T ELT) (((-558) |#2| $) NIL T ELT) (((-558) |#2| $ (-558)) 96 T ELT)) (-3290 (((-661 |#2|) $) 13 T ELT)) (-3938 (($ (-1 (-114) |#2| |#2|) $ $) 64 T ELT) (($ $ $) NIL T ELT)) (-2160 (($ (-1 |#2| |#2|) $) 37 T ELT)) (-4388 (($ (-1 |#2| |#2|) $) NIL T ELT) (($ (-1 |#2| |#2| |#2|) $ $) 60 T ELT)) (-2517 (($ |#2| $ (-558)) NIL T ELT) (($ $ $ (-558)) 67 T ELT)) (-1468 (((-3 |#2| "failed") (-1 (-114) |#2|) $) 29 T ELT)) (-2158 (((-114) (-1 (-114) |#2|) $) 23 T ELT)) (-4230 ((|#2| $ (-558) |#2|) NIL T ELT) ((|#2| $ (-558)) NIL T ELT) (($ $ (-1255 (-558))) 66 T ELT)) (-2518 (($ $ (-558)) 76 T ELT) (($ $ (-1255 (-558))) 75 T ELT)) (-2157 (((-791) (-1 (-114) |#2|) $) 34 T ELT) (((-791) |#2| $) NIL T ELT)) (-1934 (($ $ $ (-558)) 69 T ELT)) (-3820 (($ $) 68 T ELT)) (-3950 (($ (-661 |#2|)) 73 T ELT)) (-4232 (($ $ |#2|) NIL T ELT) (($ |#2| $) NIL T ELT) (($ $ $) 87 T ELT) (($ (-661 $)) 85 T ELT)) (-4376 (((-877) $) 92 T ELT)) (-2159 (((-114) (-1 (-114) |#2|) $) 22 T ELT)) (-3454 (((-114) $ $) 95 T ELT)) (-3086 (((-114) $ $) 99 T ELT))) (((-18 |#1| |#2|) (-10 -7 (-15 -3454 ((-114) |#1| |#1|)) (-15 -4376 ((-877) |#1|)) (-15 -3086 ((-114) |#1| |#1|)) (-15 -1933 (|#1| |#1|)) (-15 -1933 (|#1| (-1 (-114) |#2| |#2|) |#1|)) (-15 -2510 (|#1| |#1|)) (-15 -1934 (|#1| |#1| |#1| (-558))) (-15 -1935 ((-114) |#1|)) (-15 -3938 (|#1| |#1| |#1|)) (-15 -3839 ((-558) |#2| |#1| (-558))) (-15 -3839 ((-558) |#2| |#1|)) (-15 -3839 ((-558) (-1 (-114) |#2|) |#1|)) (-15 -1935 ((-114) (-1 (-114) |#2| |#2|) |#1|)) (-15 -3938 (|#1| (-1 (-114) |#2| |#2|) |#1| |#1|)) (-15 -4218 (|#2| |#1| (-1255 (-558)) |#2|)) (-15 -2517 (|#1| |#1| |#1| (-558))) (-15 -2517 (|#1| |#2| |#1| (-558))) (-15 -2518 (|#1| |#1| (-1255 (-558)))) (-15 -2518 (|#1| |#1| (-558))) (-15 -4388 (|#1| (-1 |#2| |#2| |#2|) |#1| |#1|)) (-15 -4232 (|#1| (-661 |#1|))) (-15 -4232 (|#1| |#1| |#1|)) (-15 -4232 (|#1| |#2| |#1|)) (-15 -4232 (|#1| |#1| |#2|)) (-15 -4230 (|#1| |#1| (-1255 (-558)))) (-15 -3950 (|#1| (-661 |#2|))) (-15 -1468 ((-3 |#2| "failed") (-1 (-114) |#2|) |#1|)) (-15 -4272 (|#2| (-1 |#2| |#2| |#2|) |#1|)) (-15 -4272 (|#2| (-1 |#2| |#2| |#2|) |#1| |#2|)) (-15 -4272 (|#2| (-1 |#2| |#2| |#2|) |#1| |#2| |#2|)) (-15 -4230 (|#2| |#1| (-558))) (-15 -4230 (|#2| |#1| (-558) |#2|)) (-15 -4218 (|#2| |#1| (-558) |#2|)) (-15 -2157 ((-791) |#2| |#1|)) (-15 -3290 ((-661 |#2|) |#1|)) (-15 -2157 ((-791) (-1 (-114) |#2|) |#1|)) (-15 -2158 ((-114) (-1 (-114) |#2|) |#1|)) (-15 -2159 ((-114) (-1 (-114) |#2|) |#1|)) (-15 -2160 (|#1| (-1 |#2| |#2|) |#1|)) (-15 -4388 (|#1| (-1 |#2| |#2|) |#1|)) (-15 -3820 (|#1| |#1|))) (-19 |#2|) (-1238)) (T -18)) NIL @@ -3447,7 +3447,7 @@ NIL ((-3453 (((-2 (|:| -3684 |#2|) (|:| -2909 (-661 |#1|))) |#2| (-661 |#1|)) 32 T ELT) ((|#2| |#2| |#1|) 27 T ELT))) (((-1046 |#1| |#2|) (-10 -7 (-15 -3453 (|#2| |#2| |#1|)) (-15 -3453 ((-2 (|:| -3684 |#2|) (|:| -2909 (-661 |#1|))) |#2| (-661 |#1|)))) (-376) (-678 |#1|)) (T -1046)) ((-3453 (*1 *2 *3 *4) (-12 (-4 *5 (-376)) (-5 *2 (-2 (|:| -3684 *3) (|:| -2909 (-661 *5)))) (-5 *1 (-1046 *5 *3)) (-5 *4 (-661 *5)) (-4 *3 (-678 *5)))) (-3453 (*1 *2 *2 *3) (-12 (-4 *3 (-376)) (-5 *1 (-1046 *3 *2)) (-4 *2 (-678 *3))))) -((-2967 (((-114) $ $) NIL (|has| |#1| (-1122)) ELT)) (-3455 ((|#1| $ |#1|) 14 T ELT)) (-4218 ((|#1| $ |#1|) 12 T ELT)) (-3457 (($ |#1|) 10 T ELT)) (-3660 (((-1180) $) NIL (|has| |#1| (-1122)) ELT)) (-3661 (((-1141) $) NIL (|has| |#1| (-1122)) ELT)) (-4230 ((|#1| $) 11 T ELT)) (-3456 ((|#1| $) 13 T ELT)) (-4376 (((-877) $) 21 (|has| |#1| (-1122)) ELT)) (-1378 (((-114) $ $) NIL (|has| |#1| (-1122)) ELT)) (-3454 (((-114) $ $) 9 T ELT))) +((-2967 (((-114) $ $) NIL (|has| |#1| (-1122)) ELT)) (-3455 ((|#1| $ |#1|) 14 T ELT)) (-4218 ((|#1| $ |#1|) 12 T ELT)) (-3457 (($ |#1|) 10 T ELT)) (-3660 (((-1180) $) NIL (|has| |#1| (-1122)) ELT)) (-3661 (((-1141) $) NIL (|has| |#1| (-1122)) ELT)) (-4230 ((|#1| $) 11 T ELT)) (-3456 ((|#1| $) 13 T ELT)) (-4376 (((-877) $) 19 (|has| |#1| (-1122)) ELT)) (-1378 (((-114) $ $) NIL (|has| |#1| (-1122)) ELT)) (-3454 (((-114) $ $) 9 T ELT))) (((-1047 |#1|) (-13 (-1238) (-10 -8 (-15 -3457 ($ |#1|)) (-15 -4230 (|#1| $)) (-15 -4218 (|#1| $ |#1|)) (-15 -3456 (|#1| $)) (-15 -3455 (|#1| $ |#1|)) (-15 -3454 ((-114) $ $)) (IF (|has| |#1| (-1122)) (-6 (-1122)) |%noBranch|))) (-1238)) (T -1047)) ((-3457 (*1 *1 *2) (-12 (-5 *1 (-1047 *2)) (-4 *2 (-1238)))) (-4230 (*1 *2 *1) (-12 (-5 *1 (-1047 *2)) (-4 *2 (-1238)))) (-4218 (*1 *2 *1 *2) (-12 (-5 *1 (-1047 *2)) (-4 *2 (-1238)))) (-3456 (*1 *2 *1) (-12 (-5 *1 (-1047 *2)) (-4 *2 (-1238)))) (-3455 (*1 *2 *1 *2) (-12 (-5 *1 (-1047 *2)) (-4 *2 (-1238)))) (-3454 (*1 *2 *1 *1) (-12 (-5 *2 (-114)) (-5 *1 (-1047 *3)) (-4 *3 (-1238))))) ((-2967 (((-114) $ $) NIL T ELT)) (-4111 (((-661 (-2 (|:| -4291 $) (|:| -1905 (-661 |#4|)))) (-661 |#4|)) NIL T ELT)) (-4112 (((-661 $) (-661 |#4|)) 117 T ELT) (((-661 $) (-661 |#4|) (-114)) 118 T ELT) (((-661 $) (-661 |#4|) (-114) (-114)) 116 T ELT) (((-661 $) (-661 |#4|) (-114) (-114) (-114) (-114)) 119 T ELT)) (-3484 (((-661 |#3|) $) NIL T ELT)) (-3309 (((-114) $) NIL T ELT)) (-3300 (((-114) $) NIL (|has| |#1| (-569)) ELT)) (-4123 (((-114) |#4| $) NIL T ELT) (((-114) $) NIL T ELT)) (-4118 ((|#4| |#4| $) NIL T ELT)) (-4205 (((-661 (-2 (|:| |val| |#4|) (|:| -1743 $))) |#4| $) 111 T ELT)) (-3310 (((-2 (|:| |under| $) (|:| -3532 $) (|:| |upper| $)) $ |#3|) NIL T ELT)) (-4140 (($ (-1 (-114) |#4|) $) NIL (|has| $ (-6 -4425)) ELT) (((-3 |#4| #1="failed") $ |#3|) 66 T ELT)) (-4154 (($) NIL T CONST)) (-3305 (((-114) $) 29 (|has| |#1| (-569)) ELT)) (-3307 (((-114) $ $) NIL (|has| |#1| (-569)) ELT)) (-3306 (((-114) $ $) NIL (|has| |#1| (-569)) ELT)) (-3308 (((-114) $) NIL (|has| |#1| (-569)) ELT)) (-4119 (((-661 |#4|) (-661 |#4|) $ (-1 |#4| |#4| |#4|) (-1 (-114) |#4| |#4|)) NIL T ELT)) (-3301 (((-661 |#4|) (-661 |#4|) $) NIL (|has| |#1| (-569)) ELT)) (-3302 (((-661 |#4|) (-661 |#4|) $) NIL (|has| |#1| (-569)) ELT)) (-3575 (((-3 $ #1#) (-661 |#4|)) NIL T ELT)) (-3574 (($ (-661 |#4|)) NIL T ELT)) (-4229 (((-3 $ #1#) $) 45 T ELT)) (-4115 ((|#4| |#4| $) 69 T ELT)) (-1467 (($ $) NIL (-12 (|has| $ (-6 -4425)) (|has| |#4| (-1122))) ELT)) (-3826 (($ |#4| $) NIL (-12 (|has| $ (-6 -4425)) (|has| |#4| (-1122))) ELT) (($ (-1 (-114) |#4|) $) NIL (|has| $ (-6 -4425)) ELT)) (-3303 (((-2 (|:| |rnum| |#1|) (|:| |polnum| |#4|) (|:| |den| |#1|)) |#4| $) 84 (|has| |#1| (-569)) ELT)) (-4124 (((-114) |#4| $ (-1 (-114) |#4| |#4|)) NIL T ELT)) (-4113 ((|#4| |#4| $) NIL T ELT)) (-4272 ((|#4| (-1 |#4| |#4| |#4|) $ |#4| |#4|) NIL (-12 (|has| $ (-6 -4425)) (|has| |#4| (-1122))) ELT) ((|#4| (-1 |#4| |#4| |#4|) $ |#4|) NIL (|has| $ (-6 -4425)) ELT) ((|#4| (-1 |#4| |#4| |#4|) $) NIL (|has| $ (-6 -4425)) ELT) ((|#4| |#4| $ (-1 |#4| |#4| |#4|) (-1 (-114) |#4| |#4|)) NIL T ELT)) (-4126 (((-2 (|:| -4291 (-661 |#4|)) (|:| -1905 (-661 |#4|))) $) NIL T ELT)) (-3615 (((-114) |#4| $) NIL T ELT)) (-3613 (((-114) |#4| $) NIL T ELT)) (-3616 (((-114) |#4| $) NIL T ELT) (((-114) $) NIL T ELT)) (-3858 (((-2 (|:| |val| (-661 |#4|)) (|:| |towers| (-661 $))) (-661 |#4|) (-114) (-114)) 132 T ELT)) (-3290 (((-661 |#4|) $) 18 (|has| $ (-6 -4425)) ELT)) (-4125 (((-114) |#4| $) NIL T ELT) (((-114) $) NIL T ELT)) (-3598 ((|#3| $) 38 T ELT)) (-3007 (((-661 |#4|) $) 19 (|has| $ (-6 -4425)) ELT)) (-3663 (((-114) |#4| $) 27 (-12 (|has| $ (-6 -4425)) (|has| |#4| (-1122))) ELT)) (-2160 (($ (-1 |#4| |#4|) $) 25 (|has| $ (-6 -4426)) ELT)) (-4388 (($ (-1 |#4| |#4|) $) 23 T ELT)) (-3315 (((-661 |#3|) $) NIL T ELT)) (-3314 (((-114) |#3| $) NIL T ELT)) (-3660 (((-1180) $) NIL T ELT)) (-3609 (((-3 |#4| (-661 $)) |#4| |#4| $) NIL T ELT)) (-3608 (((-661 (-2 (|:| |val| |#4|) (|:| -1743 $))) |#4| |#4| $) 109 T ELT)) (-4228 (((-3 |#4| #1#) $) 42 T ELT)) (-3610 (((-661 $) |#4| $) 92 T ELT)) (-3612 (((-3 (-114) (-661 $)) |#4| $) NIL T ELT)) (-3611 (((-661 (-2 (|:| |val| (-114)) (|:| -1743 $))) |#4| $) 102 T ELT) (((-114) |#4| $) 64 T ELT)) (-3656 (((-661 $) |#4| $) 114 T ELT) (((-661 $) (-661 |#4|) $) NIL T ELT) (((-661 $) (-661 |#4|) (-661 $)) 115 T ELT) (((-661 $) |#4| (-661 $)) NIL T ELT)) (-3859 (((-661 $) (-661 |#4|) (-114) (-114) (-114)) 127 T ELT)) (-3860 (($ |#4| $) 81 T ELT) (($ (-661 |#4|) $) 82 T ELT) (((-661 $) |#4| $ (-114) (-114) (-114) (-114) (-114)) 78 T ELT)) (-4127 (((-661 |#4|) $) NIL T ELT)) (-4121 (((-114) |#4| $) NIL T ELT) (((-114) $) NIL T ELT)) (-4116 ((|#4| |#4| $) NIL T ELT)) (-4129 (((-114) $ $) NIL T ELT)) (-3304 (((-2 (|:| |num| |#4|) (|:| |den| |#1|)) |#4| $) NIL (|has| |#1| (-569)) ELT)) (-4122 (((-114) |#4| $) NIL T ELT) (((-114) $) NIL T ELT)) (-4117 ((|#4| |#4| $) NIL T ELT)) (-3661 (((-1141) $) NIL T ELT)) (-4231 (((-3 |#4| #1#) $) 40 T ELT)) (-1468 (((-3 |#4| #1#) (-1 (-114) |#4|) $) NIL T ELT)) (-4109 (((-3 $ #1#) $ |#4|) 59 T ELT)) (-4199 (($ $ |#4|) NIL T ELT) (((-661 $) |#4| $) 94 T ELT) (((-661 $) |#4| (-661 $)) NIL T ELT) (((-661 $) (-661 |#4|) $) NIL T ELT) (((-661 $) (-661 |#4|) (-661 $)) 88 T ELT)) (-2158 (((-114) (-1 (-114) |#4|) $) NIL (|has| $ (-6 -4425)) ELT)) (-4198 (($ $ (-661 |#4|) (-661 |#4|)) NIL (-12 (|has| |#4| (-321 |#4|)) (|has| |#4| (-1122))) ELT) (($ $ |#4| |#4|) NIL (-12 (|has| |#4| (-321 |#4|)) (|has| |#4| (-1122))) ELT) (($ $ (-305 |#4|)) NIL (-12 (|has| |#4| (-321 |#4|)) (|has| |#4| (-1122))) ELT) (($ $ (-661 (-305 |#4|))) NIL (-12 (|has| |#4| (-321 |#4|)) (|has| |#4| (-1122))) ELT)) (-1329 (((-114) $ $) NIL T ELT)) (-3823 (((-114) $) 17 T ELT)) (-3993 (($) 14 T ELT)) (-4378 (((-791) $) NIL T ELT)) (-2157 (((-791) |#4| $) NIL (-12 (|has| $ (-6 -4425)) (|has| |#4| (-1122))) ELT) (((-791) (-1 (-114) |#4|) $) NIL (|has| $ (-6 -4425)) ELT)) (-3820 (($ $) 13 T ELT)) (-4402 (((-547) $) NIL (|has| |#4| (-631 (-547))) ELT)) (-3950 (($ (-661 |#4|)) 22 T ELT)) (-3311 (($ $ |#3|) 52 T ELT)) (-3313 (($ $ |#3|) 54 T ELT)) (-4114 (($ $) NIL T ELT)) (-3312 (($ $ |#3|) NIL T ELT)) (-4376 (((-877) $) 35 T ELT) (((-661 |#4|) $) 46 T ELT)) (-4108 (((-791) $) NIL (|has| |#3| (-381)) ELT)) (-1378 (((-114) $ $) NIL T ELT)) (-4128 (((-3 (-2 (|:| |bas| $) (|:| -3744 (-661 |#4|))) #1#) (-661 |#4|) (-1 (-114) |#4| |#4|)) NIL T ELT) (((-3 (-2 (|:| |bas| $) (|:| -3744 (-661 |#4|))) #1#) (-661 |#4|) (-1 (-114) |#4|) (-1 (-114) |#4| |#4|)) NIL T ELT)) (-4120 (((-114) $ (-1 (-114) |#4| (-661 |#4|))) NIL T ELT)) (-3607 (((-661 $) |#4| $) 91 T ELT) (((-661 $) |#4| (-661 $)) NIL T ELT) (((-661 $) (-661 |#4|) $) NIL T ELT) (((-661 $) (-661 |#4|) (-661 $)) NIL T ELT)) (-2159 (((-114) (-1 (-114) |#4|) $) NIL (|has| $ (-6 -4425)) ELT)) (-4110 (((-661 |#3|) $) NIL T ELT)) (-3614 (((-114) |#4| $) NIL T ELT)) (-4363 (((-114) |#3| $) 65 T ELT)) (-3454 (((-114) $ $) NIL T ELT)) (-4387 (((-791) $) NIL (|has| $ (-6 -4425)) ELT))) diff --git a/src/share/algebra/operation.daase b/src/share/algebra/operation.daase index 43e8ca69..55892982 100644 --- a/src/share/algebra/operation.daase +++ b/src/share/algebra/operation.daase @@ -1,5 +1,5 @@ -(719417 . 3524395030) +(719417 . 3524422414) (((*1 *2 *3 *4) (|partial| -12 (-5 *3 (-1288 *4)) (-4 *4 (-13 (-1070) (-658 (-558)))) (-5 *2 (-1288 (-419 (-558)))) (-5 *1 (-1317 *4))))) |