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
ab5a449f
Unverified
Commit
ab5a449f
authored
Dec 20, 2019
by
Mark Evenson
Committed by
GitHub
Dec 20, 2019
Browse files
Options
Browse Files
Download
Plain Diff
Merge pull request #129 from easye/master
[INCOMPLETE] Fix the numeric tower for floats
parents
080d942a
65b62a2b
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
37 additions
and
6 deletions
+37
-6
src/org/armedbear/lisp/numbers.lisp
src/org/armedbear/lisp/numbers.lisp
+28
-5
t/decode-float.lisp
t/decode-float.lisp
+9
-1
No files found.
src/org/armedbear/lisp/numbers.lisp
View file @
ab5a449f
...
...
@@ -153,11 +153,34 @@
:format-arguments
(
list
float
))))
(
defun
decode-float
(
float
)
(
multiple-value-bind
(
significand
exponent
sign
)
(
integer-decode-float
float
)
(
values
(
coerce
(
/
significand
(
expt
2
53
))
'float
)
(
+
exponent
53
)
(
if
(
minusp
sign
)
-1.0
1.0
))))
(
cond
((
typep
float
'single-float
)
(
decode-float-single
float
))
((
typep
float
'double-float
)
(
decode-float-double
float
))
(
t
(
error
'simple-type-error
:format-control
"~S is neither SINGLE-FLOAT nor DOUBLE-FLOAT."
:format-arguments
(
list
float
)))))
(
defun
decode-float-single
(
float
)
;; TODO memoize
(
let
((
float-precision-single
(
float-precision
1f0
)))
(
multiple-value-bind
(
significand
exponent
sign
)
(
integer-decode-float
float
)
(
values
(
coerce
(
/
significand
(
expt
2
float-precision-single
))
'single-float
)
(
+
exponent
float-precision-single
)
(
if
(
minusp
sign
)
-1f0
1f0
)))))
(
defun
decode-float-double
(
float
)
;; TODO memoize
(
let
((
float-precision-double
(
float-precision
1d0
)))
(
multiple-value-bind
(
significand
exponent
sign
)
(
integer-decode-float
float
)
(
values
(
coerce
(
/
significand
(
expt
2
float-precision-double
))
'double-float
)
(
+
exponent
float-precision-double
)
(
if
(
minusp
sign
)
-1d0
1d0
)))))
(
defun
conjugate
(
number
)
(
etypecase
number
...
...
t/decode-float.lisp
View file @
ab5a449f
(
in-package
:cl-user
)
;;; <https://github.com/armedbear/abcl/issues/93>
(
let
((
floats
`
(
1f6
(
let
((
floats
`
(
1f0
1f6
1f-6
,
least-positive-normalized-single-float
,
least-positive-single-float
)))
...
...
@@ -42,4 +43,11 @@
(
let
((
result
(
decode-float
float
)))
(
prove:is-type
result
'double-float
))))
;;; additional things along the way…
#|
Should fail, as you shouldn't be able to
(decode-float single-float-positive-infinity)
|#
(
prove:finalize
)
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