Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
abcl
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
abcl
abcl
Commits
734b0f39
Unverified
Commit
734b0f39
authored
Jan 02, 2020
by
Mark Evenson
Committed by
GitHub
Jan 02, 2020
Browse files
Options
Browse Files
Download
Plain Diff
Merge pull request #139 from easye/somewhat-functional/primitive-narrowing
Refit numeric tower in a systematic manner
parents
ab5a449f
72a5d761
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
127 additions
and
31 deletions
+127
-31
src/org/armedbear/lisp/Bignum.java
src/org/armedbear/lisp/Bignum.java
+5
-9
src/org/armedbear/lisp/DoubleFloat.java
src/org/armedbear/lisp/DoubleFloat.java
+5
-3
src/org/armedbear/lisp/Fixnum.java
src/org/armedbear/lisp/Fixnum.java
+5
-6
src/org/armedbear/lisp/JavaObject.java
src/org/armedbear/lisp/JavaObject.java
+99
-10
src/org/armedbear/lisp/LispCharacter.java
src/org/armedbear/lisp/LispCharacter.java
+8
-1
src/org/armedbear/lisp/SingleFloat.java
src/org/armedbear/lisp/SingleFloat.java
+5
-2
No files found.
src/org/armedbear/lisp/Bignum.java
View file @
734b0f39
...
...
@@ -85,15 +85,11 @@ public final class Bignum extends LispInteger
@Override
public
Object
javaInstance
(
Class
c
)
{
if
(
c
==
Byte
.
class
||
c
==
byte
.
class
)
return
Byte
.
valueOf
((
byte
)
value
.
intValue
());
if
(
c
==
Short
.
class
||
c
==
short
.
class
)
return
Short
.
valueOf
((
short
)
value
.
intValue
());
if
(
c
==
Integer
.
class
||
c
==
int
.
class
)
return
Integer
.
valueOf
(
value
.
intValue
());
if
(
c
==
Long
.
class
||
c
==
long
.
class
)
return
Long
.
valueOf
((
long
)
value
.
longValue
());
return
javaInstance
();
if
(
BigInteger
.
class
.
equals
(
c
))
{
return
value
;
}
return
error
(
new
TypeError
(
"Cannot convert Bignum to "
+
c
.
getName
()));
}
...
...
src/org/armedbear/lisp/DoubleFloat.java
View file @
734b0f39
...
...
@@ -236,9 +236,11 @@ public final class DoubleFloat extends LispObject
@Override
public
Object
javaInstance
(
Class
c
)
{
if
(
c
==
Float
.
class
||
c
==
float
.
class
)
return
Float
.
valueOf
((
float
)
value
);
return
javaInstance
();
if
(
Double
.
class
.
equals
(
c
)
||
double
.
class
.
equals
(
c
))
{
return
Double
.
valueOf
(
value
);
}
return
error
(
new
TypeError
(
"Cannot convert DoubleFloat to "
+
c
.
getName
()));
}
@Override
...
...
src/org/armedbear/lisp/Fixnum.java
View file @
734b0f39
...
...
@@ -76,13 +76,12 @@ public final class Fixnum extends LispInteger
@Override
public
Object
javaInstance
(
Class
c
)
{
if
(
c
==
Byte
.
class
||
c
==
byte
.
class
)
return
Byte
.
valueOf
((
byte
)
value
);
if
(
c
==
Short
.
class
||
c
==
short
.
class
)
return
Short
.
valueOf
((
short
)
value
);
if
(
c
==
Long
.
class
||
c
==
long
.
class
)
if
(
Long
.
class
.
equals
(
c
)
||
long
.
class
.
equals
(
c
))
return
Long
.
valueOf
((
long
)
value
);
return
javaInstance
();
if
(
Integer
.
class
.
equals
(
c
)
||
int
.
class
.
equals
(
c
))
return
Integer
.
valueOf
(
value
);
return
error
(
new
TypeError
(
"Cannot convert Fixnum to "
+
c
.
getName
()));
}
@Override
...
...
src/org/armedbear/lisp/JavaObject.java
View file @
734b0f39
...
...
@@ -57,7 +57,9 @@ public final class JavaObject extends LispObject {
/**
* Constructs a Java Object with the given intended class, used to access
* the object reflectively. If the class represents a primitive type,
* the corresponding wrapper type is used instead.
* the corresponding wrapper type is used instead (and a narrowing conversion
* done if necessary).
*
* @throws ClassCastException if the object is not an instance of the
* intended class.
*/
...
...
@@ -65,18 +67,47 @@ public final class JavaObject extends LispObject {
if
(
obj
!=
null
&&
intendedClass
==
null
)
{
intendedClass
=
obj
.
getClass
();
}
if
(
intendedClass
!=
null
)
{
if
(
obj
!=
null
&&
!
intendedClass
.
equals
(
obj
.
getClass
())
)
{
intendedClass
=
Java
.
maybeBoxClass
(
intendedClass
);
if
(!
intendedClass
.
isInstance
(
obj
))
{
if
(
intendedClass
.
equals
(
java
.
lang
.
Byte
.
class
)
&&
obj
instanceof
java
.
lang
.
Number
)
{
// Maps any number to two's complement 8bit byte representation
// ??? Is this a reasonable thing?
this
.
obj
=
((
java
.
lang
.
Number
)
obj
).
byteValue
();
this
.
intendedClass
=
intendedClass
;
return
;
if
(
obj
instanceof
Number
)
{
if
(
intendedClass
.
equals
(
Byte
.
class
))
{
obj
=
((
Number
)
obj
).
byteValue
();
}
else
if
(
intendedClass
.
equals
(
Short
.
class
))
{
obj
=
((
Number
)
obj
).
shortValue
();
}
else
if
(
intendedClass
.
equals
(
Integer
.
class
))
{
obj
=
((
Number
)
obj
).
intValue
();
}
else
if
(
intendedClass
.
equals
(
Long
.
class
))
{
obj
=
((
Number
)
obj
).
longValue
();
}
else
if
(
intendedClass
.
equals
(
Character
.
class
))
{
obj
=
Character
.
valueOf
((
char
)
((
Number
)
obj
).
intValue
());
}
else
if
(
intendedClass
.
equals
(
Float
.
class
))
{
obj
=
((
Number
)
obj
).
floatValue
();
}
else
if
(
intendedClass
.
equals
(
Double
.
class
))
{
obj
=
((
Number
)
obj
).
doubleValue
();
}
else
{
throw
new
ClassCastException
(
obj
+
" can not be cast to "
+
intendedClass
);
}
}
else
if
(
obj
instanceof
Character
)
{
char
c
=
((
Character
)
obj
).
charValue
();
if
(
intendedClass
.
equals
(
Byte
.
class
))
{
obj
=
(
byte
)
c
;
}
else
if
(
intendedClass
.
equals
(
Short
.
class
))
{
obj
=
(
short
)
c
;
}
else
if
(
intendedClass
.
equals
(
Integer
.
class
))
{
obj
=
(
int
)
c
;
}
else
if
(
intendedClass
.
equals
(
Long
.
class
))
{
obj
=
(
long
)
c
;
}
else
if
(
intendedClass
.
equals
(
Float
.
class
))
{
obj
=
(
float
)
c
;
}
else
if
(
intendedClass
.
equals
(
Double
.
class
))
{
obj
=
(
double
)
c
;
}
else
{
throw
new
ClassCastException
(
obj
+
" can not be cast to "
+
intendedClass
);
}
}
else
{
throw
new
ClassCastException
(
obj
+
" can not be cast to "
+
intendedClass
);
}
throw
new
ClassCastException
(
obj
+
" can not be cast to "
+
intendedClass
);
}
}
this
.
obj
=
obj
;
...
...
@@ -278,6 +309,9 @@ public final class JavaObject extends LispObject {
}
else
{
c
=
Java
.
maybeBoxClass
(
c
);
if
(
c
.
isAssignableFrom
(
intendedClass
)
||
c
.
isInstance
(
obj
))
{
// By using isAssignableFrom() we are assured that we don't do any narrowing
// here (use (jcoerce) for that, or from java .getInstance(obj, class))
// XXX In the case that c.isInstance(obj) should we then
// "fix" the intendedClass field with the (presumably)
// narrower type of 'obj'?
...
...
@@ -289,6 +323,61 @@ public final class JavaObject extends LispObject {
// representations.
return
obj
;
}
else
{
// Still need to do widening conversions here...
if
(
obj
instanceof
Byte
)
{
if
(
c
.
equals
(
Short
.
class
))
{
return
((
Byte
)
obj
).
shortValue
();
}
else
if
(
c
.
equals
(
Integer
.
class
))
{
return
((
Byte
)
obj
).
intValue
();
}
else
if
(
c
.
equals
(
Long
.
class
))
{
return
((
Byte
)
obj
).
longValue
();
}
else
if
(
c
.
equals
(
Float
.
class
))
{
return
((
Byte
)
obj
).
floatValue
();
}
else
if
(
c
.
equals
(
Double
.
class
))
{
return
((
Byte
)
obj
).
doubleValue
();
}
}
else
if
(
obj
instanceof
Short
)
{
if
(
c
.
equals
(
Integer
.
class
))
{
return
((
Short
)
obj
).
intValue
();
}
else
if
(
c
.
equals
(
Long
.
class
))
{
return
((
Short
)
obj
).
longValue
();
}
else
if
(
c
.
equals
(
Float
.
class
))
{
return
((
Short
)
obj
).
floatValue
();
}
else
if
(
c
.
equals
(
Double
.
class
))
{
return
((
Short
)
obj
).
doubleValue
();
}
}
else
if
(
obj
instanceof
Integer
)
{
if
(
c
.
equals
(
Long
.
class
))
{
return
((
Integer
)
obj
).
longValue
();
}
else
if
(
c
.
equals
(
Float
.
class
))
{
return
((
Integer
)
obj
).
floatValue
();
}
else
if
(
c
.
equals
(
Double
.
class
))
{
return
((
Integer
)
obj
).
doubleValue
();
}
}
else
if
(
obj
instanceof
Long
)
{
if
(
c
.
equals
(
Float
.
class
))
{
return
((
Long
)
obj
).
floatValue
();
}
else
if
(
c
.
equals
(
Double
.
class
))
{
return
((
Long
)
obj
).
doubleValue
();
}
}
else
if
(
obj
instanceof
Float
)
{
if
(
c
.
equals
(
Double
.
class
))
{
return
((
Float
)
obj
).
doubleValue
();
}
// nothing that doesn't potentially narrow for double
// } else if (obj instanceof Double) {
}
else
if
(
obj
instanceof
Character
)
{
if
(
c
.
equals
(
Integer
.
class
))
{
return
(
int
)
((
Character
)
obj
).
charValue
();
}
else
if
(
c
.
equals
(
Long
.
class
))
{
return
(
long
)
((
Character
)
obj
).
charValue
();
}
else
if
(
c
.
equals
(
Float
.
class
))
{
return
(
float
)
((
Character
)
obj
).
charValue
();
}
else
if
(
c
.
equals
(
Double
.
class
))
{
return
(
double
)
((
Character
)
obj
).
charValue
();
}
}
return
error
(
new
TypeError
(
intendedClass
.
getName
()
+
" is not assignable to "
+
c
.
getName
()));
}
}
...
...
src/org/armedbear/lisp/LispCharacter.java
View file @
734b0f39
...
...
@@ -200,7 +200,14 @@ public final class LispCharacter extends LispObject
@Override
public
Object
javaInstance
(
Class
c
)
{
return
javaInstance
();
if
(
Integer
.
class
.
equals
(
c
)
||
int
.
class
.
equals
(
c
))
return
(
int
)
Character
.
valueOf
(
value
);
if
(
Long
.
class
.
equals
(
c
)
||
long
.
class
.
equals
(
c
))
return
(
long
)
Character
.
valueOf
(
value
);
if
(
Character
.
class
.
equals
(
c
)
||
char
.
class
.
equals
(
c
))
return
Character
.
valueOf
(
value
);
return
error
(
new
TypeError
(
"Cannot convert LispCharacter to "
+
c
.
getName
()));
}
@Override
...
...
src/org/armedbear/lisp/SingleFloat.java
View file @
734b0f39
...
...
@@ -241,9 +241,12 @@ public final class SingleFloat extends LispObject
@Override
public
Object
javaInstance
(
Class
c
)
{
if
(
c
==
Float
.
class
||
c
==
float
.
class
)
if
(
Float
.
class
.
equals
(
c
)
||
float
.
class
.
equals
(
c
)
)
return
Float
.
valueOf
(
value
);
return
javaInstance
();
if
(
Double
.
class
.
equals
(
c
)
||
double
.
class
.
equals
(
c
))
return
Double
.
valueOf
(
value
);
return
error
(
new
TypeError
(
"Cannot convert SingleFloat to "
+
c
.
getName
()));
}
@Override
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment