|
|
|
last edited 13 years ago by test1 |
| 1 2 3 4 | ||
|
Editor: Bill Page
Time: 2008/12/03 09:34:06 GMT-8 |
||
| Note: "built-in" logic for SubDomain | ||
added: Algebra SandBoxNonZeroInteger is an attempt to define the domain of Integers without 0 as a SubDomain. changed: -NonZeroInteger: Join(OrderedAbelianSemiGroup, Monoid, CommutativeStar,CoercibleTo(Integer)) with NonZeroInteger: Join(OrderedAbelianSemiGroup, Monoid, CommutativeStar --,CoercibleTo(Integer) ) with changed: - retract:Integer->% - retractIfCan:Integer->Union(%,"failed") - retract:NonNegativeInteger->% - retractIfCan:NonNegativeInteger->Union(%,"failed") - convert:NonNegativeInteger->% --retract:Integer->% --retractIfCan:Integer->Union(%,"failed") --retract:NonNegativeInteger->% --retractIfCan:NonNegativeInteger->Union(%,"failed") --convert:NonNegativeInteger->% changed: - coerce(x):Integer == x pretend Integer - retract(z)== z pretend % - convert(nz):% == retract(nz) - retractIfCan(z) == - zero?(z) => "failed" - retract(z) - retract(nz)== nz pretend % - retractIfCan(nz) == - zero?(nz) => "failed" - retract(nz) --coerce(x):Integer == x pretend Integer --retract(z)== z pretend % --convert(nz):% == retract(nz) --retractIfCan(z) == -- zero?(z) => "failed" -- retract(z) --retract(nz)== nz pretend % --retractIfCan(nz) == -- zero?(nz) => "failed" -- retract(nz) added: Built-in There are at least two places where critical knowledge of sub-domains is built into FriCAS. In 'src/interp/i-util.boot' we must extend the 'subDomainList': \begin{boot} isSubDomain(d1,d2) == -- d1 and d2 are different domains --subDomainList := '(Integer NonNegativeInteger PositiveInteger) subDomainList := '(Integer NonZeroInteger NonNegativeInteger PositiveInteger) ATOM d1 or ATOM d2 => nil l := MEMQ(CAR d2, subDomainList) => MEMQ(CAR d1, CDR l) nil \end{boot} In 'src/interp/daase.lisp' we need to make sure 'NonZeroInteger' is known to have a 'superdomain': \begin{lisp} (defun getdatabase (constructor key) (declare (special $spadroot) (special *miss*)) (when (eq *miss* t) (format t "getdatabase call: ~20a ~a~%" constructor key)) (let (data table stream ignore struct) (declare (ignore ignore)) (when (or (symbolp constructor) (and (eq key 'hascategory) (pairp constructor))) (case key ; note that abbreviation, constructorkind and cosig are heavy hitters ; thus they occur first in the list of things to check (abbreviation (setq stream *interp-stream*) (when (setq struct (get constructor 'database)) (setq data (database-abbreviation struct)))) (constructorkind (setq stream *interp-stream*) (when (setq struct (get constructor 'database)) (setq data (database-constructorkind struct)))) (cosig (setq stream *interp-stream*) (when (setq struct (get constructor 'database)) (setq data (database-cosig struct)))) (operation (setq stream *operation-stream*) (setq data (gethash constructor *operation-hash*))) (constructormodemap (setq stream *interp-stream*) (when (setq struct (get constructor 'database)) (setq data (database-constructormodemap struct)))) (constructorcategory (setq stream *interp-stream*) (when (setq struct (get constructor 'database)) (setq data (database-constructorcategory struct)) (when (null data) ;domain or package then subfield of constructormodemap (setq data (cadar (getdatabase constructor 'constructormodemap)))))) (operationalist (setq stream *interp-stream*) (when (setq struct (get constructor 'database)) (setq data (database-operationalist struct)))) (modemaps (setq stream *interp-stream*) (when (setq struct (get constructor 'database)) (setq data (database-modemaps struct)))) (hascategory (setq table *hasCategory-hash*) (setq stream *category-stream*) (setq data (gethash constructor table))) (object (setq stream *interp-stream*) (when (setq struct (get constructor 'database)) (setq data (database-object struct)))) (asharp? (setq stream *interp-stream*) (when (setq struct (get constructor 'database)) (setq data (database-object struct)))) (niladic (setq stream *interp-stream*) (when (setq struct (get constructor 'database)) (setq data (database-niladic struct)))) (constructor? (when (setq struct (get constructor 'database)) (setq data (when (database-operationalist struct) t)))) ;(superdomain ; only 2 superdomains in the world ; (case constructor ; (|NonNegativeInteger| ; (setq data '((|Integer|) (IF (< |#1| 0) |false| |true|)))) ; (|PositiveInteger| ; (setq data '((|NonNegativeInteger|) (< 0 |#1|)))))) (superdomain ; 3 superdomains in the world (case constructor (|NonNegativeInteger| (setq data '((|Integer|) (IF (< |#1| 0) |false| |true|)))) (|NonZeroInteger| (setq data '((|Integer|) (IF (= |#1| 0) |false| |true|)))) (|PositiveInteger| (setq data '((|NonZeroInteger|) (< 0 |#1|)))))) (constructor (when (setq data (get constructor 'abbreviationfor)))) (defaultdomain (setq data (cadr (assoc constructor *defaultdomain-list*)))) (ancestors (setq stream *interp-stream*) (when (setq struct (get constructor 'database)) (setq data (database-ancestors struct)))) (sourcefile (setq stream *browse-stream*) (when (setq struct (get constructor 'database)) (setq data (database-sourcefile struct)))) (constructorform (setq stream *browse-stream*) (when (setq struct (get constructor 'database)) (setq data (database-constructorform struct)))) (constructorargs (setq data (cdr (getdatabase constructor 'constructorform)))) (attributes (setq stream *browse-stream*) (when (setq struct (get constructor 'database)) (setq data (database-attributes struct)))) (predicates (setq stream *browse-stream*) (when (setq struct (get constructor 'database)) (setq data (database-predicates struct)))) (documentation (setq stream *browse-stream*) (when (setq struct (get constructor 'database)) (setq data (database-documentation struct)))) (parents (setq stream *browse-stream*) (when (setq struct (get constructor 'database)) (setq data (database-parents struct)))) (users (setq stream *browse-stream*) (when (setq struct (get constructor 'database)) (setq data (database-users struct)))) (dependents (setq stream *browse-stream*) (when (setq struct (get constructor 'database)) (setq data (database-dependents struct)))) (otherwise (warn "~%(GETDATABASE ~a ~a) failed~%" constructor key))) (when (numberp data) ;fetch the real data (when *miss* (format t "getdatabase miss: ~20a ~a~%" constructor key)) (file-position stream data) (setq data (unsqueeze (read stream))) (case key ; cache the result of the database read (operation (setf (gethash constructor *operation-hash*) data)) (hascategory (setf (gethash constructor *hascategory-hash*) data)) (constructorkind (setf (database-constructorkind struct) data)) (cosig (setf (database-cosig struct) data)) (constructormodemap (setf (database-constructormodemap struct) data)) (constructorcategory (setf (database-constructorcategory struct) data)) (operationalist (setf (database-operationalist struct) data)) (modemaps (setf (database-modemaps struct) data)) (object (setf (database-object struct) data)) (niladic (setf (database-niladic struct) data)) (abbreviation (setf (database-abbreviation struct) data)) (constructor (setf (database-constructor struct) data)) (ancestors (setf (database-ancestors struct) data)) (constructorform (setf (database-constructorform struct) data)) (attributes (setf (database-attributes struct) data)) (predicates (setf (database-predicates struct) data)) (documentation (setf (database-documentation struct) data)) (parents (setf (database-parents struct) data)) (users (setf (database-users struct) data)) (dependents (setf (database-dependents struct) data)) (sourcefile (setf (database-sourcefile struct) data)))) (case key ; fixup the special cases (sourcefile (when (and data (string= (directory-namestring data) "") (string= (pathname-type data) "spad")) (setq data (concatenate 'string $spadroot "/../../src/algebra/" data)))) (asharp? ; is this asharp code? (if (consp data) (setq data (cdr data)) (setq data nil))) (object ; fix up system object pathname (if (consp data) (setq data (if (string= (directory-namestring (car data)) "") (concatenate 'string $spadroot "/algebra/" (car data) "." *lisp-bin-filetype*) (car data))) (when (and data (string= (directory-namestring data) "")) (setq data (concatenate 'string $spadroot "/algebra/" data "." *lisp-bin-filetype*))))))) data)) \end{lisp} \begin{axiom} isSubDomain(devaluate(NonNegativeInteger)$Lisp,devaluate(Integer)$Lisp)$Lisp isSubDomain(devaluate(PositiveInteger)$Lisp,devaluate(Integer)$Lisp)$Lisp isSubDomain(devaluate(NonZeroInteger)$Lisp,devaluate(Integer)$Lisp)$Lisp \end{axiom} changed: -i:NZINT:=1 -j:NZINT:=-1 i:NZINT := 1$NZINT i:NZINT := (1::Integer) i:NZINT := 1 \end{axiom} \begin{axiom} j:NZINT := -1 \end{axiom} \begin{axiom}
SandBoxNonZeroInteger? is an attempt to define the domain of Integers without 0 as a SubDomain?.
(1) -> <spad>
)abbrev domain NZINT NonZeroInteger NonZeroInteger: Join(OrderedAbelianSemiGroup,Monoid, CommutativeStar --, CoercibleTo(Integer) ) with gcd: (%, %) -> % ++ gcd(a, b) computes the greatest common divisor of two ++ positive integers \spad{a} and b. _-: % -> % --retract:Integer->% --retractIfCan:Integer->Union(%, "failed") --retract:NonNegativeInteger->% --retractIfCan:NonNegativeInteger->Union(%, "failed") --convert:NonNegativeInteger->% == SubDomain(Integer, #1 ~= 0) add Rep == Integer x:% y:% z:Integer nz:NonNegativeInteger -x == (-(x pretend Integer)) pretend % x+y == (z:=(x pretend Integer)+(y pretend Integer)) = 0 => error "zero" z pretend %
--coerce(x):Integer == x pretend Integer --retract(z)== z pretend % --convert(nz):% == retract(nz) --retractIfCan(z) == -- zero?(z) => "failed" -- retract(z) --retract(nz)== nz pretend % --retractIfCan(nz) == -- zero?(nz) => "failed" -- retract(nz)</spad>
Compiling FriCAS source code from file
/var/lib/zope2.10/instance/axiom-wiki/var/LatexWiki/3042217120178961765-25px001.spad
using system compiler.
NZINT abbreviates domain NonZeroInteger
------------------------------------------------------------------------
initializing NRLIB NZINT for NonZeroInteger
compiling into NRLIB NZINT
************* USER ERROR **********
available signatures for Rep:
NONE
NEED Rep: () -> ?
****** comp fails at level 1 with expression: ******
((DEF (|Rep|) (NIL) (|Integer|)))
****** level 1 ******
x:= (DEF (Rep) (NIL) (Integer))
m:= $EmptyMode
f:=
((((|#1| #) (* #) (+ #) (- #) ...)))
>> Apparent user error:
unspecified errorThere are at least two places where critical knowledge of sub-domains is built into FriCAS?.
In src/interp/i-util.boot we must extend the 'subDomainList':
isSubDomain(d1,d2) == -- d1 and d2 are different domains --subDomainList := '(Integer NonNegativeInteger PositiveInteger) subDomainList := '(Integer NonZeroInteger NonNegativeInteger PositiveInteger) ATOM d1 or ATOM d2 => nil l := MEMQ(CAR d2, subDomainList) => MEMQ(CAR d1, CDR l) nil
The file
/var/lib/zope2.10/instance/axiom-wiki/var/LatexWiki/1905831235319360423-25px002.boot
is needed but does not exist.In src/interp/daase.lisp we need to make sure NonZeroInteger is known to have a 'superdomain':
(defun getdatabase (constructor key)
(declare (special $spadroot) (special *miss*))
(when (eq *miss* t) (format t "getdatabase call: ~20a ~a~%" constructor key))
(let (data table stream ignore struct)
(declare (ignore ignore))
(when (or (symbolp constructor)
(and (eq key 'hascategory) (pairp constructor)))
(case key
; note that abbreviation, constructorkind and cosig are heavy hitters
; thus they occur first in the list of things to check
(abbreviation
(setq stream *interp-stream*)
(when (setq struct (get constructor 'database))
(setq data (database-abbreviation struct))))
(constructorkind
(setq stream *interp-stream*)
(when (setq struct (get constructor 'database))
(setq data (database-constructorkind struct))))
(cosig
(setq stream *interp-stream*)
(when (setq struct (get constructor 'database))
(setq data (database-cosig struct))))
(operation
(setq stream *operation-stream*)
(setq data (gethash constructor *operation-hash*)))
(constructormodemap
(setq stream *interp-stream*)
(when (setq struct (get constructor 'database))
(setq data (database-constructormodemap struct))))
(constructorcategory
(setq stream *interp-stream*)
(when (setq struct (get constructor 'database))
(setq data (database-constructorcategory struct))
(when (null data) ;domain or package then subfield of constructormodemap
(setq data (cadar (getdatabase constructor 'constructormodemap))))))
(operationalist
(setq stream *interp-stream*)
(when (setq struct (get constructor 'database))
(setq data (database-operationalist struct))))
(modemaps
(setq stream *interp-stream*)
(when (setq struct (get constructor 'database))
(setq data (database-modemaps struct))))
(hascategory
(setq table *hasCategory-hash*)
(setq stream *category-stream*)
(setq data (gethash constructor table)))
(object
(setq stream *interp-stream*)
(when (setq struct (get constructor 'database))
(setq data (database-object struct))))
(asharp?
(setq stream *interp-stream*)
(when (setq struct (get constructor 'database))
(setq data (database-object struct))))
(niladic
(setq stream *interp-stream*)
(when (setq struct (get constructor 'database))
(setq data (database-niladic struct))))
(constructor?
(when (setq struct (get constructor 'database))
(setq data (when (database-operationalist struct) t))))
;(superdomain ; only 2 superdomains in the world
; (case constructor
; (|NonNegativeInteger|
; (setq data '((|Integer|) (IF (< |#1| 0) |false| |true|))))
; (|PositiveInteger|
; (setq data '((|NonNegativeInteger|) (< 0 |#1|))))))
(superdomain ; 3 superdomains in the world
(case constructor
(|NonNegativeInteger|
(setq data '((|Integer|) (IF (< |#1| 0) |false| |true|))))
(|NonZeroInteger|
(setq data '((|Integer|) (IF (= |#1| 0) |false| |true|))))
(|PositiveInteger|
(setq data '((|NonZeroInteger|) (< 0 |#1|))))))
(constructor
(when (setq data (get constructor 'abbreviationfor))))
(defaultdomain
(setq data (cadr (assoc constructor *defaultdomain-list*))))
(ancestors
(setq stream *interp-stream*)
(when (setq struct (get constructor 'database))
(setq data (database-ancestors struct))))
(sourcefile
(setq stream *browse-stream*)
(when (setq struct (get constructor 'database))
(setq data (database-sourcefile struct))))
(constructorform
(setq stream *browse-stream*)
(when (setq struct (get constructor 'database))
(setq data (database-constructorform struct))))
(constructorargs
(setq data (cdr (getdatabase constructor 'constructorform))))
(attributes
(setq stream *browse-stream*)
(when (setq struct (get constructor 'database))
(setq data (database-attributes struct))))
(predicates
(setq stream *browse-stream*)
(when (setq struct (get constructor 'database))
(setq data (database-predicates struct))))
(documentation
(setq stream *browse-stream*)
(when (setq struct (get constructor 'database))
(setq data (database-documentation struct))))
(parents
(setq stream *browse-stream*)
(when (setq struct (get constructor 'database))
(setq data (database-parents struct))))
(users
(setq stream *browse-stream*)
(when (setq struct (get constructor 'database))
(setq data (database-users struct))))
(dependents
(setq stream *browse-stream*)
(when (setq struct (get constructor 'database))
(setq data (database-dependents struct))))
(otherwise (warn "~%(GETDATABASE ~a ~a) failed~%" constructor key)))
(when (numberp data) ;fetch the real data
(when *miss* (format t "getdatabase miss: ~20a ~a~%" constructor key))
(file-position stream data)
(setq data (unsqueeze (read stream)))
(case key ; cache the result of the database read
(operation (setf (gethash constructor *operation-hash*) data))
(hascategory (setf (gethash constructor *hascategory-hash*) data))
(constructorkind (setf (database-constructorkind struct) data))
(cosig (setf (database-cosig struct) data))
(constructormodemap (setf (database-constructormodemap struct) data))
(constructorcategory (setf (database-constructorcategory struct) data))
(operationalist (setf (database-operationalist struct) data))
(modemaps (setf (database-modemaps struct) data))
(object (setf (database-object struct) data))
(niladic (setf (database-niladic struct) data))
(abbreviation (setf (database-abbreviation struct) data))
(constructor (setf (database-constructor struct) data))
(ancestors (setf (database-ancestors struct) data))
(constructorform (setf (database-constructorform struct) data))
(attributes (setf (database-attributes struct) data))
(predicates (setf (database-predicates struct) data))
(documentation (setf (database-documentation struct) data))
(parents (setf (database-parents struct) data))
(users (setf (database-users struct) data))
(dependents (setf (database-dependents struct) data))
(sourcefile (setf (database-sourcefile struct) data))))
(case key ; fixup the special cases
(sourcefile
(when (and data (string= (directory-namestring data) "")
(string= (pathname-type data) "spad"))
(setq data
(concatenate 'string $spadroot "/../../src/algebra/" data))))
(asharp? ; is this asharp code?
(if (consp data)
(setq data (cdr data))
(setq data nil)))
(object ; fix up system object pathname
(if (consp data)
(setq data
(if (string= (directory-namestring (car data)) "")
(concatenate 'string $spadroot "/algebra/" (car data)
"." *lisp-bin-filetype*)
(car data)))
(when (and data (string= (directory-namestring data) ""))
(setq data (concatenate 'string $spadroot "/algebra/" data
"." *lisp-bin-filetype*)))))))
data))
Your user access level is compiler and this command is therefore not
available. See the )set userlevel command for more information.isSubDomain(devaluate(NonNegativeInteger)$Lisp,devaluate(Integer)$Lisp)$Lisp
| (1) |
isSubDomain(devaluate(PositiveInteger)$Lisp,devaluate(Integer)$Lisp)$Lisp
| (2) |
isSubDomain(devaluate(NonZeroInteger)$Lisp,devaluate(Integer)$Lisp)$Lisp
You cannot now use NonZeroInteger in the context you have it.
)show NZINT
You cannot now use NonZeroInteger in the context you have it.
i:NZINT := 1$NZINT
You cannot now use NonZeroInteger in the context you have it.
j:NZINT := -1
You cannot now use NonZeroInteger in the context you have it.
j:NZINT:=-i
You cannot now use NonZeroInteger in the context you have it.
i-j
| (3) |
retractIfCan(0)$NZINT
You cannot now use NonZeroInteger in the context you have it.