Merge branch 'master' of git://factorcode.org/git/factor
commit
653a74a314
|
@ -74,7 +74,7 @@ name>char-hook [
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: lexer-before ( i -- before )
|
||||
: lexer-subseq ( i -- before )
|
||||
[
|
||||
[
|
||||
lexer get
|
||||
|
@ -84,11 +84,6 @@ name>char-hook [
|
|||
lexer get (>>column)
|
||||
] bi ;
|
||||
|
||||
: find-next-token ( ch -- i elt )
|
||||
CHAR: \ 2array
|
||||
[ lexer get [ column>> ] [ line-text>> ] bi ] dip
|
||||
[ member? ] curry find-from ;
|
||||
|
||||
: rest-of-line ( lexer -- seq )
|
||||
[ line-text>> ] [ column>> ] bi tail-slice ;
|
||||
|
||||
|
@ -107,11 +102,7 @@ ERROR: escaped-char-expected ;
|
|||
escaped-char-expected
|
||||
] if ;
|
||||
|
||||
: next-line% ( lexer -- )
|
||||
[ rest-of-line % ]
|
||||
[ next-line "\n" % ] bi ;
|
||||
|
||||
: rest-begins? ( string -- ? )
|
||||
: lexer-head? ( string -- ? )
|
||||
[
|
||||
lexer get [ line-text>> ] [ column>> ] bi tail-slice
|
||||
] dip head? ;
|
||||
|
@ -119,6 +110,15 @@ ERROR: escaped-char-expected ;
|
|||
: advance-lexer ( n -- )
|
||||
[ lexer get ] dip [ + ] curry change-column drop ; inline
|
||||
|
||||
: find-next-token ( ch -- i elt )
|
||||
CHAR: \ 2array
|
||||
[ lexer get [ column>> ] [ line-text>> ] bi ] dip
|
||||
[ member? ] curry find-from ;
|
||||
|
||||
: next-line% ( lexer -- )
|
||||
[ rest-of-line % ]
|
||||
[ next-line "\n" % ] bi ;
|
||||
|
||||
: take-double-quotes ( -- string )
|
||||
lexer get dup current-char CHAR: " = [
|
||||
[ ] [ column>> ] [ line-text>> ] tri
|
||||
|
@ -138,29 +138,29 @@ ERROR: escaped-char-expected ;
|
|||
lexer get advance-char
|
||||
] if ;
|
||||
|
||||
DEFER: (parse-long-string)
|
||||
DEFER: (parse-multiline-string)
|
||||
|
||||
: parse-found-token ( i string token -- )
|
||||
[ lexer-before % ] dip
|
||||
[ lexer-subseq % ] dip
|
||||
CHAR: \ = [
|
||||
lexer get [ next-char , ] [ next-char , ] bi (parse-long-string)
|
||||
lexer get [ next-char , ] [ next-char , ] bi (parse-multiline-string)
|
||||
] [
|
||||
dup rest-begins? [
|
||||
dup lexer-head? [
|
||||
end-string-parse
|
||||
] [
|
||||
lexer get next-char , (parse-long-string)
|
||||
lexer get next-char , (parse-multiline-string)
|
||||
] if
|
||||
] if ;
|
||||
|
||||
ERROR: trailing-characters string ;
|
||||
|
||||
: (parse-long-string) ( string -- )
|
||||
: (parse-multiline-string) ( string -- )
|
||||
lexer get still-parsing? [
|
||||
dup first find-next-token [
|
||||
parse-found-token
|
||||
] [
|
||||
drop lexer get next-line%
|
||||
(parse-long-string)
|
||||
(parse-multiline-string)
|
||||
] if*
|
||||
] [
|
||||
unexpected-eof
|
||||
|
@ -168,13 +168,10 @@ ERROR: trailing-characters string ;
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: parse-long-string ( string -- string' )
|
||||
[ (parse-long-string) ] "" make ;
|
||||
|
||||
: parse-multiline-string ( -- string )
|
||||
lexer get rest-of-line "\"\"" head? [
|
||||
lexer get [ 2 + ] change-column drop
|
||||
"\"\"\""
|
||||
] [
|
||||
"\""
|
||||
] if parse-long-string unescape-string ;
|
||||
] if [ (parse-multiline-string) ] "" make unescape-string ;
|
||||
|
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
|
@ -0,0 +1,14 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: decimals kernel locals math math.combinatorics math.ranges
|
||||
sequences ;
|
||||
IN: benchmark.e-decimals
|
||||
|
||||
:: calculate-e-decimals ( n -- e )
|
||||
n [1,b] [ factorial 0 <decimal> D: 1 swap n D/ ] map
|
||||
D: 1 [ D+ ] reduce ;
|
||||
|
||||
: calculate-e-decimals-benchmark ( -- )
|
||||
5 [ 800 calculate-e-decimals drop ] times ;
|
||||
|
||||
MAIN: calculate-e-decimals-benchmark
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
|
@ -0,0 +1,12 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.combinatorics math.ranges sequences ;
|
||||
IN: benchmark.e-ratios
|
||||
|
||||
: calculate-e-ratios ( n -- e )
|
||||
iota [ factorial recip ] sigma ;
|
||||
|
||||
: calculate-e-ratios-benchmark ( -- )
|
||||
5 [ 300 calculate-e-ratios drop ] times ;
|
||||
|
||||
MAIN: calculate-e-ratios-benchmark
|
Loading…
Reference in New Issue