[ t ] [ 64 [ 2^ 0.5 * ] map [ < ] monotonic? ] unit-test
[ 5 ] [ 10.5 1.9 /i ] unit-test
+
+[ t ] [ 0/0. 0/0. unordered? ] unit-test
+[ t ] [ 1.0 0/0. unordered? ] unit-test
+[ t ] [ 0/0. 1.0 unordered? ] unit-test
+[ f ] [ 1.0 1.0 unordered? ] unit-test
+
double>bits 52 2^ 1 - bitand ; inline
M: float fp-nan?
- dup fp-special? [ fp-nan-payload zero? not ] [ drop f ] if ; inline
+ dup float= not ;
M: float fp-qnan?
dup fp-nan? [ fp-nan-payload 51 2^ bitand zero? not ] [ drop f ] if ; inline
] if
] if ; inline
+M: float unordered? [ fp-nan? ] bi@ or ; inline
+
M: float prev-float ( m -- n )
double>bits
dup -0.0 double>bits >= [ 1 + bits>double ] [ ! negative
MATH: <= ( x y -- ? ) foldable
MATH: > ( x y -- ? ) foldable
MATH: >= ( x y -- ? ) foldable
+MATH: unordered? ( x y -- ? ) foldable
+
+M: object unordered? 2drop f ;
MATH: + ( x y -- z ) foldable
MATH: - ( x y -- z ) foldable
-USING: kernel math math.parser sequences tools.test ;
+USING: kernel literals math math.parser sequences tools.test ;
IN: math.parser.tests
[ f ]
[ "-3/4" ] [ -3/4 number>string ] unit-test
[ "-1-1/4" ] [ -5/4 number>string ] unit-test
+
+[ "1.0p0" ] [ 1.0 >hex ] unit-test
+[ "1.8p2" ] [ 6.0 >hex ] unit-test
+[ "1.8p-2" ] [ 0.375 >hex ] unit-test
+[ "-1.8p2" ] [ -6.0 >hex ] unit-test
+[ "1.8p10" ] [ 1536.0 >hex ] unit-test
+[ "0.0" ] [ 0.0 >hex ] unit-test
+[ "1.0p-1074" ] [ 1 bits>double >hex ] unit-test
+[ "-0.0" ] [ -0.0 >hex ] unit-test
+
+[ 1.0 ] [ "1.0" hex> ] unit-test
+[ 15.5 ] [ "f.8" hex> ] unit-test
+[ 15.53125 ] [ "f.88" hex> ] unit-test
+[ -15.5 ] [ "-f.8" hex> ] unit-test
+[ 15.5 ] [ "f.8p0" hex> ] unit-test
+[ -15.5 ] [ "-f.8p0" hex> ] unit-test
+[ 62.0 ] [ "f.8p2" hex> ] unit-test
+[ 3.875 ] [ "f.8p-2" hex> ] unit-test
+[ $[ 1 bits>double ] ] [ "1.0p-1074" hex> ] unit-test
+[ 0.0 ] [ "1.0p-1075" hex> ] unit-test
+[ 1/0. ] [ "1.0p1024" hex> ] unit-test
+[ -1/0. ] [ "-1.0p1024" hex> ] unit-test
+
string>natural
] if ; inline
-: string>float ( str -- n/f )
+: dec>float ( str -- n/f )
[ CHAR: , eq? not ] filter
>byte-array 0 suffix (string>float) ;
+: hex>float-parts ( str -- neg? mantissa-str expt )
+ "-" ?head swap "p" split1 [ 10 base> ] [ 0 ] if* ;
+
+: make-mantissa ( str -- bits )
+ 16 base> dup log2 52 swap - shift ;
+
+: combine-hex-float-parts ( neg? mantissa expt -- float )
+ dup 2046 > [ 2drop -1/0. 1/0. ? ] [
+ dup 0 <= [ 1 - shift 0 ] when
+ [ HEX: 8000,0000,0000,0000 0 ? ]
+ [ 52 2^ 1 - bitand ]
+ [ 52 shift ] tri* bitor bitor
+ bits>double
+ ] if ;
+
+: hex>float ( str -- n/f )
+ hex>float-parts
+ [ "." split1 [ append make-mantissa ] [ drop 16 base> log2 ] 2bi ]
+ [ + 1023 + ] bi*
+ combine-hex-float-parts ;
+
+: base>float ( str base -- n/f )
+ {
+ { 10 [ dec>float ] }
+ { 16 [ hex>float ] }
+ [ "Floats can only be converted from strings in base 10 or 16" throw ]
+ } case ;
+
: number-char? ( char -- ? )
"0123456789ABCDEFabcdef." member? ;
PRIVATE>
+: string>float ( str -- n/f )
+ 10 base>float ;
+
: base> ( str radix -- n/f )
over numeric-looking? [
over [ "/." member? ] find nip {
{ CHAR: / [ string>ratio ] }
- { CHAR: . [ drop string>float ] }
+ { CHAR: . [ base>float ] }
[ drop string>integer ]
} case
] [ 2drop f ] if ;
[ ".0" append ]
} cond ;
-: float>string ( n -- str )
+<PRIVATE
+
+: mantissa-expt-normalize ( mantissa expt -- mantissa' expt' )
+ dup zero?
+ [ over log2 52 swap - [ shift 52 2^ 1 - bitand ] [ 1022 + - ] bi-curry bi* ]
+ [ 1023 - ] if ;
+
+: mantissa-expt ( float -- mantissa expt )
+ [ 52 2^ 1 - bitand ]
+ [ -0.0 double>bits bitnot bitand -52 shift ] bi
+ mantissa-expt-normalize ;
+
+: float>hex-sign ( bits -- str )
+ -0.0 double>bits bitand zero? "" "-" ? ;
+
+: float>hex-value ( mantissa -- str )
+ 16 >base [ CHAR: 0 = ] trim-tail [ "0" ] [ ] if-empty "1." prepend ;
+
+: float>hex-expt ( mantissa -- str )
+ 10 >base "p" prepend ;
+
+: float>hex ( n -- str )
+ double>bits
+ [ float>hex-sign ] [
+ mantissa-expt [ float>hex-value ] [ float>hex-expt ] bi*
+ ] bi 3append ;
+
+: float>decimal ( n -- str )
(float>string)
[ 0 = ] trim-tail >string
fix-float ;
+: float>base ( n base -- str )
+ {
+ { 10 [ float>decimal ] }
+ { 16 [ float>hex ] }
+ [ "Floats can only be converted to strings in base 10 or 16" throw ]
+ } case ;
+
+PRIVATE>
+
+: float>string ( n -- str )
+ 10 float>base ;
+
M: float >base
- drop {
- { [ dup fp-nan? ] [ drop "0/0." ] }
- { [ dup 1/0. = ] [ drop "1/0." ] }
- { [ dup -1/0. = ] [ drop "-1/0." ] }
- { [ dup double>bits HEX: 8000000000000000 = ] [ drop "-0.0" ] }
- [ float>string ]
+ {
+ { [ over fp-nan? ] [ 2drop "0/0." ] }
+ { [ over 1/0. = ] [ 2drop "1/0." ] }
+ { [ over -1/0. = ] [ 2drop "-1/0." ] }
+ { [ over 0.0 fp-bitwise= ] [ 2drop "0.0" ] }
+ { [ over -0.0 fp-bitwise= ] [ 2drop "-0.0" ] }
+ [ float>base ]
} cond ;
: number>string ( n -- str ) 10 >base ;
Teach Vim when to load Factor support files.
ftplugin/factor_settings.vim
Teach Vim to follow the Factor Coding Style guidelines.
+ plugin/factor.vim
+ Teach Vim some commands for navigating Factor source code. See below.
syntax/factor.vim
Syntax highlighting for Factor code.
+The "plugin/factor.vim" file implements the following commands for
+navigating Factor source:
+
+ :FactorVocab factor.vocab.name
+ Opens the source file implementing the "factor.vocab.name"
+ vocabulary.
+ :FactorVocabImpl
+ Opens the main implementation file for the current vocabulary
+ (name.factor). The keyboard shortcut "\fi" is bound to this
+ command.
+ :FactorVocabDocs
+ Opens the documentation file for the current vocabulary
+ (name-docs.factor). The keyboard shortcut "\fd" is bound to this
+ command.
+ :FactorVocabTests
+ Opens the unit test file for the current vocabulary
+ (name-tests.factor). The keyboard shortcut "\ft" is bound to this
+ command.
+
+In order for the ":FactorVocab" command to work, you'll need to set some
+variables in your vimrc file:
+ g:FactorRoot
+ This variable should be set to the root of your Factor
+ installation. The default value is "~/factor".
+ g:FactorVocabRoots
+ This variable should be set to a list of Factor vocabulary roots.
+ The paths may be either relative to g:FactorRoot or absolute paths.
+ The default value is ["core", "basis", "extra", "work"].
+
Note: The syntax-highlighting file is automatically generated to include the
names of all the vocabularies Factor knows about. To regenerate it manually,
run the following code in the listener:
"editors.vim.generate-syntax" run
-...or run it from the command-line:
+...or run it from the command line:
factor -run=editors.vim.generate-syntax
nmap <silent> <Leader>fd :FactorVocabDocs<CR>
nmap <silent> <Leader>ft :FactorVocabTests<CR>
-let g:FactorRoot = "~/factor"
-let g:FactorVocabRoots = ["core", "basis", "extra", "work"]
+if !exists("g:FactorRoot")
+ let g:FactorRoot = "~/factor"
+endif
-command! -nargs=1 -complete=custom,FactorCompleteVocab FactorVocab :call GoToFactorVocab("<args>")
+if !exists("g:FactorVocabRoots")
+ let g:FactorVocabRoots = ["core", "basis", "extra", "work"]
+endif
+
+command! -nargs=1 -complete=customlist,FactorCompleteVocab FactorVocab :call GoToFactorVocab("<args>")
command! FactorVocabImpl :call GoToFactorVocabImpl()
command! FactorVocabDocs :call GoToFactorVocabDocs()
command! FactorVocabTests :call GoToFactorVocabTests()
return vocabroot
endfunction
+function! s:unique(list)
+ let dict = {}
+ for value in a:list
+ let dict[value] = 1
+ endfor
+ return sort(keys(dict))
+endfunction
+
function! FactorCompleteVocab(arglead, cmdline, cursorpos)
- let vocabs = ""
+ let vocabs = []
let vocablead = substitute(a:arglead, "\\.", "/", "g")
for root in g:FactorVocabRoots
let vocabroot = FactorVocabRoot(root)
let newvocabs = globpath(vocabroot, vocablead . "*")
if newvocabs != ""
- let newvocabs = substitute(newvocabs, "\\(^\\|\\n\\)\\V" . escape(vocabroot, "\\"), "\\1", "g")
- let newvocabs = substitute(newvocabs, "/\\|\\\\", ".", "g")
- let vocabs .= newvocabs . "\n"
+ let newvocabsl = split(newvocabs, "\n")
+ let newvocabsl = filter(newvocabsl, 'getftype(v:val) == "dir"')
+ let newvocabsl = map(newvocabsl, 'substitute(v:val, "^\\V" . escape(vocabroot, "\\"), "\\1", "g")')
+ let vocabs += newvocabsl
endif
endfor
+ let vocabs = s:unique(vocabs)
+ let vocabs = map(vocabs, 'substitute(v:val, "/\\|\\\\", ".", "g")')
return vocabs
endfunction
projects / factor.git / commitdiff