hg/stx-goodies-xmlsuite: xquery/XQuery__WithinBranchCasting.st@bad21c4f64bf (annotated)

241 e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	1	"{ Package: 'stx:goodies/xmlsuite/xquery' }"
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	2
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	3	"{ NameSpace: XQuery }"
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	4
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	5	Object subclass:#WithinBranchCasting
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	6	instanceVariableNames:''
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	7	classVariableNames:''
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	8	poolDictionaries:''
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	9	category:'XQuery-TypeCasting'
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	10	!
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	11
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	12
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	13	!WithinBranchCasting methodsFor:'casting'!
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	14
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	15	accept: type and: anotherType
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	16	^ (TypeFactory current primitiveTypeFor: type) = (TypeFactory current primitiveTypeFor: anotherType).
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	17
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	18	"Created: / 07-11-2009 / 17:20:20 / Jan Kurs <kursj1@fel.cvut.cz>"
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	19	"Modified: / 18-11-2009 / 00:54:09 / Jan Kurs <kursj1@fel.cvut.cz>"
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	20	!
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	21
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	22	cast: atomicValue to: anotherType
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	23	[
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	24	\| commonPrimitiveType \|
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	25	commonPrimitiveType := TypeFactory current primitiveTypeFor: anotherType.
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	26
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	27	^ (atomicValue castAs: commonPrimitiveType typeName) castAs: anotherType typeName.
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	28	]
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	29	on: Exception
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	30	do: [ :ex \|
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	31	self raiseError: '[err:FORG0001]' withMessage: ex asString.
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	32	].
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	33
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	34	"Created: / 07-11-2009 / 16:51:22 / Jan Kurs <kursj1@fel.cvut.cz>"
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	35	"Modified: / 21-11-2009 / 18:38:10 / Jan Kurs <kursj1@fel.cvut.cz>"
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	36	! !
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	37
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	38	!WithinBranchCasting methodsFor:'casting - private'!
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	39
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	40	castRuleFor: atomicValue to: anotherType
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	41	\| name fromType toType castClass \|
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	42
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	43	fromType := TypeFactory getType: atomicValue typeName.
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	44	toType := anotherType.
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	45
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	46	[ castClass isNil ] whileTrue:
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	47	[
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	48	name := 'XQuery::',fromType localName asUppercaseFirst, 'To', toType localName asUppercaseFirst, 'Cast'.
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	49	castClass := Smalltalk classNamed: name.
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	50
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	51	(TypeFactory current isType: fromType instanceOf: (TypeFactory getType: 'xs:anyAtomicType')) ifFalse: [
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	52	" generalize fromType at first"
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	53	fromType := TypeFactory current supertypeOf: fromType.
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	54	] ifTrue: [
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	55	" from type is anyAtomicType, so generalize to type"
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	56	toType := TypeFactory current supertypeOf: toType.
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	57	]
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	58	].
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	59
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	60	^ (castClass new)
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	61	atomicValue: atomicValue;
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	62	anotherType: anotherType;
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	63	yourself.
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	64
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	65	"Created: / 09-11-2009 / 16:13:05 / Jan Kurs <kursj1@fel.cvut.cz>"
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	66	!
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	67
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	68	isAcceptable: type
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	69	^ type isPrimitive or: [ type typeName = 'xs:integer' ].
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	70
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	71	"Created: / 07-11-2009 / 17:20:40 / Jan Kurs <kursj1@fel.cvut.cz>"
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	72	"Modified: / 18-11-2009 / 00:24:48 / Jan Kurs <kursj1@fel.cvut.cz>"
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	73	! !
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	74
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	75	!WithinBranchCasting methodsFor:'error reporting'!
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	76
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	77	raiseError: errorType
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	78	AtomicItemError raiseErrorString: 'Error no.: ', errorType.
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	79
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	80	"Created: / 05-10-2009 / 17:20:46 / Jan Kurs <kursj1@fel.cvut.cz>"
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	81	"Modified: / 24-10-2009 / 16:14:30 / Jan Kurs <kursj1@fel.cvut.cz>"
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	82	!
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	83
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	84	raiseError: errorType withMessage: message
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	85	AtomicItemError raiseErrorString: message, ' Error no.: ', errorType.
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	86
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	87	"Created: / 05-10-2009 / 17:21:52 / Jan Kurs <kursj1@fel.cvut.cz>"
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	88	"Modified: / 24-10-2009 / 16:14:25 / Jan Kurs <kursj1@fel.cvut.cz>"
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	89	! !
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	90
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	91	!WithinBranchCasting class methodsFor:'documentation'!
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	92
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	93	version_SVN
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	94	^ '$Id$'
e28ef0f20186 Branch datatypes reintegrated Jan Vrany <jan.vrany@fit.cvut.cz> parents: diff changeset	95	! !

author	Jan Vrany <jan.vrany@fit.cvut.cz>
	Mon, 02 Jul 2018 08:46:01 +0200
changeset 305	bad21c4f64bf
parent 296	ea3dbc023c80
permissions	-rw-r--r--