--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/xquery/XQuery__OpLibrary.st Tue May 12 12:20:53 2015 +0100
@@ -0,0 +1,220 @@
+"{ Package: 'stx:goodies/xmlsuite/xquery' }"
+
+"{ NameSpace: XQuery }"
+
+SmalltalkFunctionLibrary subclass:#OpLibrary
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'XQuery-Libraries'
+!
+
+
+!OpLibrary class methodsFor:'function library API'!
+
+namespaceURI
+ "Superclass XQuery::FunctionLibrary class says that I am responsible to implement this method"
+
+ ^#OpNsURI.
+
+ "Modified: / 15-10-2009 / 23:21:01 / Jan Kurs <kursj1@fel.cvut.cz>"
+! !
+
+!OpLibrary methodsFor:'function library API'!
+
+defaultPrefix
+ "Superclass XQuery::FunctionLibrary says that I am responsible to implement this method"
+
+ ^'op'
+
+ "Modified: / 15-10-2009 / 23:05:59 / Jan Kurs <kursj1@fel.cvut.cz>"
+!
+
+functionLocalNames
+ "Superclass XQuery::FunctionLibrary says that I am responsible to implement this method"
+
+ ^#(
+ #'numeric-add'
+ #'numeric-substract'
+ #'numeric-multiply'
+ #'numeric-divide'
+ #'numeric-integer-divide'
+ #'numeric-mod'
+ )
+
+ "Modified: / 24-10-2009 / 13:37:43 / Jan Kurs <kursj1@fel.cvut.cz>"
+! !
+
+!OpLibrary methodsFor:'numeric-operations'!
+
+getNumericType: op
+ (op isSubtypeOf: 'xs:float') ifTrue: [ ^ 'xs:float' ].
+ (op isSubtypeOf: 'xs:double') ifTrue: [ ^ 'xs:double' ].
+ (op isSubtypeOf: 'xs:integer') ifTrue: [ ^ 'xs:integer' ].
+ (op isSubtypeOf: 'xs:decimal') ifTrue: [ ^ 'xs:decimal' ].
+
+ TypeError raiseErrorString: 'not numeric type'.
+
+ "Created: / 15-10-2009 / 23:49:44 / Jan Kurs <kursj1@fel.cvut.cz>"
+ "Modified: / 30-12-2009 / 13:05:02 / Jan Kurs <kursj1@fel.cvut.cz>"
+!
+
+mapOperator: op1 to: op2
+ (op1 isSubtypeOf: op2 type) ifFalse: [
+ ^ self promote: op1 toType: op2 type.
+ ].
+
+ ^ op1
+
+ "Created: / 15-10-2009 / 23:39:19 / Jan Kurs <kursj1@fel.cvut.cz>"
+!
+
+promote: op toType: typeName
+ "see http://www.w3.org/TR/xpath20/#promotion"
+ "Numeric type promotion:
+ 1. A value of type xs:float (or any type derived by restriction from xs:float)
+ can be promoted to the type xs:double. The result is the xs:double value
+ that is the same as the original value.
+
+ 2.A value of type xs:decimal (or any type derived by restriction from xs:decimal)
+ can be promoted to either of the types xs:float or xs:double. The result of
+ this promotion is created by casting the original value to the required type.
+ This kind of promotion may cause loss of precision.
+ "
+
+ (TypeFactory current isNumeric: op typeName) ifFalse: [FunctionError raiseErrorString: 'Only numeric types can be promoted'].
+
+ ((op isSubtypeOf: 'xs:float') and: [ typeName = 'xs:double' ]) ifTrue: [
+ ^ AtomicItem withValue: op nodeId asType: typeName.
+ ].
+
+ ((op isSubtypeOf: 'xs:decimal') and: [ (typeName = 'xs:double') or: [ typeName = 'xs:float'] ]) ifTrue: [
+ ^ AtomicItem withValue: op nodeId asType: typeName.
+ ].
+
+ ^ op.
+
+ "Created: / 15-10-2009 / 23:44:03 / Jan Kurs <kursj1@fel.cvut.cz>"
+ "Modified: / 30-12-2009 / 13:59:48 / Jan Kurs <kursj1@fel.cvut.cz>"
+!
+
+withArg: op1 and: op2 doNumericOperation: aTwoArgBlock
+ | arg1 arg2 retType |
+ self assert: op1 isAtomicValue.
+ self assert: op2 isAtomicValue.
+
+ arg1 := self mapOperator: op1 to: op2.
+ arg2 := self mapOperator: op2 to: op1.
+
+
+ (arg2 isSubtypeOf: arg1 type) ifTrue: [
+ retType := self getNumericType: arg1.
+ ] ifFalse: [
+ retType := self getNumericType: arg2.
+ ].
+
+ self assert: (TypeFactory isType: retType supertypeOf: (self getNumericType: arg2)).
+
+ ^ XQuerySequence with: (AtomicItem withValue: (aTwoArgBlock value: arg1 value value: arg2 value) asType: retType)
+
+ "Created: / 19-10-2009 / 21:39:04 / Jan Kurs <kursj1@fel.cvut.cz>"
+ "Modified: / 30-12-2009 / 14:43:42 / Jan Kurs <kursj1@fel.cvut.cz>"
+!
+
+withArg: op1 and: op2 doNumericOperation: aTwoArgBlock andReturnType: retType
+ | arg1 arg2 |
+ self assert: op1 isAtomicValue.
+ self assert: op2 isAtomicValue.
+
+ arg1 := self mapOperator: op1 to: op2.
+ arg2 := self mapOperator: op2 to: op1.
+
+ [
+ ^ XQuerySequence with: (AtomicItem withValue:
+ (aTwoArgBlock value: arg1 value value: arg2 value) asType: retType)
+ ] on: Exception do:
+ [
+ : ex |
+ ^ FunctionError raiseErrorString: ex asString.
+ ]
+
+ "Created: / 24-10-2009 / 13:43:45 / Jan Kurs <kursj1@fel.cvut.cz>"
+ "Modified: / 30-12-2009 / 14:09:33 / Jan Kurs <kursj1@fel.cvut.cz>"
+! !
+
+!OpLibrary methodsFor:'op:*'!
+
+numericAddInContext: context withParameters: parameters forInterpreter: interpreter
+ ^ self withArg: parameters first
+ and: parameters second
+ doNumericOperation: [:arg1 :arg2 | arg1 value + arg2 value ].
+
+ "Created: / 15-10-2009 / 23:10:11 / Jan Kurs <kursj1@fel.cvut.cz>"
+ "Modified: / 09-11-2009 / 16:48:58 / Jan Kurs <kursj1@fel.cvut.cz>"
+!
+
+numericDivideInContext:context withParameters:parameters forInterpreter:interpreter
+ "6.2.4 op:numeric-divide
+ op:numeric-divide($arg1 as numeric, $arg2 as numeric) as numeric
+
+ Summary: Backs up the 'div' operator and returns the arithmetic quotient of its operands: ($arg1 div $arg2).
+
+ As a special case, if the types of both $arg1 and $arg2 are xs:integer, then the return type is xs:decimal."
+
+ ((parameters first isSubtypeOf:'xs:integer') and:[ parameters second isSubtypeOf:'xs:integer' ])
+ ifTrue:[
+ ^ self
+ withArg:parameters first
+ and:parameters second
+ doNumericOperation:[:arg1 :arg2 | arg1 / arg2 ]
+ andReturnType:'xs:decimal'
+ ]
+ ifFalse:[
+ ^ self
+ withArg:parameters first
+ and:parameters second
+ doNumericOperation:[:arg1 :arg2 | arg1 / arg2 ]
+ ].
+
+ "Created: / 24-10-2009 / 13:38:01 / Jan Kurs <kursj1@fel.cvut.cz>"
+!
+
+numericIntegerDivideInContext:context withParameters:parameters forInterpreter:interpreter
+ ^ self
+ withArg:parameters first
+ and:parameters second
+ doNumericOperation:[:arg1 :arg2 | arg1 // arg2 ]
+ andReturnType:'xs:integer'
+
+ "Created: / 24-10-2009 / 13:38:18 / Jan Kurs <kursj1@fel.cvut.cz>"
+!
+
+numericModInContext: context withParameters: parameters forInterpreter: interpreter
+ ^ self withArg: parameters first
+ and: parameters second
+ doNumericOperation: [:arg1 :arg2 | arg1 \\ arg2].
+
+ "Created: / 24-10-2009 / 13:38:24 / Jan Kurs <kursj1@fel.cvut.cz>"
+!
+
+numericMultiplyInContext: context withParameters: parameters forInterpreter: interpreter
+ ^ self withArg: parameters first
+ and: parameters second
+ doNumericOperation: [:arg1 :arg2 | arg1 * arg2].
+
+ "Created: / 19-10-2009 / 21:58:42 / Jan Kurs <kursj1@fel.cvut.cz>"
+!
+
+numericSubstractInContext: context withParameters: parameters forInterpreter: interpreter
+ ^ self withArg: parameters first
+ and: parameters second
+ doNumericOperation: [:arg1 :arg2 | arg1 - arg2].
+
+ "Created: / 19-10-2009 / 22:44:23 / Jan Kurs <kursj1@fel.cvut.cz>"
+! !
+
+!OpLibrary class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id$'
+! !