]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/math/floats/env/env.factor
factor: trim using lists
[factor.git] / basis / math / floats / env / env.factor
index 3d281b06c83d9f708e4214859dc8cd3855b0d919..d019d1ee0e379c640303cc581589e6d4dedf21b2 100644 (file)
@@ -1,8 +1,7 @@
-! (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:
@@ -67,16 +66,16 @@ HOOK: (fp-env-registers) cpu ( -- registers )
 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
@@ -133,14 +132,14 @@ PRIVATE>
 :: 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
@@ -149,7 +148,7 @@ PRIVATE>
     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