The Lambda Lab
/
projects
/
scheme.forth.jl.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (from parent 1:
f675338
)
Added floating point printing words.
author
Tim Vaughan
<tgvaughan@gmail.com>
Sun, 11 Dec 2016 01:52:08 +0000
(14:52 +1300)
committer
Tim Vaughan
<tgvaughan@gmail.com>
Sun, 11 Dec 2016 01:52:08 +0000
(14:52 +1300)
src/float.4th
patch
|
blob
|
history
diff --git
a/src/float.4th
b/src/float.4th
index
c256da9
..
2305749
100644
(file)
--- a/
src/float.4th
+++ b/
src/float.4th
@@
-39,58
+39,183
@@
END-CODE
CODE f>
b = reinterpret(Float64, popPS())
a = reinterpret(Float64, popPS())
CODE f>
b = reinterpret(Float64, popPS())
a = reinterpret(Float64, popPS())
- pushPS(reinterpret(Int64, a>b))
+ if a > b
+ pushPS(-1)
+ else
+ pushPS(0)
+ end
END-CODE
CODE f<
b = reinterpret(Float64, popPS())
a = reinterpret(Float64, popPS())
END-CODE
CODE f<
b = reinterpret(Float64, popPS())
a = reinterpret(Float64, popPS())
- pushPS(reinterpret(Int64, a<b))
+ if a < b
+ pushPS(-1)
+ else
+ pushPS(0)
+ end
END-CODE
CODE f=
b = reinterpret(Float64, popPS())
a = reinterpret(Float64, popPS())
END-CODE
CODE f=
b = reinterpret(Float64, popPS())
a = reinterpret(Float64, popPS())
- pushPS(reinterpret(Int64, a=b))
+ if a == b
+ pushPS(-1)
+ else
+ pushPS(0)
+ end
END-CODE
END-CODE
-CODE f<=
- b = reinterpret(Float64, popPS())
- a = reinterpret(Float64, popPS())
- pushPS(reinterpret(Int64, a<=b))
-END-CODE
+: f<=
+ f> invert ;
-CODE f>=
+: f>=
+ f< invert ;
+
+CODE fmod
b = reinterpret(Float64, popPS())
a = reinterpret(Float64, popPS())
b = reinterpret(Float64, popPS())
a = reinterpret(Float64, popPS())
- pushPS(reinterpret(Int64, a
>=
b))
+ pushPS(reinterpret(Int64, a
%
b))
END-CODE
CODE flog
END-CODE
CODE flog
-
b
= reinterpret(Float64, popPS())
+
a
= reinterpret(Float64, popPS())
pushPS(reinterpret(Int64, log(a)))
END-CODE
CODE fexp
pushPS(reinterpret(Int64, log(a)))
END-CODE
CODE fexp
-
b
= reinterpret(Float64, popPS())
+
a
= reinterpret(Float64, popPS())
pushPS(reinterpret(Int64, exp(a)))
END-CODE
pushPS(reinterpret(Int64, exp(a)))
END-CODE
+CODE fnan?
+ a = reinterpret(Float64, popPS())
+ if isnan(a)
+ pushPS(-1)
+ else
+ pushPS(0)
+ end
+END-CODE
+
+CODE finf?
+ a = reinterpret(Float64, popPS())
+ if isinf(a)
+ pushPS(-1)
+ else
+ pushPS(0)
+ end
+END-CODE
+
CODE i->f
pushPS(reinterpret(Int64, Float64(popPS())))
END-CODE
CODE i->f
pushPS(reinterpret(Int64, Float64(popPS())))
END-CODE
-: f.scientific ( float -- )
+CODE f->i
+ a = reinterpret(Float64, popPS())
+ pushPS(Int64(round(a)))
+END-CODE
+
+: f/mod
+ 2dup fmod -rot f/ ;
+
+: 0.0
+ [ 0 i->f ] literal ;
+
+: 1.0
+ [ 1 i->f ] literal ;
+
+: -1.0
+ [ -1 i->f ] literal ;
+
+: 10.0
+ [ 10 i->f ] literal ;
+
+: flog10
+ flog [ 10 i->f flog ] literal f/ ;
+
+: fabs
+ dup 0.0 f< if
+ -1.0 f*
+ then
+;
+
+: floor
+ dup 0.0 f>= if
+ dup 1.0 fmod f-
+ else
+ dup 1.0 fmod dup 0.0 <> if
+ f- 1.0 f-
+ else
+ drop
+ then
+ then
;
;
+: fhead ( float -- )
+ floor f->i
+ 0 .R ;
+
+: ftail ( float prec -- )
+ dup 0<= if 2drop exit then
+
+ swap
+
+ 1.0 fmod 10.0 f*
+
+ dup floor f->i 0 .R
+
+ 1.0 fmod dup 0.0 f> if
+ swap 1- recurse
+ else
+ 2drop
+ then
+;
+
+variable precision
+16 precision !
+
: f.plain ( float -- )
: f.plain ( float -- )
+ dup 0.0 = if
+ ." 0.0"
+ drop exit
+ then
+
+ dup 0.0 f< if
+ [char] - emit
+ -1.0 f*
+ then
+
+ dup fhead
+
+ [char] . emit
+
+ precision @ over flog10 floor f->i -
+ ftail
+;
+
+: f.scientific ( float -- )
+ dup 0.0 = if
+ ." 0.0"
+ drop exit
+ then
+
+ dup 0.0 f< if
+ [char] - emit
+ -1.0 f*
+ then
+
+ dup flog10 floor dup -rot
+ 10.0 swap f^ f/ f.plain
+ ." e" f->i 0 .R
;
: f. ( float -- )
;
: f. ( float -- )
- dup dup 1000000 i->f f>= swap 1 i->f 10000 i->f f/ f< or if
+ dup
fabs
dup 1000000 i->f f>= swap 1 i->f 10000 i->f f/ f< or if
f.scientific
else
f.plain
then
f.scientific
else
f.plain
then
+
+ space
;
;