-! (c)Joe Groff bsd license
-USING: alien.syntax arrays assocs biassocs combinators
-combinators.short-circuit continuations generalizations kernel
-literals locals math math.bitwise sequences sets system
-vocabs ;
+! Copyright (C) 2009 Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays assocs combinators continuations generalizations
+kernel math math.bitwise sequences sets system vocabs ;
IN: math.floats.env
SINGLETONS:
GENERIC: (set-fp-env-register) ( fp-env -- )
GENERIC: (get-exception-flags) ( fp-env -- exceptions )
-GENERIC# (set-exception-flags) 1 ( fp-env exceptions -- fp-env )
+GENERIC#: (set-exception-flags) 1 ( fp-env exceptions -- fp-env )
GENERIC: (get-fp-traps) ( fp-env -- exceptions )
-GENERIC# (set-fp-traps) 1 ( fp-env exceptions -- fp-env )
+GENERIC#: (set-fp-traps) 1 ( fp-env exceptions -- fp-env )
GENERIC: (get-rounding-mode) ( fp-env -- mode )
-GENERIC# (set-rounding-mode) 1 ( fp-env mode -- fp-env )
+GENERIC#: (set-rounding-mode) 1 ( fp-env mode -- fp-env )
GENERIC: (get-denormal-mode) ( fp-env -- mode )
-GENERIC# (set-denormal-mode) 1 ( fp-env mode -- fp-env )
+GENERIC#: (set-denormal-mode) 1 ( fp-env mode -- fp-env )
: change-fp-env-registers ( quot -- )
(fp-env-registers) swap [ (set-fp-env-register) ] compose each ; inline
:: with-denormal-mode ( mode quot -- )
denormal-mode :> orig
mode set-denormal-mode
- quot [ orig set-denormal-mode ] [ ] cleanup ; inline
+ quot [ orig set-denormal-mode ] finally ; inline
: rounding-mode ( -- mode ) fp-env-register (get-rounding-mode) ;
:: with-rounding-mode ( mode quot -- )
rounding-mode :> orig
mode set-rounding-mode
- quot [ orig set-rounding-mode ] [ ] cleanup ; inline
+ quot [ orig set-rounding-mode ] finally ; inline
: fp-traps ( -- exceptions )
(fp-env-registers) [ (get-fp-traps) ] [ union ] map-reduce >array ; inline
clear-fp-exception-flags
fp-traps :> orig
exceptions set-fp-traps
- quot [ orig set-fp-traps ] [ ] cleanup ; inline
+ quot [ orig set-fp-traps ] finally ; inline
: without-fp-traps ( quot -- )
{ } swap with-fp-traps ; inline