switch some vocabs to 4 spaces.
parent
1f5e8f3970
commit
c75fc48f23
|
@ -59,7 +59,7 @@ C: <foo> foo
|
|||
] with-variables
|
||||
] unit-test
|
||||
|
||||
{ H{ { ?a ?a } } } [
|
||||
{ H{ { ?a ?a } } }
|
||||
\ ?a \ ?a match
|
||||
] unit-test
|
||||
|
||||
|
@ -69,9 +69,7 @@ C: <foo> foo
|
|||
} match-cond
|
||||
] unit-test
|
||||
|
||||
[
|
||||
{ 2 1 }
|
||||
] [
|
||||
{ { 2 1 } } [
|
||||
{ "a" 1 2 "b" } { _ ?a ?b _ } { ?b ?a } match-replace
|
||||
] unit-test
|
||||
|
||||
|
|
|
@ -187,13 +187,22 @@ M: real absq sq ; inline
|
|||
: >=1? ( x -- ? )
|
||||
dup complex? [ drop f ] [ 1 >= ] if ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: fp-normalize ( x -- y exp )
|
||||
dup abs 0x1.0p-1022 < [ 52 2^ * -52 ] [ 0 ] if ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
GENERIC: frexp ( x -- y exp )
|
||||
|
||||
M: float frexp
|
||||
dup fp-special? [ dup zero? ] unless* [ 0 ] [
|
||||
fp-normalize [
|
||||
double>bits
|
||||
[ 0x800f,ffff,ffff,ffff bitand 0.5 double>bits bitor bits>double ]
|
||||
[ -52 shift 0x7ff bitand 1022 - ] bi
|
||||
] dip +
|
||||
] if ; inline
|
||||
|
||||
M: integer frexp
|
||||
|
@ -210,8 +219,9 @@ GENERIC# ldexp 1 ( x exp -- y )
|
|||
|
||||
M: float ldexp
|
||||
over fp-special? [ over zero? ] unless* [ drop ] [
|
||||
[ double>bits dup -52 shift 0x7ff bitand 1023 - ] dip +
|
||||
{
|
||||
[ fp-normalize ] dip
|
||||
[ double>bits dup -52 shift 0x7ff bitand 1023 - ]
|
||||
[ + ] [ + ] tri* {
|
||||
{ [ dup -1074 < ] [ drop 0 copysign ] }
|
||||
{ [ dup 1023 > ] [ drop 0 < -1/0. 1/0. ? ] }
|
||||
[
|
||||
|
|
|
@ -24,7 +24,8 @@ SYMBOL: error-stack
|
|||
{
|
||||
{ [ over position>> not ] [ nip ] }
|
||||
{ [ dup position>> not ] [ drop ] }
|
||||
[ 2dup [ position>> ] compare {
|
||||
[
|
||||
2dup [ position>> ] compare {
|
||||
{ +lt+ [ nip ] }
|
||||
{ +gt+ [ drop ] }
|
||||
{ +eq+ [ messages>> over messages>> union [ position>> ] dip <parse-error> ] }
|
||||
|
@ -121,9 +122,7 @@ TUPLE: peg-head rule-id involved-set eval-set ;
|
|||
|
||||
: memo ( pos id -- memo-entry )
|
||||
#! Return the result from the memo cache.
|
||||
packrat at
|
||||
! " memo result " write dup .
|
||||
;
|
||||
packrat at ;
|
||||
|
||||
: set-memo ( memo-entry pos id -- )
|
||||
#! Store an entry in the cache
|
||||
|
@ -230,12 +229,9 @@ TUPLE: peg-head rule-id involved-set eval-set ;
|
|||
] if ;
|
||||
|
||||
: apply-rule ( r p -- ast )
|
||||
! 2dup [ rule-id ] dip 2array "apply-rule: " write .
|
||||
2dup recall [
|
||||
! " memoed" print
|
||||
nip apply-memo-rule
|
||||
] [
|
||||
! " not memoed" print
|
||||
apply-non-memo-rule
|
||||
] if* ; inline
|
||||
|
||||
|
|
|
@ -40,8 +40,7 @@ HELP: (byte-array)
|
|||
|
||||
HELP: >byte-array
|
||||
{ $values { "seq" "a sequence" } { "byte-array" byte-array } }
|
||||
{ $description
|
||||
"Outputs a freshly-allocated byte array whose elements have the same signed byte values as a given sequence." }
|
||||
{ $description "Outputs a freshly-allocated byte array whose elements have the same signed byte values as a given sequence." }
|
||||
{ $errors "Throws an error if the sequence contains elements other than integers." } ;
|
||||
|
||||
HELP: 1byte-array
|
||||
|
|
|
@ -2,7 +2,8 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel peg strings sequences math math.parser
|
||||
namespaces make words quotations arrays hashtables io
|
||||
io.streams.string assocs ascii peg.parsers words.symbol ;
|
||||
io.streams.string assocs ascii peg.parsers words.symbol
|
||||
combinators.short-circuit ;
|
||||
IN: fjsc
|
||||
|
||||
TUPLE: ast-number value ;
|
||||
|
@ -21,20 +22,22 @@ TUPLE: ast-in name ;
|
|||
TUPLE: ast-hashtable elements ;
|
||||
|
||||
: identifier-middle? ( ch -- bool )
|
||||
[ blank? not ] keep
|
||||
[ "}];\"" member? not ] keep
|
||||
digit? not
|
||||
and and ;
|
||||
{
|
||||
[ blank? not ]
|
||||
[ "}];\"" member? not ]
|
||||
[ digit? not ]
|
||||
} 1&& ;
|
||||
|
||||
: 'identifier-ends' ( -- parser )
|
||||
[
|
||||
[ blank? not ] keep
|
||||
[ CHAR: " = not ] keep
|
||||
[ CHAR: ; = not ] keep
|
||||
[ LETTER? not ] keep
|
||||
[ letter? not ] keep
|
||||
identifier-middle? not
|
||||
and and and and and
|
||||
{
|
||||
[ blank? not ]
|
||||
[ CHAR: " = not ]
|
||||
[ CHAR: ; = not ]
|
||||
[ LETTER? not ]
|
||||
[ letter? not ]
|
||||
[ identifier-middle? not ]
|
||||
} 1&&
|
||||
] satisfy repeat0 ;
|
||||
|
||||
: 'identifier-middle' ( -- parser )
|
||||
|
@ -54,10 +57,11 @@ DEFER: 'expression'
|
|||
|
||||
: 'effect-name' ( -- parser )
|
||||
[
|
||||
[ blank? not ] keep
|
||||
[ CHAR: ) = not ] keep
|
||||
CHAR: - = not
|
||||
and and
|
||||
{
|
||||
[ blank? not ]
|
||||
[ CHAR: ) = not ]
|
||||
[ CHAR: - = not ]
|
||||
} 1&&
|
||||
] satisfy repeat1 [ >string ] action ;
|
||||
|
||||
: 'stack-effect' ( -- parser )
|
||||
|
|
|
@ -9,12 +9,10 @@ IN: update
|
|||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: git-pull-clean ( -- )
|
||||
image parent-directory
|
||||
[
|
||||
image parent-directory [
|
||||
{ "git" "pull" "git://factorcode.org/git/factor.git" branch-name }
|
||||
run-command
|
||||
]
|
||||
with-directory ;
|
||||
] with-directory ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
@ -33,28 +31,24 @@ IN: update
|
|||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: rebuild ( -- )
|
||||
image parent-directory
|
||||
[
|
||||
image parent-directory [
|
||||
download-clean-image
|
||||
make-clean
|
||||
make
|
||||
boot
|
||||
]
|
||||
with-directory ;
|
||||
] with-directory ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: update ( -- )
|
||||
image parent-directory
|
||||
[
|
||||
image parent-directory [
|
||||
git-id
|
||||
git-pull-clean
|
||||
git-id
|
||||
= not
|
||||
[ rebuild ]
|
||||
when
|
||||
]
|
||||
with-directory ;
|
||||
] with-directory ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
Loading…
Reference in New Issue