steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2008-09-11 01:11:59 -05:00
parent 800b134fa7 cc7f9e7731
commit e0b537993f
338 changed files with 2881 additions and 1036 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/alien/arrays/arrays.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien arrays alien.c-types alien.structs USING: alien arrays alien.c-types alien.structs
sequences math kernel namespaces libc cpu.architecture ; sequences math kernel namespaces make libc cpu.architecture ;
IN: alien.arrays IN: alien.arrays
UNION: value-type array struct-type ; UNION: value-type array struct-type ;

2
basis/alien/c-types/c-types.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2008 Slava Pestov. ! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: byte-arrays arrays assocs kernel kernel.private libc math USING: byte-arrays arrays assocs kernel kernel.private libc math
namespaces parser sequences strings words assocs splitting namespaces make parser sequences strings words assocs splitting
math.parser cpu.architecture alien alien.accessors quotations math.parser cpu.architecture alien alien.accessors quotations
layouts system compiler.units io.files io.encodings.binary layouts system compiler.units io.files io.encodings.binary
accessors combinators effects continuations ; accessors combinators effects continuations ;

2
basis/alien/structs/fields/fields.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2008 Slava Pestov. ! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays kernel kernel.private math namespaces USING: accessors arrays kernel kernel.private math namespaces
sequences strings words effects combinators alien.c-types ; make sequences strings words effects combinators alien.c-types ;
IN: alien.structs.fields IN: alien.structs.fields
TUPLE: field-spec name offset type reader writer ; TUPLE: field-spec name offset type reader writer ;

2
basis/bootstrap/image/image.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2008 Slava Pestov. ! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien arrays byte-arrays generic assocs hashtables assocs USING: alien arrays byte-arrays generic assocs hashtables assocs
hashtables.private io kernel kernel.private math namespaces hashtables.private io kernel kernel.private math namespaces make
parser prettyprint sequences sequences.private strings sbufs parser prettyprint sequences sequences.private strings sbufs
vectors words quotations assocs system layouts splitting vectors words quotations assocs system layouts splitting
grouping growable classes classes.builtin classes.tuple grouping growable classes classes.builtin classes.tuple

2
basis/bootstrap/image/upload/upload.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: checksums checksums.openssl splitting assocs USING: checksums checksums.openssl splitting assocs
kernel io.files bootstrap.image sequences io namespaces kernel io.files bootstrap.image sequences io namespaces make
io.launcher math io.encodings.ascii ; io.launcher math io.encodings.ascii ;
IN: bootstrap.image.upload IN: bootstrap.image.upload

2
basis/channels/remote/remote.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
! !
! Remote Channels ! Remote Channels
USING: kernel init namespaces assocs arrays random USING: kernel init namespaces make assocs arrays random
sequences channels match concurrency.messaging sequences channels match concurrency.messaging
concurrency.distributed threads accessors ; concurrency.distributed threads accessors ;
IN: channels.remote IN: channels.remote

2
basis/checksums/common/common.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2006, 2008 Doug Coleman. ! Copyright (C) 2006, 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.bitwise strings io.binary namespaces USING: kernel math math.bitwise strings io.binary namespaces
grouping ; make grouping ;
IN: checksums.common IN: checksums.common
SYMBOL: bytes-read SYMBOL: bytes-read

4
basis/checksums/sha1/sha1.factor
View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays combinators kernel io io.encodings.binary io.files USING: arrays combinators kernel io io.encodings.binary io.files
io.streams.byte-array math.vectors strings sequences namespaces io.streams.byte-array math.vectors strings sequences namespaces
math parser sequences assocs grouping vectors io.binary hashtables make math parser sequences assocs grouping vectors io.binary
symbols math.bitwise checksums checksums.common ; hashtables symbols math.bitwise checksums checksums.common ;
IN: checksums.sha1 IN: checksums.sha1
! Implemented according to RFC 3174. ! Implemented according to RFC 3174.

2
basis/checksums/sha2/sha2.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel splitting grouping math sequences namespaces USING: kernel splitting grouping math sequences namespaces make
io.binary symbols math.bitwise checksums checksums.common io.binary symbols math.bitwise checksums checksums.common
sbufs strings ; sbufs strings ;
IN: checksums.sha2 IN: checksums.sha2

4
basis/cocoa/enumeration/enumeration.factor
View File

@ -15,7 +15,7 @@ IN: cocoa.enumeration
object state stackbuf count -> countByEnumeratingWithState:objects:count: object state stackbuf count -> countByEnumeratingWithState:objects:count:
dup zero? [ drop ] [ dup zero? [ drop ] [
state NSFastEnumerationState-itemsPtr [ stackbuf ] unless* state NSFastEnumerationState-itemsPtr [ stackbuf ] unless*
'[ , void*-nth quot call ] each '[ _ void*-nth quot call ] each
object quot state stackbuf count (NSFastEnumeration-each) object quot state stackbuf count (NSFastEnumeration-each)
] if ; inline recursive ] if ; inline recursive
@ -24,7 +24,7 @@ IN: cocoa.enumeration
: NSFastEnumeration-map ( object quot -- vector ) : NSFastEnumeration-map ( object quot -- vector )
NS-EACH-BUFFER-SIZE <vector> NS-EACH-BUFFER-SIZE <vector>
[ '[ @ , push ] NSFastEnumeration-each ] keep ; inline [ '[ @ _ push ] NSFastEnumeration-each ] keep ; inline
: NSFastEnumeration>vector ( object -- vector ) : NSFastEnumeration>vector ( object -- vector )
[ ] NSFastEnumeration-map ; [ ] NSFastEnumeration-map ;

11
basis/cocoa/messages/messages.factor
View File

@ -1,11 +1,10 @@
! Copyright (C) 2006, 2008 Slava Pestov. ! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.strings USING: accessors alien alien.c-types alien.strings arrays assocs
arrays assocs combinators compiler kernel combinators compiler kernel math namespaces make parser
math namespaces parser prettyprint prettyprint.sections prettyprint prettyprint.sections quotations sequences strings
quotations sequences strings words cocoa.runtime io macros words cocoa.runtime io macros memoize debugger
memoize debugger io.encodings.ascii effects compiler.generator io.encodings.ascii effects compiler.generator libc libc.private ;
libc libc.private ;
IN: cocoa.messages IN: cocoa.messages
: make-sender ( method function -- quot ) : make-sender ( method function -- quot )

2
basis/cocoa/subclassing/subclassing.factor
View File

@ -4,7 +4,7 @@ USING: alien alien.c-types alien.strings arrays assocs
combinators compiler hashtables kernel libc math namespaces combinators compiler hashtables kernel libc math namespaces
parser sequences words cocoa.messages cocoa.runtime parser sequences words cocoa.messages cocoa.runtime
compiler.units io.encodings.ascii generalizations compiler.units io.encodings.ascii generalizations
continuations ; continuations make ;
IN: cocoa.subclassing IN: cocoa.subclassing
: init-method ( method -- sel imp types ) : init-method ( method -- sel imp types )

2
basis/cocoa/views/views.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2006, 2007 Slava Pestov ! Copyright (C) 2006, 2007 Slava Pestov
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types arrays kernel math namespaces cocoa USING: alien.c-types arrays kernel math namespaces make cocoa
cocoa.messages cocoa.classes cocoa.types sequences cocoa.messages cocoa.classes cocoa.types sequences
continuations ; continuations ;
IN: cocoa.views IN: cocoa.views

4
basis/combinators/short-circuit/short-circuit.factor
View File

@ -11,7 +11,7 @@ IN: combinators.short-circuit
[ '[ drop N ndup @ dup not ] [ drop N ndrop f ] 2array ] [ '[ drop N ndup @ dup not ] [ drop N ndrop f ] 2array ]
map map
[ t ] [ N nnip ] 2array suffix [ t ] [ N nnip ] 2array suffix
'[ f , cond ] ; '[ f _ cond ] ;
MACRO: 0&& ( quots -- quot ) 0 n&&-rewrite ; MACRO: 0&& ( quots -- quot ) 0 n&&-rewrite ;
MACRO: 1&& ( quots -- quot ) 1 n&&-rewrite ; MACRO: 1&& ( quots -- quot ) 1 n&&-rewrite ;
@ -25,7 +25,7 @@ MACRO: 3&& ( quots -- quot ) 3 n&&-rewrite ;
[ '[ drop N ndup @ dup ] [ N nnip ] 2array ] [ '[ drop N ndup @ dup ] [ N nnip ] 2array ]
map map
[ drop N ndrop t ] [ f ] 2array suffix [ drop N ndrop t ] [ f ] 2array suffix
'[ f , cond ] ; '[ f _ cond ] ;
MACRO: 0|| ( quots -- quot ) 0 n||-rewrite ; MACRO: 0|| ( quots -- quot ) 0 n||-rewrite ;
MACRO: 1|| ( quots -- quot ) 1 n||-rewrite ; MACRO: 1|| ( quots -- quot ) 1 n||-rewrite ;

2
basis/compiler/compiler.factor
View File

@ -54,7 +54,7 @@ SYMBOL: +failed+
H{ } clone dependencies set H{ } clone dependencies set
H{ } clone generic-dependencies set H{ } clone generic-dependencies set
, { _ {
[ compile-begins ] [ compile-begins ]
[ [
[ build-tree-from-word ] [ compile-failed return ] recover [ build-tree-from-word ] [ compile-failed return ] recover

2
basis/compiler/generator/fixup/fixup.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2007, 2008 Slava Pestov. ! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays byte-arrays generic assocs hashtables io.binary USING: arrays byte-arrays generic assocs hashtables io.binary
kernel kernel.private math namespaces sequences words kernel kernel.private math namespaces make sequences words
quotations strings alien.accessors alien.strings layouts system quotations strings alien.accessors alien.strings layouts system
combinators math.bitwise words.private cpu.architecture combinators math.bitwise words.private cpu.architecture
math.order accessors growable ; math.order accessors growable ;

14
basis/compiler/generator/generator.factor
View File

@ -2,14 +2,14 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes combinators USING: accessors arrays assocs classes combinators
cpu.architecture effects generic hashtables io kernel cpu.architecture effects generic hashtables io kernel
kernel.private layouts math math.parser namespaces prettyprint kernel.private layouts math math.parser namespaces make
quotations sequences system threads words vectors sets deques prettyprint quotations sequences system threads words vectors
continuations.private summary alien alien.c-types sets deques continuations.private summary alien alien.c-types
alien.structs alien.strings alien.arrays libc compiler.errors alien.structs alien.strings alien.arrays libc compiler.errors
stack-checker.inlining stack-checker.inlining compiler.tree compiler.tree.builder
compiler.tree compiler.tree.builder compiler.tree.combinators compiler.tree.combinators compiler.tree.propagation.info
compiler.tree.propagation.info compiler.generator.fixup compiler.generator.fixup compiler.generator.registers
compiler.generator.registers compiler.generator.iterator ; compiler.generator.iterator ;
IN: compiler.generator IN: compiler.generator
SYMBOL: compile-queue SYMBOL: compile-queue

6
basis/compiler/generator/registers/registers.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2006, 2008 Slava Pestov. ! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs classes classes.private classes.algebra USING: arrays assocs classes classes.private classes.algebra
combinators hashtables kernel layouts math namespaces quotations combinators hashtables kernel layouts math namespaces make
sequences system vectors words effects alien byte-arrays quotations sequences system vectors words effects alien
accessors sets math.order cpu.architecture byte-arrays accessors sets math.order cpu.architecture
compiler.generator.fixup ; compiler.generator.fixup ;
IN: compiler.generator.registers IN: compiler.generator.registers

2
basis/compiler/tests/curry.factor
View File

@ -1,5 +1,5 @@
USING: tools.test quotations math kernel sequences USING: tools.test quotations math kernel sequences
assocs namespaces compiler.units ; assocs namespaces make compiler.units ;
IN: compiler.tests IN: compiler.tests
[ 3 ] [ 5 [ [ 2 - ] curry call ] compile-call ] unit-test [ 3 ] [ 5 [ [ 2 - ] curry call ] compile-call ] unit-test

2
basis/compiler/tests/templates-early.factor
View File

@ -3,7 +3,7 @@ IN: compiler.tests
USING: compiler compiler.generator compiler.generator.registers USING: compiler compiler.generator compiler.generator.registers
compiler.generator.registers.private tools.test namespaces compiler.generator.registers.private tools.test namespaces
sequences words kernel math effects definitions compiler.units sequences words kernel math effects definitions compiler.units
accessors cpu.architecture ; accessors cpu.architecture make ;
: <int-vreg> ( n -- vreg ) int-regs <vreg> ; : <int-vreg> ( n -- vreg ) int-regs <vreg> ;

23
basis/compiler/tree/cleanup/cleanup-tests.factor
View File

@ -36,7 +36,7 @@ compiler.tree.checker ;
: inlined? ( quot seq/word -- ? ) : inlined? ( quot seq/word -- ? )
[ cleaned-up-tree ] dip [ cleaned-up-tree ] dip
dup word? [ 1array ] when dup word? [ 1array ] when
'[ dup #call? [ word>> , member? ] [ drop f ] if ] '[ dup #call? [ word>> _ member? ] [ drop f ] if ]
contains-node? not ; contains-node? not ;
[ f ] [ [ f ] [
@ -457,3 +457,24 @@ cell-bits 32 = [
[ [ >r "A" throw r> ] [ "B" throw ] if ] [ [ >r "A" throw r> ] [ "B" throw ] if ]
cleaned-up-tree drop cleaned-up-tree drop
] unit-test ] unit-test
! Regression from benchmark.nsieve
: chicken-fingers ( i seq -- )
2dup < [
2drop
] [
chicken-fingers
] if ; inline recursive
: buffalo-wings ( i seq -- )
2dup < [
2dup chicken-fingers
>r 1+ r> buffalo-wings
] [
2drop
] if ; inline recursive
[ t ] [
[ 2 swap >fixnum buffalo-wings ]
{ <-integer-fixnum +-integer-fixnum } inlined?
] unit-test

8
basis/compiler/tree/cleanup/cleanup.factor
View File

@ -101,7 +101,7 @@ M: #declare cleanup* drop f ;
: delete-unreachable-branches ( #branch -- ) : delete-unreachable-branches ( #branch -- )
dup live-branches>> '[ dup live-branches>> '[
, _
[ [ [ drop ] [ delete-nodes ] if ] 2each ] [ [ [ drop ] [ delete-nodes ] if ] 2each ]
[ select-children ] [ select-children ]
2bi 2bi
@ -148,9 +148,9 @@ M: #branch cleanup*
M: #phi cleanup* M: #phi cleanup*
#! Remove #phi function inputs which no longer exist. #! Remove #phi function inputs which no longer exist.
live-branches get live-branches get
[ '[ , sift-children ] change-phi-in-d ] [ '[ _ sift-children ] change-phi-in-d ]
[ '[ , sift-children ] change-phi-info-d ] [ '[ _ sift-children ] change-phi-info-d ]
[ '[ , sift-children ] change-terminated ] tri [ '[ _ sift-children ] change-terminated ] tri
eliminate-phi eliminate-phi
live-branches off ; live-branches off ;

16
basis/compiler/tree/combinators/combinators.factor
View File

@ -6,12 +6,12 @@ IN: compiler.tree.combinators
: each-node ( nodes quot: ( node -- ) -- ) : each-node ( nodes quot: ( node -- ) -- )
dup dup '[ dup dup '[
, [ _ [
dup #branch? [ dup #branch? [
children>> [ , each-node ] each children>> [ _ each-node ] each
] [ ] [
dup #recursive? [ dup #recursive? [
child>> , each-node child>> _ each-node
] [ drop ] if ] [ drop ] if
] if ] if
] bi ] bi
@ -21,22 +21,22 @@ IN: compiler.tree.combinators
dup dup '[ dup dup '[
@ @
dup #branch? [ dup #branch? [
[ [ , map-nodes ] map ] change-children [ [ _ map-nodes ] map ] change-children
] [ ] [
dup #recursive? [ dup #recursive? [
[ , map-nodes ] change-child [ _ map-nodes ] change-child
] when ] when
] if ] if
] map flatten ; inline recursive ] map flatten ; inline recursive
: contains-node? ( nodes quot: ( node -- ? ) -- ? ) : contains-node? ( nodes quot: ( node -- ? ) -- ? )
dup dup '[ dup dup '[
, keep swap [ drop t ] [ _ keep swap [ drop t ] [
dup #branch? [ dup #branch? [
children>> [ , contains-node? ] contains? children>> [ _ contains-node? ] contains?
] [ ] [
dup #recursive? [ dup #recursive? [
child>> , contains-node? child>> _ contains-node?
] [ drop f ] if ] [ drop f ] if
] if ] if
] if ] if

6
basis/compiler/tree/dead-code/branches/branches.factor
View File

@ -33,7 +33,7 @@ M: #branch remove-dead-code*
: live-value-indices ( values -- indices ) : live-value-indices ( values -- indices )
[ length ] keep live-values get [ length ] keep live-values get
'[ , nth , key? ] filter ; inline '[ _ nth _ key? ] filter ; inline
: drop-indexed-values ( values indices -- node ) : drop-indexed-values ( values indices -- node )
[ drop filter-live ] [ nths ] 2bi [ drop filter-live ] [ nths ] 2bi
@ -44,13 +44,13 @@ M: #branch remove-dead-code*
: insert-drops ( nodes values indices -- nodes' ) : insert-drops ( nodes values indices -- nodes' )
'[ '[
over ends-with-terminate? over ends-with-terminate?
[ drop ] [ , drop-indexed-values suffix ] if [ drop ] [ _ drop-indexed-values suffix ] if
] 2map ; ] 2map ;
: hoist-drops ( #phi -- ) : hoist-drops ( #phi -- )
if-node get swap if-node get swap
[ phi-in-d>> ] [ out-d>> live-value-indices ] bi [ phi-in-d>> ] [ out-d>> live-value-indices ] bi
'[ , , insert-drops ] change-children drop ; '[ _ _ insert-drops ] change-children drop ;
: remove-phi-outputs ( #phi -- ) : remove-phi-outputs ( #phi -- )
[ filter-live ] change-out-d drop ; [ filter-live ] change-out-d drop ;

2
basis/compiler/tree/dead-code/simple/simple.factor
View File

@ -53,7 +53,7 @@ M: #alien-invoke compute-live-values* nip look-at-inputs ;
M: #alien-indirect compute-live-values* nip look-at-inputs ; M: #alien-indirect compute-live-values* nip look-at-inputs ;
: filter-mapping ( assoc -- assoc' ) : filter-mapping ( assoc -- assoc' )
live-values get '[ drop , key? ] assoc-filter ; live-values get '[ drop _ key? ] assoc-filter ;
: filter-corresponding ( new old -- old' ) : filter-corresponding ( new old -- old' )
#! Remove elements from 'old' if the element with the same #! Remove elements from 'old' if the element with the same

4
basis/compiler/tree/debugger/debugger.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2006, 2008 Slava Pestov. ! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel assocs fry match accessors namespaces effects USING: kernel assocs fry match accessors namespaces make effects
sequences sequences.private quotations generic macros arrays sequences sequences.private quotations generic macros arrays
prettyprint prettyprint.backend prettyprint.sections math words prettyprint prettyprint.backend prettyprint.sections math words
combinators io sorting hints combinators io sorting hints
@ -16,7 +16,7 @@ IN: compiler.tree.debugger
GENERIC: node>quot ( node -- ) GENERIC: node>quot ( node -- )
MACRO: match-choose ( alist -- ) MACRO: match-choose ( alist -- )
[ '[ , ] ] assoc-map '[ , match-cond ] ; [ [ ] curry ] assoc-map [ match-cond ] curry ;
MATCH-VARS: ?a ?b ?c ; MATCH-VARS: ?a ?b ?c ;

4
basis/compiler/tree/escape-analysis/recursive/recursive.factor
View File

@ -28,7 +28,7 @@ IN: compiler.tree.escape-analysis.recursive
: recursive-stacks ( #enter-recursive -- stacks ) : recursive-stacks ( #enter-recursive -- stacks )
recursive-phi-in recursive-phi-in
escaping-values get '[ [ , disjoint-set-member? ] all? ] filter escaping-values get '[ [ _ disjoint-set-member? ] all? ] filter
flip ; flip ;
: analyze-recursive-phi ( #enter-recursive -- ) : analyze-recursive-phi ( #enter-recursive -- )
@ -67,5 +67,5 @@ M: #return-recursive escape-analysis* ( #return-recursive -- )
[ call-next-method ] [ call-next-method ]
[ [
[ in-d>> ] [ label>> calls>> ] bi [ in-d>> ] [ label>> calls>> ] bi
[ out-d>> escaping-values get '[ , equate ] 2each ] with each [ out-d>> escaping-values get '[ _ equate ] 2each ] with each
] bi ; ] bi ;

4
basis/compiler/tree/finalization/finalization.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel arrays accessors sequences sequences.private words USING: kernel arrays accessors sequences sequences.private words
fry namespaces math math.order memoize classes.builtin fry namespaces make math math.order memoize classes.builtin
classes.tuple.private slots.private combinators layouts classes.tuple.private slots.private combinators layouts
byte-arrays alien.accessors byte-arrays alien.accessors
compiler.intrinsics compiler.intrinsics
@ -68,7 +68,7 @@ MEMO: builtin-predicate-expansion ( word -- nodes )
MEMO: (tuple-boa-expansion) ( n -- quot ) MEMO: (tuple-boa-expansion) ( n -- quot )
[ [
[ 2 + ] map <reversed> [ 2 + ] map <reversed>
[ '[ [ , set-slot ] keep ] % ] each [ '[ [ _ set-slot ] keep ] % ] each
] [ ] make ; ] [ ] make ;
: tuple-boa-expansion ( layout -- quot ) : tuple-boa-expansion ( layout -- quot )

16
basis/compiler/tree/normalization/normalization.factor
View File

@ -81,7 +81,7 @@ SYMBOL: rename-map
[ rename-map get at ] keep or ; [ rename-map get at ] keep or ;
: rename-values ( values -- values' ) : rename-values ( values -- values' )
rename-map get '[ [ , at ] keep or ] map ; rename-map get '[ [ _ at ] keep or ] map ;
GENERIC: rename-node-values* ( node -- node ) GENERIC: rename-node-values* ( node -- node )
@ -127,7 +127,7 @@ SYMBOL: introduction-stack
: add-renamings ( old new -- ) : add-renamings ( old new -- )
[ rename-values ] dip [ rename-values ] dip
rename-map get '[ , set-at ] 2each ; rename-map get '[ _ set-at ] 2each ;
M: #introduce normalize* M: #introduce normalize*
out-d>> [ length pop-introductions ] keep add-renamings f ; out-d>> [ length pop-introductions ] keep add-renamings f ;
@ -158,7 +158,7 @@ M: #branch normalize*
M: #phi normalize* M: #phi normalize*
remaining-introductions get swap dup terminated>> remaining-introductions get swap dup terminated>>
'[ , eliminate-phi-introductions ] change-phi-in-d ; '[ _ eliminate-phi-introductions ] change-phi-in-d ;
: (normalize) ( nodes introductions -- nodes ) : (normalize) ( nodes introductions -- nodes )
introduction-stack [ introduction-stack [
@ -168,7 +168,7 @@ M: #phi normalize*
M: #recursive normalize* M: #recursive normalize*
dup label>> introductions>> dup label>> introductions>>
[ drop [ child>> first ] [ in-d>> ] bi >>in-d drop ] [ drop [ child>> first ] [ in-d>> ] bi >>in-d drop ]
[ make-values '[ , (normalize) ] change-child ] [ make-values '[ _ (normalize) ] change-child ]
2bi ; 2bi ;
M: #enter-recursive normalize* M: #enter-recursive normalize*
@ -181,14 +181,14 @@ M: #enter-recursive normalize*
: call<return ( #call-recursive n -- nodes ) : call<return ( #call-recursive n -- nodes )
neg dup make-values [ neg dup make-values [
[ pop-introductions '[ , prepend ] change-in-d ] [ pop-introductions '[ _ prepend ] change-in-d ]
[ '[ , prepend ] change-out-d ] [ '[ _ prepend ] change-out-d ]
bi* bi*
] [ introduction-stack [ prepend ] change ] bi ; ] [ introduction-stack [ prepend ] change ] bi ;
: call>return ( #call-recursive n -- #call-recursive ) : call>return ( #call-recursive n -- #call-recursive )
[ [ [ in-d>> ] [ out-d>> ] bi ] [ '[ , head ] ] bi* bi@ add-renamings ] [ [ [ in-d>> ] [ out-d>> ] bi ] [ '[ _ head ] ] bi* bi@ add-renamings ]
[ '[ , tail ] [ change-in-d ] [ change-out-d ] bi ] [ '[ _ tail ] [ change-in-d ] [ change-out-d ] bi ]
2bi ; 2bi ;
M: #call-recursive normalize* M: #call-recursive normalize*

4
basis/compiler/tree/propagation/branches/branches.factor
View File

@ -32,7 +32,7 @@ M: #if live-branches
M: #dispatch live-branches M: #dispatch live-branches
[ children>> length ] [ in-d>> first value-info interval>> ] bi [ children>> length ] [ in-d>> first value-info interval>> ] bi
'[ , interval-contains? ] map ; '[ _ interval-contains? ] map ;
: live-children ( #branch -- children ) : live-children ( #branch -- children )
[ children>> ] [ live-branches>> ] bi select-children ; [ children>> ] [ live-branches>> ] bi select-children ;
@ -61,7 +61,7 @@ SYMBOL: infer-children-data
infer-children-data get infer-children-data get
[ [
'[ '[
, [ _ [
dup +bottom+ eq? dup +bottom+ eq?
[ drop null-info ] [ value-info ] if [ drop null-info ] [ value-info ] if
] bind ] bind

14
basis/compiler/tree/propagation/known-words/known-words.factor
View File

@ -118,7 +118,7 @@ most-negative-fixnum most-positive-fixnum [a,b]
: binary-op ( word interval-quot post-proc-quot -- ) : binary-op ( word interval-quot post-proc-quot -- )
'[ '[
[ binary-op-class ] [ , binary-op-interval ] 2bi [ binary-op-class ] [ _ binary-op-interval ] 2bi
@ @
<class/interval-info> <class/interval-info>
] "outputs" set-word-prop ; ] "outputs" set-word-prop ;
@ -159,14 +159,14 @@ most-negative-fixnum most-positive-fixnum [a,b]
in1 in2 op negate-comparison (comparison-constraints) out f--> /\ ; in1 in2 op negate-comparison (comparison-constraints) out f--> /\ ;
: define-comparison-constraints ( word op -- ) : define-comparison-constraints ( word op -- )
'[ , comparison-constraints ] "constraints" set-word-prop ; '[ _ comparison-constraints ] "constraints" set-word-prop ;
comparison-ops comparison-ops
[ dup '[ , define-comparison-constraints ] each-derived-op ] each [ dup '[ _ define-comparison-constraints ] each-derived-op ] each
generic-comparison-ops [ generic-comparison-ops [
dup specific-comparison dup specific-comparison
'[ , , define-comparison-constraints ] each-derived-op '[ _ _ define-comparison-constraints ] each-derived-op
] each ] each
! Remove redundant comparisons ! Remove redundant comparisons
@ -179,13 +179,13 @@ generic-comparison-ops [
comparison-ops [ comparison-ops [
dup '[ dup '[
[ , fold-comparison ] "outputs" set-word-prop [ _ fold-comparison ] "outputs" set-word-prop
] each-derived-op ] each-derived-op
] each ] each
generic-comparison-ops [ generic-comparison-ops [
dup specific-comparison dup specific-comparison
'[ , fold-comparison ] "outputs" set-word-prop '[ _ fold-comparison ] "outputs" set-word-prop
] each ] each
: maybe-or-never ( ? -- info ) : maybe-or-never ( ? -- info )
@ -221,7 +221,7 @@ generic-comparison-ops [
{ >float float } { >float float }
} [ } [
'[ '[
, _
[ nip ] [ [ nip ] [
[ interval>> ] [ class-interval ] bi* [ interval>> ] [ class-interval ] bi*
interval-intersect interval-intersect

4
basis/compiler/tree/propagation/simple/simple.factor
View File

@ -68,8 +68,8 @@ M: #declare propagate-before
[ in-d>> [ value-info literal?>> ] all? ] [ drop f ] if ; [ in-d>> [ value-info literal?>> ] all? ] [ drop f ] if ;
: (fold-call) ( #call word -- info ) : (fold-call) ( #call word -- info )
[ [ out-d>> ] [ in-d>> [ value-info literal>> ] map ] bi ] [ '[ , execute ] ] bi* [ [ out-d>> ] [ in-d>> [ value-info literal>> ] map ] bi ] [ '[ _ execute ] ] bi*
'[ , , with-datastack [ <literal-info> ] map nip ] '[ _ _ with-datastack [ <literal-info> ] map nip ]
[ drop [ object-info ] replicate ] [ drop [ object-info ] replicate ]
recover ; recover ;

2
basis/compiler/tree/tree.factor
View File

@ -178,7 +178,7 @@ M: #return-recursive inputs/outputs [ in-d>> ] [ out-d>> ] bi ;
: shuffle-effect ( #shuffle -- effect ) : shuffle-effect ( #shuffle -- effect )
[ in-d>> ] [ out-d>> ] [ mapping>> ] tri [ in-d>> ] [ out-d>> ] [ mapping>> ] tri
'[ , at ] map '[ _ at ] map
<effect> ; <effect> ;
: recursive-phi-in ( #enter-recursive -- seq ) : recursive-phi-in ( #enter-recursive -- seq )

7
basis/concurrency/messaging/messaging-tests.factor
View File

@ -1,9 +1,8 @@
! Copyright (C) 2005 Chris Double. All Rights Reserved. ! Copyright (C) 2005 Chris Double. All Rights Reserved.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
! USING: kernel threads vectors arrays sequences namespaces make
USING: kernel threads vectors arrays sequences tools.test continuations deques strings math words match
namespaces tools.test continuations deques strings math words quotations concurrency.messaging concurrency.mailboxes
match quotations concurrency.messaging concurrency.mailboxes
concurrency.count-downs accessors ; concurrency.count-downs accessors ;
IN: concurrency.messaging.tests IN: concurrency.messaging.tests

6
basis/core-foundation/fsevents/fsevents.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2008 Slava Pestov ! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings alien.syntax kernel USING: alien alien.c-types alien.strings alien.syntax kernel
math sequences namespaces assocs init accessors continuations math sequences namespaces make assocs init accessors
combinators core-foundation core-foundation.run-loop continuations combinators core-foundation
io.encodings.utf8 destructors ; core-foundation.run-loop io.encodings.utf8 destructors ;
IN: core-foundation.fsevents IN: core-foundation.fsevents
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !

4
basis/cpu/architecture/architecture.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2006, 2008 Slava Pestov. ! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays generic kernel kernel.private math memory USING: arrays generic kernel kernel.private math memory
namespaces sequences layouts system hashtables classes alien namespaces make sequences layouts system hashtables classes
byte-arrays combinators words sets ; alien byte-arrays combinators words sets ;
IN: cpu.architecture IN: cpu.architecture
! Register classes ! Register classes

2
basis/cpu/ppc/assembler/assembler-tests.factor
View File

@ -1,6 +1,6 @@
IN: cpu.ppc.assembler.tests IN: cpu.ppc.assembler.tests
USING: cpu.ppc.assembler tools.test arrays kernel namespaces USING: cpu.ppc.assembler tools.test arrays kernel namespaces
vocabs sequences ; make vocabs sequences ;
: test-assembler ( expected quot -- ) : test-assembler ( expected quot -- )
[ 1array ] [ [ { } make ] curry ] bi* unit-test ; [ 1array ] [ [ { } make ] curry ] bi* unit-test ;

2
basis/cpu/ppc/assembler/backend/backend.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: compiler.generator.fixup kernel namespaces sequences USING: compiler.generator.fixup kernel namespaces make sequences
words math math.bitwise io.binary parser lexer ; words math math.bitwise io.binary parser lexer ;
IN: cpu.ppc.assembler.backend IN: cpu.ppc.assembler.backend

2
basis/cpu/x86/architecture/architecture.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types arrays cpu.x86.assembler USING: accessors alien alien.c-types arrays cpu.x86.assembler
cpu.x86.assembler.private cpu.architecture kernel kernel.private cpu.x86.assembler.private cpu.architecture kernel kernel.private
math memory namespaces sequences words compiler.generator math memory namespaces make sequences words compiler.generator
compiler.generator.registers compiler.generator.fixup system compiler.generator.registers compiler.generator.fixup system
layouts combinators compiler.constants math.order ; layouts combinators compiler.constants math.order ;
IN: cpu.x86.architecture IN: cpu.x86.architecture

2
basis/cpu/x86/assembler/assembler-tests.factor
View File

@ -1,4 +1,4 @@
USING: cpu.x86.assembler kernel tools.test namespaces ; USING: cpu.x86.assembler kernel tools.test namespaces make ;
IN: cpu.x86.assembler.tests IN: cpu.x86.assembler.tests
[ { HEX: 49 HEX: 89 HEX: 04 HEX: 24 } ] [ [ R12 [] RAX MOV ] { } make ] unit-test [ { HEX: 49 HEX: 89 HEX: 04 HEX: 24 } ] [ [ R12 [] RAX MOV ] { } make ] unit-test

2
basis/cpu/x86/assembler/assembler.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2008 Slava Pestov. ! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays compiler.generator.fixup io.binary kernel USING: arrays compiler.generator.fixup io.binary kernel
combinators kernel.private math namespaces sequences combinators kernel.private math namespaces make sequences
words system layouts math.order accessors words system layouts math.order accessors
cpu.x86.assembler.syntax ; cpu.x86.assembler.syntax ;
IN: cpu.x86.assembler IN: cpu.x86.assembler

3
basis/csv/csv.factor
View File

@ -4,7 +4,8 @@
! Simple CSV Parser ! Simple CSV Parser
! Phil Dawes phil@phildawes.net ! Phil Dawes phil@phildawes.net
USING: kernel sequences io namespaces combinators unicode.categories ; USING: kernel sequences io namespaces make
combinators unicode.categories ;
IN: csv IN: csv
SYMBOL: delimiter SYMBOL: delimiter

2
basis/db/postgresql/postgresql.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2007, 2008 Doug Coleman. ! Copyright (C) 2007, 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs alien alien.syntax continuations io USING: arrays assocs alien alien.syntax continuations io
kernel math math.parser namespaces prettyprint quotations kernel math math.parser namespaces make prettyprint quotations
sequences debugger db db.postgresql.lib db.postgresql.ffi sequences debugger db db.postgresql.lib db.postgresql.ffi
db.tuples db.types tools.annotations math.ranges db.tuples db.types tools.annotations math.ranges
combinators classes locals words tools.walker combinators classes locals words tools.walker

8
basis/db/queries/queries.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel math namespaces sequences random strings USING: accessors kernel math namespaces make sequences random
math.parser math.intervals combinators math.bitwise nmake db strings math.parser math.intervals combinators math.bitwise
db.tuples db.types db.sql classes words shuffle arrays destructors nmake db db.tuples db.types db.sql classes words shuffle arrays
continuations ; destructors continuations ;
IN: db.queries IN: db.queries
GENERIC: where ( specs obj -- ) GENERIC: where ( specs obj -- )

2
basis/db/tuples/tuples-docs.factor
View File

@ -154,7 +154,7 @@ T{ book
"Now we've created a book. Let's save it to the database." "Now we've created a book. Let's save it to the database."
{ $code <" USING: db db.sqlite fry io.files ; { $code <" USING: db db.sqlite fry io.files ;
: with-book-tutorial ( quot -- ) : with-book-tutorial ( quot -- )
'[ "book-tutorial.db" temp-file sqlite-db , with-db ] call ; '[ "book-tutorial.db" temp-file sqlite-db _ with-db ] call ;
[ [
book recreate-table book recreate-table

4
basis/db/tuples/tuples-tests.factor
View File

@ -201,10 +201,10 @@ TUPLE: annotation n paste-id summary author mode contents ;
! ] with-db ! ] with-db
: test-sqlite ( quot -- ) : test-sqlite ( quot -- )
[ ] swap '[ "tuples-test.db" temp-file sqlite-db , with-db ] unit-test ; [ ] swap '[ "tuples-test.db" temp-file sqlite-db _ with-db ] unit-test ;
: test-postgresql ( quot -- ) : test-postgresql ( quot -- )
[ ] swap '[ { "localhost" "postgres" "foob" "factor-test" } postgresql-db , with-db ] unit-test ; [ ] swap '[ { "localhost" "postgres" "foob" "factor-test" } postgresql-db _ with-db ] unit-test ;
: test-repeated-insert : test-repeated-insert
[ ] [ person ensure-table ] unit-test [ ] [ person ensure-table ] unit-test

12
basis/debugger/debugger.factor
View File

@ -1,12 +1,12 @@
! Copyright (C) 2004, 2008 Slava Pestov. ! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: slots arrays definitions generic hashtables summary io USING: slots arrays definitions generic hashtables summary io
kernel math namespaces prettyprint prettyprint.config sequences kernel math namespaces make prettyprint prettyprint.config
assocs sequences.private strings io.styles io.files vectors sequences assocs sequences.private strings io.styles io.files
words system splitting math.parser classes.tuple continuations vectors words system splitting math.parser classes.tuple
continuations.private combinators generic.math classes.builtin continuations continuations.private combinators generic.math
classes compiler.units generic.standard vocabs init classes.builtin classes compiler.units generic.standard vocabs
kernel.private io.encodings accessors math.order init kernel.private io.encodings accessors math.order
destructors source-files parser classes.tuple.parser destructors source-files parser classes.tuple.parser
effects.parser lexer compiler.errors generic.parser effects.parser lexer compiler.errors generic.parser
strings.parser ; strings.parser ;

2
basis/debugger/threads/threads.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors debugger continuations threads threads.private USING: accessors debugger continuations threads threads.private
io io.styles prettyprint kernel math.parser namespaces ; io io.styles prettyprint kernel math.parser namespaces make ;
IN: debugger.threads IN: debugger.threads
: error-in-thread. ( thread -- ) : error-in-thread. ( thread -- )

2
basis/delegate/delegate.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors parser generic kernel classes classes.tuple USING: accessors parser generic kernel classes classes.tuple
words slots assocs sequences arrays vectors definitions words slots assocs sequences arrays vectors definitions
prettyprint math hashtables sets macros namespaces ; prettyprint math hashtables sets macros namespaces make ;
IN: delegate IN: delegate
: protocol-words ( protocol -- words ) : protocol-words ( protocol -- words )

8
basis/disjoint-sets/disjoint-sets.factor
View File

@ -64,7 +64,7 @@ M: disjoint-set add-atom
[ 1 -rot counts>> set-at ] [ 1 -rot counts>> set-at ]
2tri ; 2tri ;
: add-atoms ( seq disjoint-set -- ) '[ , add-atom ] each ; : add-atoms ( seq disjoint-set -- ) '[ _ add-atom ] each ;
GENERIC: disjoint-set-member? ( a disjoint-set -- ? ) GENERIC: disjoint-set-member? ( a disjoint-set -- ? )
@ -89,7 +89,7 @@ M:: disjoint-set equate ( a b disjoint-set -- )
] if ; ] if ;
: equate-all-with ( seq a disjoint-set -- ) : equate-all-with ( seq a disjoint-set -- )
'[ , , equate ] each ; '[ _ _ equate ] each ;
: equate-all ( seq disjoint-set -- ) : equate-all ( seq disjoint-set -- )
over empty? [ 2drop ] [ over empty? [ 2drop ] [
@ -102,7 +102,7 @@ M: disjoint-set clone
: assoc>disjoint-set ( assoc -- disjoint-set ) : assoc>disjoint-set ( assoc -- disjoint-set )
<disjoint-set> <disjoint-set>
[ '[ drop , add-atom ] assoc-each ] [ '[ drop _ add-atom ] assoc-each ]
[ '[ , equate ] assoc-each ] [ '[ _ equate ] assoc-each ]
[ nip ] [ nip ]
2tri ; 2tri ;

2
basis/documents/documents.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2006, 2007 Slava Pestov ! Copyright (C) 2006, 2007 Slava Pestov
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays io kernel math models namespaces USING: accessors arrays io kernel math models namespaces make
sequences strings splitting combinators unicode.categories sequences strings splitting combinators unicode.categories
math.order ; math.order ;
IN: documents IN: documents

55
basis/fry/fry-docs.factor
View File

@ -1,15 +1,12 @@
USING: help.markup help.syntax quotations kernel ; USING: help.markup help.syntax quotations kernel ;
IN: fry IN: fry
HELP: , HELP: _
{ $description "Fry specifier. Inserts a literal value into the fried quotation." } ; { $description "Fry specifier. Inserts a literal value into the fried quotation." } ;
HELP: @ HELP: @
{ $description "Fry specifier. Splices a quotation into the fried quotation." } ; { $description "Fry specifier. Splices a quotation into the fried quotation." } ;
HELP: _
{ $description "Fry specifier. Shifts all fry specifiers to the left down by one stack position." } ;
HELP: fry HELP: fry
{ $values { "quot" quotation } { "quot'" quotation } } { $values { "quot" quotation } { "quot'" quotation } }
{ $description "Outputs a quotation that when called, fries " { $snippet "quot" } " by taking values from the stack and substituting them in." } { $description "Outputs a quotation that when called, fries " { $snippet "quot" } " by taking values from the stack and substituting them in." }
@ -19,7 +16,7 @@ HELP: fry
HELP: '[ HELP: '[
{ $syntax "code... ]" } { $syntax "code... ]" }
{ $description "Literal fried quotation. Expands into code which takes values from the stack and substitutes them in place of the fry specifiers " { $link , } " and " { $link @ } "." } { $description "Literal fried quotation. Expands into code which takes values from the stack and substitutes them in place of the fry specifiers " { $link _ } " and " { $link @ } "." }
{ $examples "See " { $link "fry.examples" } "." } ; { $examples "See " { $link "fry.examples" } "." } ;
ARTICLE: "fry.examples" "Examples of fried quotations" ARTICLE: "fry.examples" "Examples of fried quotations"
@ -27,69 +24,50 @@ ARTICLE: "fry.examples" "Examples of fried quotations"
$nl $nl
"If a quotation does not contain any fry specifiers, then " { $link POSTPONE: '[ } " behaves just like " { $link POSTPONE: [ } ":" "If a quotation does not contain any fry specifiers, then " { $link POSTPONE: '[ } " behaves just like " { $link POSTPONE: [ } ":"
{ $code "{ 10 20 30 } '[ . ] each" } { $code "{ 10 20 30 } '[ . ] each" }
"Occurrences of " { $link , } " on the left map directly to " { $link curry } ". That is, the following three lines are equivalent:" "Occurrences of " { $link _ } " on the left map directly to " { $link curry } ". That is, the following three lines are equivalent:"
{ $code { $code
"{ 10 20 30 } 5 '[ , + ] map" "{ 10 20 30 } 5 '[ _ + ] map"
"{ 10 20 30 } 5 [ + ] curry map" "{ 10 20 30 } 5 [ + ] curry map"
"{ 10 20 30 } [ 5 + ] map" "{ 10 20 30 } [ 5 + ] map"
} }
"Occurrences of " { $link , } " in the middle of a quotation map to more complex quotation composition patterns. The following three lines are equivalent:" "Occurrences of " { $link _ } " in the middle of a quotation map to more complex quotation composition patterns. The following three lines are equivalent:"
{ $code { $code
"{ 10 20 30 } 5 '[ 3 , / ] map" "{ 10 20 30 } 5 '[ 3 _ / ] map"
"{ 10 20 30 } 5 [ 3 ] swap [ / ] curry compose map" "{ 10 20 30 } 5 [ 3 ] swap [ / ] curry compose map"
"{ 10 20 30 } [ 3 5 / ] map" "{ 10 20 30 } [ 3 5 / ] map"
} }
"Occurrences of " { $link @ } " are simply syntax sugar for " { $snippet ", call" } ". The following four lines are equivalent:" "Occurrences of " { $link @ } " are simply syntax sugar for " { $snippet "_ call" } ". The following four lines are equivalent:"
{ $code { $code
"{ 10 20 30 } [ sq ] '[ @ . ] each" "{ 10 20 30 } [ sq ] '[ @ . ] each"
"{ 10 20 30 } [ sq ] [ call . ] curry each" "{ 10 20 30 } [ sq ] [ call . ] curry each"
"{ 10 20 30 } [ sq ] [ . ] compose each" "{ 10 20 30 } [ sq ] [ . ] compose each"
"{ 10 20 30 } [ sq . ] each" "{ 10 20 30 } [ sq . ] each"
} }
"The " { $link , } " and " { $link @ } " specifiers may be freely mixed:" "The " { $link _ } " and " { $link @ } " specifiers may be freely mixed:"
{ $code { $code
"{ 8 13 14 27 } [ even? ] 5 '[ @ dup , ? ] map" "{ 8 13 14 27 } [ even? ] 5 '[ @ dup _ ? ] map"
"{ 8 13 14 27 } [ even? ] 5 [ dup ] swap [ ? ] curry 3compose map" "{ 8 13 14 27 } [ even? ] 5 [ dup ] swap [ ? ] curry 3compose map"
"{ 8 13 14 27 } [ even? dup 5 ? ] map" "{ 8 13 14 27 } [ even? dup 5 ? ] map"
} }
"Occurrences of " { $link _ } " have the effect of enclosing all code to their left in a quotation passed to " { $link dip } ". The following four lines are equivalent:"
{ $code
"{ 10 20 30 } 1 '[ , _ / ] map"
"{ 10 20 30 } 1 [ [ ] curry dip / ] curry map"
"{ 10 20 30 } 1 [ swap / ] curry map"
"{ 10 20 30 } [ 1 swap / ] map"
}
"For any quotation body " { $snippet "X" } ", the following two are equivalent:"
{ $code
"[ [ X ] dip ]"
"'[ X _ ]"
}
"Here are some built-in combinators rewritten in terms of fried quotations:" "Here are some built-in combinators rewritten in terms of fried quotations:"
{ $table { $table
{ { $link literalize } { $snippet ": literalize '[ , ] ;" } } { { $link literalize } { $snippet ": literalize '[ _ ] ;" } }
{ { $link slip } { $snippet ": slip '[ @ , ] call ;" } } { { $link slip } { $snippet ": slip '[ @ _ ] call ;" } }
{ { $link dip } { $snippet ": dip '[ @ _ ] call ;" } } { { $link curry } { $snippet ": curry '[ _ @ ] ;" } }
{ { $link curry } { $snippet ": curry '[ , @ ] ;" } }
{ { $link with } { $snippet ": with swapd '[ , _ @ ] ;" } }
{ { $link compose } { $snippet ": compose '[ @ @ ] ;" } } { { $link compose } { $snippet ": compose '[ @ @ ] ;" } }
{ { $link bi@ } { $snippet ": bi@ tuck '[ , @ , @ ] call ;" } } { { $link bi@ } { $snippet ": bi@ tuck '[ _ @ _ @ ] call ;" } }
} ; } ;
ARTICLE: "fry.philosophy" "Fried quotation philosophy" ARTICLE: "fry.philosophy" "Fried quotation philosophy"
"Fried quotations generalize quotation-building words such as " { $link curry } " and " { $link compose } ". They can clean up code with lots of currying and composition, particularly when quotations are nested:" "Fried quotations generalize quotation-building words such as " { $link curry } " and " { $link compose } ". They can clean up code with lots of currying and composition, particularly when quotations are nested:"
{ $code { $code
"'[ [ , key? ] all? ] filter" "'[ [ _ key? ] all? ] filter"
"[ [ key? ] curry all? ] curry filter" "[ [ key? ] curry all? ] curry filter"
} }
"There is a mapping from fried quotations to lexical closures as defined in the " { $vocab-link "locals" } " vocabulary. Namely, a fried quotation is equivalent to a ``let'' form where each local binding is only used once, and bindings are used in the same order in which they are defined. The following two lines are equivalent:" "There is a mapping from fried quotations to lexical closures as defined in the " { $vocab-link "locals" } " vocabulary. Namely, a fried quotation is equivalent to a ``let'' form where each local binding is only used once, and bindings are used in the same order in which they are defined. The following two lines are equivalent:"
{ $code { $code
"'[ 3 , + 4 , / ]" "'[ 3 _ + 4 _ / ]"
"[let | a [ ] b [ ] | [ 3 a + 4 b / ] ]" "[let | a [ ] b [ ] | [ 3 a + 4 b / ] ]"
}
"The " { $link _ } " fry specifier has no direct analogue in " { $vocab-link "locals" } ", however closure conversion together with the " { $link dip } " combinator achieve the same effect:"
{ $code
"'[ , 2 + , * _ / ]"
"[let | a [ ] b [ ] | [ [ a 2 + b * ] dip / ] ]"
} ; } ;
ARTICLE: "fry.limitations" "Fried quotation limitations" ARTICLE: "fry.limitations" "Fried quotation limitations"
@ -101,9 +79,8 @@ $nl
"Fried quotations are denoted with a special parsing word:" "Fried quotations are denoted with a special parsing word:"
{ $subsection POSTPONE: '[ } { $subsection POSTPONE: '[ }
"Fried quotations contain zero or more " { $emphasis "fry specifiers" } ":" "Fried quotations contain zero or more " { $emphasis "fry specifiers" } ":"
{ $subsection , }
{ $subsection @ }
{ $subsection _ } { $subsection _ }
{ $subsection @ }
"When a fried quotation is being evaluated, values are consumed from the stack and spliced into the quotation from right to left." "When a fried quotation is being evaluated, values are consumed from the stack and spliced into the quotation from right to left."
{ $subsection "fry.examples" } { $subsection "fry.examples" }
{ $subsection "fry.philosophy" } { $subsection "fry.philosophy" }

34
basis/fry/fry-tests.factor
View File

@ -2,63 +2,59 @@ IN: fry.tests
USING: fry tools.test math prettyprint kernel io arrays USING: fry tools.test math prettyprint kernel io arrays
sequences ; sequences ;
[ [ 3 + ] ] [ 3 '[ , + ] ] unit-test [ [ 3 + ] ] [ 3 '[ _ + ] ] unit-test
[ [ 1 3 + ] ] [ 1 3 '[ , , + ] ] unit-test [ [ 1 3 + ] ] [ 1 3 '[ _ _ + ] ] unit-test
[ [ 1 + ] ] [ 1 [ + ] '[ , @ ] ] unit-test [ [ 1 + ] ] [ 1 [ + ] '[ _ @ ] ] unit-test
[ [ 1 + . ] ] [ 1 [ + ] '[ , @ . ] ] unit-test [ [ 1 + . ] ] [ 1 [ + ] '[ _ @ . ] ] unit-test
[ [ + - ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test [ [ + - ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test
[ [ "a" write "b" print ] ] [ [ "a" write "b" print ] ]
[ "a" "b" '[ , write , print ] ] unit-test [ "a" "b" '[ _ write _ print ] ] unit-test
[ [ 1 2 + 3 4 - ] ] [ [ 1 2 + 3 4 - ] ]
[ [ + ] [ - ] '[ 1 2 @ 3 4 @ ] ] unit-test [ [ + ] [ - ] '[ 1 2 @ 3 4 @ ] ] unit-test
[ 1/2 ] [ [ 1/2 ] [
1 '[ , _ / ] 2 swap call 1 '[ [ _ ] dip / ] 2 swap call
] unit-test ] unit-test
[ { { 1 "a" "A" } { 1 "b" "B" } { 1 "c" "C" } } ] [ [ { { 1 "a" "A" } { 1 "b" "B" } { 1 "c" "C" } } ] [
1 '[ , _ _ 3array ] 1 '[ [ _ ] 2dip 3array ]
{ "a" "b" "c" } { "A" "B" "C" } rot 2map { "a" "b" "c" } { "A" "B" "C" } rot 2map
] unit-test ] unit-test
[ { { 1 "a" } { 1 "b" } { 1 "c" } } ] [ [ { { 1 "a" } { 1 "b" } { 1 "c" } } ] [
'[ 1 _ 2array ] '[ [ 1 ] dip 2array ]
{ "a" "b" "c" } swap map { "a" "b" "c" } swap map
] unit-test ] unit-test
[ 1 2 ] [
1 2 '[ _ , ] call
] unit-test
[ { { 1 "a" 2 } { 1 "b" 2 } { 1 "c" 2 } } ] [ [ { { 1 "a" 2 } { 1 "b" 2 } { 1 "c" 2 } } ] [
1 2 '[ , _ , 3array ] 1 2 '[ [ _ ] dip _ 3array ]
{ "a" "b" "c" } swap map { "a" "b" "c" } swap map
] unit-test ] unit-test
: funny-dip '[ @ _ ] call ; inline : funny-dip '[ [ @ ] dip ] call ; inline
[ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test [ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test
[ { 1 2 3 } ] [ [ { 1 2 3 } ] [
3 1 '[ , [ , + ] map ] call 3 1 '[ _ [ _ + ] map ] call
] unit-test ] unit-test
[ { 1 { 2 { 3 } } } ] [ [ { 1 { 2 { 3 } } } ] [
1 2 3 '[ , [ , [ , 1array ] call 2array ] call 2array ] call 1 2 3 '[ _ [ _ [ _ 1array ] call 2array ] call 2array ] call
] unit-test ] unit-test
{ 1 1 } [ '[ [ [ , ] ] ] ] must-infer-as { 1 1 } [ '[ [ [ _ ] ] ] ] must-infer-as
[ { { { 3 } } } ] [ [ { { { 3 } } } ] [
3 '[ [ [ , 1array ] call 1array ] call 1array ] call 3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
] unit-test ] unit-test
[ { { { 3 } } } ] [ [ { { { 3 } } } ] [
3 '[ [ [ , 1array ] call 1array ] call 1array ] call 3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
] unit-test ] unit-test

47
basis/fry/fry.factor
View File

@ -1,13 +1,13 @@
! Copyright (C) 2008 Slava Pestov, Eduardo Cavazos. ! Copyright (C) 2008 Slava Pestov, Eduardo Cavazos.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences combinators parser splitting math USING: kernel sequences combinators parser splitting math
quotations arrays namespaces qualified ; quotations arrays make qualified words ;
QUALIFIED: namespaces
IN: fry IN: fry
: , ( -- * ) "Only valid inside a fry" throw ;
: @ ( -- * ) "Only valid inside a fry" throw ;
: _ ( -- * ) "Only valid inside a fry" throw ; : _ ( -- * ) "Only valid inside a fry" throw ;
: @ ( -- * ) "Only valid inside a fry" throw ;
<PRIVATE
DEFER: (shallow-fry) DEFER: (shallow-fry)
DEFER: shallow-fry DEFER: shallow-fry
@ -19,48 +19,33 @@ DEFER: shallow-fry
] unless-empty ; inline ] unless-empty ; inline
: (shallow-fry) ( accum quot -- result ) : (shallow-fry) ( accum quot -- result )
[ [ 1quotation ] [
1quotation
] [
unclip { unclip {
{ \ , [ [ curry ] ((shallow-fry)) ] } { \ _ [ [ curry ] ((shallow-fry)) ] }
{ \ @ [ [ compose ] ((shallow-fry)) ] } { \ @ [ [ compose ] ((shallow-fry)) ] }
! to avoid confusion, remove if fry goes core
{ \ namespaces:, [ [ curry ] ((shallow-fry)) ] }
[ swap >r suffix r> (shallow-fry) ] [ swap >r suffix r> (shallow-fry) ]
} case } case
] if-empty ; ] if-empty ;
: shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ; : shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ;
: deep-fry ( quot -- quot ) PREDICATE: fry-specifier < word { _ @ } memq? ;
{ _ } last-split1 dup [
shallow-fry [ >r ] rot
deep-fry [ [ dip ] curry r> compose ] 4array concat
] [
drop shallow-fry
] if ;
: fry-specifier? ( obj -- ? ) { , namespaces:, @ } member? ; GENERIC: count-inputs ( quot -- n )
: count-inputs ( quot -- n ) M: callable count-inputs [ count-inputs ] sigma ;
[ M: fry-specifier count-inputs drop 1 ;
{ M: object count-inputs drop 0 ;
{ [ dup callable? ] [ count-inputs ] }
{ [ dup fry-specifier? ] [ drop 1 ] } PRIVATE>
[ drop 0 ]
} cond
] map sum ;
: fry ( quot -- quot' ) : fry ( quot -- quot' )
[ [
[ [
dup callable? [ dup callable? [
[ count-inputs \ , <repetition> % ] [ fry % ] bi [ count-inputs \ _ <repetition> % ] [ fry % ] bi
] [ namespaces:, ] if ] [ , ] if
] each ] each
] [ ] make deep-fry ; ] [ ] make shallow-fry ;
: '[ \ ] parse-until fry over push-all ; parsing : '[ \ ] parse-until fry over push-all ; parsing

6
basis/furnace/actions/actions.factor
View File

@ -60,7 +60,7 @@ TUPLE: action rest authorize init display validate submit ;
: handle-get ( action -- response ) : handle-get ( action -- response )
'[ '[
, dup display>> [ _ dup display>> [
{ {
[ init>> call ] [ init>> call ]
[ authorize>> call ] [ authorize>> call ]
@ -90,7 +90,7 @@ TUPLE: action rest authorize init display validate submit ;
: handle-post ( action -- response ) : handle-post ( action -- response )
'[ '[
, dup submit>> [ _ dup submit>> [
[ validate>> call ] [ validate>> call ]
[ authorize>> call ] [ authorize>> call ]
[ submit>> call ] [ submit>> call ]
@ -133,4 +133,4 @@ TUPLE: page-action < action template ;
: <page-action> ( -- page ) : <page-action> ( -- page )
page-action new-action page-action new-action
dup '[ , template>> <chloe-content> ] >>display ; dup '[ _ template>> <chloe-content> ] >>display ;

4
basis/furnace/alloy/alloy.factor
View File

@ -14,7 +14,7 @@ IN: furnace.alloy
'[ '[
<conversations> <conversations>
<sessions> <sessions>
, , <db-persistence> _ _ <db-persistence>
<check-form-submissions> <check-form-submissions>
] call ; ] call ;
@ -26,5 +26,5 @@ IN: furnace.alloy
: start-expiring ( db params -- ) : start-expiring ( db params -- )
'[ '[
, , [ state-classes [ expire-state ] each ] with-db _ _ [ state-classes [ expire-state ] each ] with-db
] 5 minutes every drop ; ] 5 minutes every drop ;

2
basis/furnace/auth/auth.factor
View File

@ -125,7 +125,7 @@ TUPLE: secure-realm-only < filter-responder ;
C: <secure-realm-only> secure-realm-only C: <secure-realm-only> secure-realm-only
M: secure-realm-only call-responder* M: secure-realm-only call-responder*
'[ , , call-next-method ] if-secure-realm ; '[ _ _ call-next-method ] if-secure-realm ;
TUPLE: protected < filter-responder description capabilities ; TUPLE: protected < filter-responder description capabilities ;

2
basis/furnace/auth/basic/basic.factor
View File

@ -1,6 +1,6 @@
! Copyright (c) 2007 Chris Double. ! Copyright (c) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel splitting base64 namespaces strings USING: accessors kernel splitting base64 namespaces make strings
http http.server.responses furnace.auth ; http http.server.responses furnace.auth ;
IN: furnace.auth.basic IN: furnace.auth.basic

6
basis/furnace/auth/features/recover-password/recover-password.factor
View File

@ -1,7 +1,7 @@
! Copyright (c) 2008 Slava Pestov. ! Copyright (c) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: namespaces accessors kernel assocs arrays io.sockets threads USING: namespaces make accessors kernel assocs arrays io.sockets
fry urls smtp validators html.forms present threads fry urls smtp validators html.forms present
http http.server.responses http.server.redirection http http.server.responses http.server.redirection
http.server.dispatchers http.server.dispatchers
furnace furnace.actions furnace.auth furnace.auth.providers furnace furnace.actions furnace.auth furnace.auth.providers
@ -43,7 +43,7 @@ SYMBOL: lost-password-from
] "" make >>body ; ] "" make >>body ;
: send-password-email ( user -- ) : send-password-email ( user -- )
'[ , password-email send-email ] '[ _ password-email send-email ]
"E-mail send thread" spawn drop ; "E-mail send thread" spawn drop ;
: <recover-action-1> ( -- action ) : <recover-action-1> ( -- action )

4
basis/furnace/chloe-tags/chloe-tags.factor
View File

@ -56,7 +56,7 @@ CHLOE: write-atom drop [ write-atom-feeds ] [code] ;
: compile-link-attrs ( tag -- ) : compile-link-attrs ( tag -- )
#! Side-effects current namespace. #! Side-effects current namespace.
attrs>> '[ [ , _ link-attr ] each-responder ] [code] ; attrs>> '[ [ [ _ ] dip link-attr ] each-responder ] [code] ;
: a-start-tag ( tag -- ) : a-start-tag ( tag -- )
[ compile-link-attrs ] [ compile-a-url ] bi [ compile-link-attrs ] [ compile-a-url ] bi
@ -72,7 +72,7 @@ CHLOE: a
: compile-hidden-form-fields ( for -- ) : compile-hidden-form-fields ( for -- )
'[ '[
, [ "," split [ hidden render ] each ] when* _ [ "," split [ hidden render ] each ] when*
nested-forms get " " join f like nested-forms-key hidden-form-field nested-forms get " " join f like nested-forms-key hidden-form-field
[ modify-form ] each-responder [ modify-form ] each-responder
] [code] ; ] [code] ;

4
basis/furnace/conversations/conversations.factor
View File

@ -109,8 +109,8 @@ M: conversations call-responder*
: restore-conversation ( seq -- ) : restore-conversation ( seq -- )
conversation get dup [ conversation get dup [
namespace>> namespace>>
[ '[ , key? ] filter ] [ '[ _ key? ] filter ]
[ '[ [ , at ] keep set ] each ] [ '[ [ _ at ] keep set ] each ]
bi bi
] [ 2drop ] if ; ] [ 2drop ] if ;

2
basis/furnace/furnace.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: namespaces assocs sequences kernel classes splitting USING: namespaces make assocs sequences kernel classes splitting
vocabs.loader accessors strings combinators arrays vocabs.loader accessors strings combinators arrays
continuations present fry continuations present fry
urls html.elements urls html.elements

2
basis/furnace/redirection/redirection.factor
View File

@ -42,4 +42,4 @@ C: <secure-only> secure-only
} cond ; inline } cond ; inline
M: secure-only call-responder* M: secure-only call-responder*
'[ , , call-next-method ] if-secure ; '[ _ _ call-next-method ] if-secure ;

11
basis/furnace/sessions/sessions-tests.factor
View File

@ -1,10 +1,9 @@
IN: furnace.sessions.tests IN: furnace.sessions.tests
USING: tools.test http furnace.sessions USING: tools.test http furnace.sessions furnace.actions
furnace.actions http.server http.server.responses http.server http.server.responses math namespaces make kernel
math namespaces kernel accessors io.sockets io.servers.connection accessors io.sockets io.servers.connection prettyprint
prettyprint io.streams.string io.files splitting destructors io.streams.string io.files splitting destructors sequences db
sequences db db.tuples db.sqlite continuations urls math.parser db.tuples db.sqlite continuations urls math.parser furnace ;
furnace ;
: with-session : with-session
[ [

2
basis/furnace/syndication/syndication.factor
View File

@ -44,7 +44,7 @@ TUPLE: feed-action < action title url entries ;
feed-action new-action feed-action new-action
dup '[ dup '[
feed new feed new
, _
[ title>> call >>title ] [ title>> call >>title ]
[ url>> call adjust-url relative-to-request >>url ] [ url>> call adjust-url relative-to-request >>url ]
[ entries>> call process-entries >>entries ] [ entries>> call process-entries >>entries ]

20
basis/generalizations/generalizations.factor
View File

@ -6,24 +6,24 @@ math.ranges combinators macros quotations fry arrays ;
IN: generalizations IN: generalizations
MACRO: nsequence ( n seq -- quot ) MACRO: nsequence ( n seq -- quot )
[ drop <reversed> ] [ '[ , , new-sequence ] ] 2bi [ drop <reversed> ] [ '[ _ _ new-sequence ] ] 2bi
[ '[ @ [ , swap set-nth-unsafe ] keep ] ] reduce ; [ '[ @ [ _ swap set-nth-unsafe ] keep ] ] reduce ;
MACRO: narray ( n -- quot ) MACRO: narray ( n -- quot )
'[ , { } nsequence ] ; '[ _ { } nsequence ] ;
MACRO: firstn ( n -- ) MACRO: firstn ( n -- )
dup zero? [ drop [ drop ] ] [ dup zero? [ drop [ drop ] ] [
[ [ '[ , _ nth-unsafe ] ] map ] [ [ '[ [ _ ] dip nth-unsafe ] ] map ]
[ 1- '[ , _ bounds-check 2drop ] ] [ 1- '[ [ _ ] dip bounds-check 2drop ] ]
bi prefix '[ , cleave ] bi prefix '[ _ cleave ]
] if ; ] if ;
MACRO: npick ( n -- ) MACRO: npick ( n -- )
1- dup saver [ dup ] rot [ r> swap ] n*quot 3append ; 1- dup saver [ dup ] rot [ r> swap ] n*quot 3append ;
MACRO: ndup ( n -- ) MACRO: ndup ( n -- )
dup '[ , npick ] n*quot ; dup '[ _ npick ] n*quot ;
MACRO: nrot ( n -- ) MACRO: nrot ( n -- )
1- dup saver swap [ r> swap ] n*quot append ; 1- dup saver swap [ r> swap ] n*quot append ;
@ -41,7 +41,7 @@ MACRO: ntuck ( n -- )
2 + [ dupd -nrot ] curry ; 2 + [ dupd -nrot ] curry ;
MACRO: nrev ( n -- quot ) MACRO: nrev ( n -- quot )
1 [a,b] [ ] [ '[ @ , -nrot ] ] reduce ; 1 [a,b] [ ] [ '[ @ _ -nrot ] ] reduce ;
MACRO: ndip ( quot n -- ) MACRO: ndip ( quot n -- )
dup saver -rot restorer 3append ; dup saver -rot restorer 3append ;
@ -51,7 +51,7 @@ MACRO: nslip ( n -- )
MACRO: nkeep ( n -- ) MACRO: nkeep ( n -- )
[ ] [ 1+ ] [ ] tri [ ] [ 1+ ] [ ] tri
'[ [ , ndup ] dip , -nrot , nslip ] ; '[ [ _ ndup ] dip _ -nrot _ nslip ] ;
MACRO: ncurry ( n -- ) MACRO: ncurry ( n -- )
[ curry ] n*quot ; [ curry ] n*quot ;
@ -61,5 +61,5 @@ MACRO: nwith ( n -- )
MACRO: napply ( n -- ) MACRO: napply ( n -- )
2 [a,b] 2 [a,b]
[ [ 1- ] keep '[ , ntuck , nslip ] ] [ [ 1- ] keep '[ _ ntuck _ nslip ] ]
map concat >quotation [ call ] append ; map concat >quotation [ call ] append ;

1
basis/help/handbook/handbook.factor
View File

@ -108,6 +108,7 @@ USE: io.buffers
ARTICLE: "collections" "Collections" ARTICLE: "collections" "Collections"
{ $heading "Sequences" } { $heading "Sequences" }
{ $subsection "sequences" } { $subsection "sequences" }
{ $subsection "namespaces-make" }
"Fixed-length sequences:" "Fixed-length sequences:"
{ $subsection "arrays" } { $subsection "arrays" }
{ $subsection "quotations" } { $subsection "quotations" }

4
basis/help/help.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2008 Slava Pestov. ! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays io io.styles kernel namespaces parser USING: accessors arrays io io.styles kernel namespaces make
prettyprint sequences words assocs definitions generic parser prettyprint sequences words assocs definitions generic
quotations effects slots continuations classes.tuple debugger quotations effects slots continuations classes.tuple debugger
combinators vocabs help.stylesheet help.topics help.crossref combinators vocabs help.stylesheet help.topics help.crossref
help.markup sorting classes vocabs.loader ; help.markup sorting classes vocabs.loader ;

8
basis/help/lint/lint.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2006, 2008 Slava Pestov. ! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: fry accessors sequences parser kernel help help.markup USING: fry accessors sequences parser kernel help help.markup
help.topics words strings classes tools.vocabs namespaces io help.topics words strings classes tools.vocabs namespaces make
io.streams.string prettyprint definitions arrays vectors io io.streams.string prettyprint definitions arrays vectors
combinators combinators.short-circuit splitting debugger combinators combinators.short-circuit splitting debugger
hashtables sorting effects vocabs vocabs.loader assocs editors hashtables sorting effects vocabs vocabs.loader assocs editors
continuations classes.predicate macros math sets eval ; continuations classes.predicate macros math sets eval ;
@ -39,7 +39,7 @@ IN: help.lint
$predicate $predicate
$class-description $class-description
$error-description $error-description
} swap '[ , elements empty? not ] contains? ; } swap '[ _ elements empty? not ] contains? ;
: check-values ( word element -- ) : check-values ( word element -- )
{ {
@ -110,7 +110,7 @@ M: help-error error.
H{ } clone [ H{ } clone [
'[ '[
dup >link where dup dup >link where dup
[ first , at , push-at ] [ 2drop ] if [ first _ at _ push-at ] [ 2drop ] if
] each ] each
] keep ; ] keep ;

2
basis/help/markup/markup.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2008 Slava Pestov. ! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays definitions generic io kernel assocs USING: accessors arrays definitions generic io kernel assocs
hashtables namespaces parser prettyprint sequences strings hashtables namespaces make parser prettyprint sequences strings
io.styles vectors words math sorting splitting classes slots io.styles vectors words math sorting splitting classes slots
vocabs help.stylesheet help.topics vocabs.loader alias ; vocabs help.stylesheet help.topics vocabs.loader alias ;
IN: help.markup IN: help.markup

2
basis/help/topics/topics.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2007 Slava Pestov. ! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.x ! See http://factorcode.org/license.txt for BSD license.x
USING: accessors arrays definitions generic assocs USING: accessors arrays definitions generic assocs
io kernel namespaces prettyprint prettyprint.sections io kernel namespaces make prettyprint prettyprint.sections
sequences words summary classes strings vocabs ; sequences words summary classes strings vocabs ;
IN: help.topics IN: help.topics

4
basis/hints/hints.factor
View File

@ -21,7 +21,7 @@ IN: hints
: specializer-cases ( quot word -- default alist ) : specializer-cases ( quot word -- default alist )
dup [ array? ] all? [ 1array ] unless [ dup [ array? ] all? [ 1array ] unless [
[ make-specializer ] keep [ make-specializer ] keep
'[ , declare ] pick append '[ _ declare ] pick append
] { } map>assoc ; ] { } map>assoc ;
: method-declaration ( method -- quot ) : method-declaration ( method -- quot )
@ -30,7 +30,7 @@ IN: hints
bi prefix ; bi prefix ;
: specialize-method ( quot method -- quot' ) : specialize-method ( quot method -- quot' )
method-declaration '[ , declare ] prepend ; method-declaration '[ _ declare ] prepend ;
: specialize-quot ( quot specializer -- quot' ) : specialize-quot ( quot specializer -- quot' )
specializer-cases alist>quot ; specializer-cases alist>quot ;

2
basis/html/components/components.factor
View File

@ -88,7 +88,7 @@ TUPLE: choice size multiple choices ;
</option> ; </option> ;
: render-options ( options selected -- ) : render-options ( options selected -- )
'[ dup , member? render-option ] each ; '[ dup _ member? render-option ] each ;
M: choice render* M: choice render*
<select <select

10
basis/html/elements/elements.factor
View File

@ -70,7 +70,7 @@ SYMBOL: html
: def-for-html-word-<foo> ( name -- ) : def-for-html-word-<foo> ( name -- )
#! Return the name and code for the <foo> patterned #! Return the name and code for the <foo> patterned
#! word. #! word.
dup <foo> swap '[ , <foo> write-html ] dup <foo> swap '[ _ <foo> write-html ]
(( -- )) html-word ; (( -- )) html-word ;
: <foo ( str -- <str ) "<" prepend ; : <foo ( str -- <str ) "<" prepend ;
@ -78,7 +78,7 @@ SYMBOL: html
: def-for-html-word-<foo ( name -- ) : def-for-html-word-<foo ( name -- )
#! Return the name and code for the <foo patterned #! Return the name and code for the <foo patterned
#! word. #! word.
<foo dup '[ , write-html ] <foo dup '[ _ write-html ]
(( -- )) html-word ; (( -- )) html-word ;
: foo> ( str -- foo> ) ">" append ; : foo> ( str -- foo> ) ">" append ;
@ -93,14 +93,14 @@ SYMBOL: html
: def-for-html-word-</foo> ( name -- ) : def-for-html-word-</foo> ( name -- )
#! Return the name and code for the </foo> patterned #! Return the name and code for the </foo> patterned
#! word. #! word.
</foo> dup '[ , write-html ] (( -- )) html-word ; </foo> dup '[ _ write-html ] (( -- )) html-word ;
: <foo/> ( str -- <str/> ) "<" swap "/>" 3append ; : <foo/> ( str -- <str/> ) "<" swap "/>" 3append ;
: def-for-html-word-<foo/> ( name -- ) : def-for-html-word-<foo/> ( name -- )
#! Return the name and code for the <foo/> patterned #! Return the name and code for the <foo/> patterned
#! word. #! word.
dup <foo/> swap '[ , <foo/> write-html ] dup <foo/> swap '[ _ <foo/> write-html ]
(( -- )) html-word ; (( -- )) html-word ;
: foo/> ( str -- str/> ) "/>" append ; : foo/> ( str -- str/> ) "/>" append ;
@ -134,7 +134,7 @@ SYMBOL: html
: define-attribute-word ( name -- ) : define-attribute-word ( name -- )
dup "=" prepend swap dup "=" prepend swap
'[ , write-attr ] (( string -- )) html-word ; '[ _ write-attr ] (( string -- )) html-word ;
! Define some closed HTML tags ! Define some closed HTML tags
[ [

4
basis/html/forms/forms.factor
View File

@ -63,7 +63,7 @@ SYMBOL: nested-forms
: with-form ( name quot -- ) : with-form ( name quot -- )
'[ '[
, _
[ nested-forms [ swap prefix ] change ] [ nested-forms [ swap prefix ] change ]
[ value form set ] [ value form set ]
bi bi
@ -103,4 +103,4 @@ C: <validation-error> validation-error
swap set-value ; swap set-value ;
: validate-values ( assoc validators -- assoc' ) : validate-values ( assoc validators -- assoc' )
swap '[ dup , at _ validate-value ] assoc-each ; swap '[ [ dup _ at ] dip validate-value ] assoc-each ;

11
basis/html/streams/streams.factor
View File

@ -1,11 +1,10 @@
! Copyright (C) 2004, 2008 Slava Pestov. ! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: combinators generic assocs help http io io.styles
USING: combinators generic assocs help http io io.styles io.files io.files continuations io.streams.string kernel math math.order
continuations io.streams.string kernel math math.order math.parser math.parser namespaces make quotations assocs sequences strings
namespaces quotations assocs sequences strings words html.elements words html.elements xml.entities sbufs continuations destructors
xml.entities sbufs continuations destructors accessors arrays ; accessors arrays ;
IN: html.streams IN: html.streams
GENERIC: browser-link-href ( presented -- href ) GENERIC: browser-link-href ( presented -- href )

7
basis/html/templates/chloe/chloe.factor
View File

@ -1,9 +1,10 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sequences combinators kernel fry USING: accessors kernel sequences combinators kernel fry
namespaces classes.tuple assocs splitting words arrays memoize namespaces make classes.tuple assocs splitting words arrays
io io.files io.encodings.utf8 io.streams.string unicode.case memoize io io.files io.encodings.utf8 io.streams.string
mirrors math urls present multiline quotations xml xml.data unicode.case mirrors math urls present multiline quotations xml
xml.data
html.forms html.forms
html.elements html.elements
html.components html.components

7
basis/html/templates/chloe/compiler/compiler.factor
View File

@ -1,8 +1,9 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: assocs namespaces kernel sequences accessors combinators USING: assocs namespaces make kernel sequences accessors
strings splitting io io.streams.string present xml.writer combinators strings splitting io io.streams.string present
xml.data xml.entities html.forms html.templates.chloe.syntax ; xml.writer xml.data xml.entities html.forms
html.templates.chloe.syntax ;
IN: html.templates.chloe.compiler IN: html.templates.chloe.compiler
: chloe-attrs-only ( assoc -- assoc' ) : chloe-attrs-only ( assoc -- assoc' )

6
basis/html/templates/chloe/components/components.factor
View File

@ -14,13 +14,13 @@ IN: html.templates.chloe.components
: CHLOE-SINGLETON: : CHLOE-SINGLETON:
scan-word scan-word
[ name>> ] [ '[ , singleton-component-tag ] ] bi [ name>> ] [ '[ _ singleton-component-tag ] ] bi
define-chloe-tag ; define-chloe-tag ;
parsing parsing
: compile-component-attrs ( tag class -- ) : compile-component-attrs ( tag class -- )
[ attrs>> [ drop main>> "name" = not ] assoc-filter ] dip [ attrs>> [ drop main>> "name" = not ] assoc-filter ] dip
[ all-slots swap '[ name>> , at compile-attr ] each ] [ all-slots swap '[ name>> _ at compile-attr ] each ]
[ [ boa ] [code-with] ] [ [ boa ] [code-with] ]
bi ; bi ;
@ -30,6 +30,6 @@ IN: html.templates.chloe.components
: CHLOE-TUPLE: : CHLOE-TUPLE:
scan-word scan-word
[ name>> ] [ '[ , tuple-component-tag ] ] bi [ name>> ] [ '[ _ tuple-component-tag ] ] bi
define-chloe-tag ; define-chloe-tag ;
parsing parsing

2
basis/html/templates/fhtml/fhtml.factor
View File

@ -74,6 +74,6 @@ TUPLE: fhtml path ;
C: <fhtml> fhtml C: <fhtml> fhtml
M: fhtml call-template* ( filename -- ) M: fhtml call-template* ( filename -- )
'[ , path>> utf8 file-contents eval-template ] assert-depth ; '[ _ path>> utf8 file-contents eval-template ] assert-depth ;
INSTANCE: fhtml template INSTANCE: fhtml template

6
basis/http/client/client.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2005, 2008 Slava Pestov. ! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs kernel math math.parser namespaces USING: accessors assocs kernel math math.parser namespaces make
sequences io io.sockets io.streams.string io.files io.timeouts sequences io io.sockets io.streams.string io.files io.timeouts
strings splitting calendar continuations accessors vectors strings splitting calendar continuations accessors vectors
math.order hashtables byte-arrays prettyprint math.order hashtables byte-arrays prettyprint
@ -95,7 +95,7 @@ DEFER: (http-request)
SYMBOL: redirects SYMBOL: redirects
: redirect-url ( request url -- request ) : redirect-url ( request url -- request )
'[ , >url derive-url ensure-port ] change-url ; '[ _ >url derive-url ensure-port ] change-url ;
: do-redirect ( response data -- response data ) : do-redirect ( response data -- response data )
over code>> 300 399 between? [ over code>> 300 399 between? [
@ -169,7 +169,7 @@ M: download-failed error.
: download-to ( url file -- ) : download-to ( url file -- )
#! Downloads the contents of a URL to a file. #! Downloads the contents of a URL to a file.
swap http-get swap http-get
[ content-charset>> ] [ '[ , write ] ] bi* [ content-charset>> ] [ '[ _ write ] ] bi*
with-file-writer ; with-file-writer ;
: download ( url -- ) : download ( url -- )

6
basis/http/http.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2003, 2008 Slava Pestov. ! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel combinators math namespaces USING: accessors kernel combinators math namespaces make
assocs sequences splitting sorting sets debugger assocs sequences splitting sorting sets debugger
strings vectors hashtables quotations arrays byte-arrays strings vectors hashtables quotations arrays byte-arrays
math.parser calendar calendar.format present math.parser calendar calendar.format present
@ -28,7 +28,7 @@ IN: http
[ read-crlf dup f like ] [ parse-header-line ] [ drop ] produce ; [ read-crlf dup f like ] [ parse-header-line ] [ drop ] produce ;
: collect-headers ( assoc -- assoc' ) : collect-headers ( assoc -- assoc' )
H{ } clone [ '[ , push-at ] assoc-each ] keep ; H{ } clone [ '[ _ push-at ] assoc-each ] keep ;
: process-header ( alist -- assoc ) : process-header ( alist -- assoc )
f swap [ [ swap or dup ] dip swap ] assoc-map nip f swap [ [ swap or dup ] dip swap ] assoc-map nip
@ -196,7 +196,7 @@ M: response clone
[ clone ] change-cookies ; [ clone ] change-cookies ;
: get-cookie ( request/response name -- cookie/f ) : get-cookie ( request/response name -- cookie/f )
[ cookies>> ] dip '[ , _ name>> = ] find nip ; [ cookies>> ] dip '[ [ _ ] dip name>> = ] find nip ;
: delete-cookie ( request/response name -- ) : delete-cookie ( request/response name -- )
over cookies>> [ get-cookie ] dip delete ; over cookies>> [ get-cookie ] dip delete ;

6
basis/http/parsers/parsers.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: combinators.short-circuit math math.order math.parser kernel USING: combinators.short-circuit math math.order math.parser
sequences sequences.deep peg peg.parsers assocs arrays kernel sequences sequences.deep peg peg.parsers assocs arrays
hashtables strings unicode.case namespaces ascii ; hashtables strings unicode.case namespaces make ascii ;
IN: http.parsers IN: http.parsers
: except ( quot -- parser ) : except ( quot -- parser )

2
basis/http/server/cgi/cgi.factor
View File

@ -50,7 +50,7 @@ IN: http.server.cgi
200 >>code 200 >>code
"CGI output follows" >>message "CGI output follows" >>message
swap '[ swap '[
, output-stream get swap <cgi-process> <process-stream> [ _ output-stream get swap <cgi-process> <process-stream> [
post-request? [ request get post-data>> raw>> write flush ] when post-request? [ request get post-data>> raw>> write flush ] when
input-stream get swap (stream-copy) input-stream get swap (stream-copy)
] with-stream ] with-stream

6
basis/http/server/server.factor
View File

@ -158,7 +158,7 @@ main-responder global [ <404> <trivial-responder> or ] change-at
: <500> ( error -- response ) : <500> ( error -- response )
500 "Internal server error" <trivial-response> 500 "Internal server error" <trivial-response>
swap development? get [ '[ , http-error. ] >>body ] [ drop ] if ; swap development? get [ '[ _ http-error. ] >>body ] [ drop ] if ;
: do-response ( response -- ) : do-response ( response -- )
[ request get swap write-full-response ] [ request get swap write-full-response ]
@ -198,7 +198,7 @@ LOG: httpd-header NOTICE
[ [
local-address get local-address get
[ secure? "https" "http" ? >>protocol ] [ secure? "https" "http" ? >>protocol ]
[ port>> '[ , or ] change-port ] [ port>> '[ _ or ] change-port ]
bi bi
] change-url drop ; ] change-url drop ;
@ -207,7 +207,7 @@ LOG: httpd-header NOTICE
: do-request ( request -- response ) : do-request ( request -- response )
'[ '[
, _
{ {
[ init-request ] [ init-request ]
[ prepare-request ] [ prepare-request ]

2
basis/http/server/static/static.factor
View File

@ -73,7 +73,7 @@ TUPLE: file-responder root hook special allow-listings ;
: list-directory ( directory -- response ) : list-directory ( directory -- response )
file-responder get allow-listings>> [ file-responder get allow-listings>> [
'[ , directory. ] "text/html" <content> '[ _ directory. ] "text/html" <content>
] [ ] [
drop <403> drop <403>
] if ; ] if ;

2
basis/interval-maps/interval-maps.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Daniel Ehrenberg. ! Copyright (C) 2008 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences arrays accessors grouping math.order USING: kernel sequences arrays accessors grouping math.order
sorting binary-search math assocs locals namespaces ; sorting binary-search math assocs locals namespaces make ;
IN: interval-maps IN: interval-maps
TUPLE: interval-map array ; TUPLE: interval-map array ;

4
basis/io/servers/connection/connection.factor
View File

@ -67,7 +67,7 @@ M: threaded-server handle-client* handler>> call ;
: handle-client ( client remote local -- ) : handle-client ( client remote local -- )
'[ '[
, , log-connection _ _ log-connection
threaded-server get threaded-server get
[ timeout>> timeouts ] [ handle-client* ] bi [ timeout>> timeouts ] [ handle-client* ] bi
] with-stream ; ] with-stream ;
@ -77,7 +77,7 @@ M: threaded-server handle-client* handler>> call ;
: accept-connection ( threaded-server -- ) : accept-connection ( threaded-server -- )
[ accept ] [ addr>> ] bi [ accept ] [ addr>> ] bi
[ '[ , , , handle-client ] ] [ '[ _ _ _ handle-client ] ]
[ drop threaded-server get name>> swap thread-name ] 2bi [ drop threaded-server get name>> swap thread-name ] 2bi
spawn drop ; spawn drop ;

2
basis/io/servers/packet/datagram.factor
View File

@ -18,4 +18,4 @@ LOG: received-datagram NOTICE
PRIVATE> PRIVATE>
: with-datagrams ( seq service quot -- ) : with-datagrams ( seq service quot -- )
'[ [ , _ spawn-datagrams ] parallel-each ] with-logging ; inline '[ [ [ _ ] dip spawn-datagrams ] parallel-each ] with-logging ; inline

2
basis/io/unix/backend/backend.factor
View File

@ -3,7 +3,7 @@
USING: alien alien.c-types generic assocs kernel kernel.private USING: alien alien.c-types generic assocs kernel kernel.private
math io.ports sequences strings structs sbufs threads unix math io.ports sequences strings structs sbufs threads unix
vectors io.buffers io.backend io.encodings math.parser vectors io.buffers io.backend io.encodings math.parser
continuations system libc qualified namespaces io.timeouts continuations system libc qualified namespaces make io.timeouts
io.encodings.utf8 destructors accessors summary combinators io.encodings.utf8 destructors accessors summary combinators
locals ; locals ;
QUALIFIED: io QUALIFIED: io

2
basis/io/unix/unix-tests.factor
View File

@ -1,7 +1,7 @@
USING: io.files io.sockets io kernel threads USING: io.files io.sockets io kernel threads
namespaces tools.test continuations strings byte-arrays namespaces tools.test continuations strings byte-arrays
sequences prettyprint system io.encodings.binary io.encodings.ascii sequences prettyprint system io.encodings.binary io.encodings.ascii
io.streams.duplex destructors ; io.streams.duplex destructors make ;
IN: io.unix.tests IN: io.unix.tests
! Unix domain stream sockets ! Unix domain stream sockets

2
basis/json/reader/reader.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2006 Chris Double. ! Copyright (C) 2006 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel parser-combinators namespaces sequences promises strings USING: kernel parser-combinators namespaces make sequences promises strings
assocs math math.parser math.vectors math.functions math.order assocs math math.parser math.vectors math.functions math.order
lists hashtables ascii accessors ; lists hashtables ascii accessors ;
IN: json.reader IN: json.reader

6
basis/json/writer/writer.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2006 Chris Double. ! Copyright (C) 2006 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel io.streams.string io strings splitting sequences math USING: kernel io.streams.string io strings splitting sequences
math.parser assocs classes words namespaces prettyprint math math.parser assocs classes words namespaces make
hashtables mirrors tr ; prettyprint hashtables mirrors tr ;
IN: json.writer IN: json.writer
#! Writes the object out to a stream in JSON format #! Writes the object out to a stream in JSON format

3
basis/lcs/lcs.factor
View File

@ -1,5 +1,6 @@
USING: sequences kernel math locals math.order math.ranges USING: sequences kernel math locals math.order math.ranges
accessors arrays namespaces combinators combinators.short-circuit ; accessors arrays namespaces make combinators
combinators.short-circuit ;
IN: lcs IN: lcs
<PRIVATE <PRIVATE

11
basis/locals/locals.factor
View File

@ -1,14 +1,13 @@
! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos. ! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces sequences sequences.private assocs math USING: kernel namespaces make sequences sequences.private assocs
vectors strings classes.tuple generalizations math vectors strings classes.tuple generalizations parser words
parser words quotations debugger macros arrays macros splitting quotations debugger macros arrays macros splitting combinators
combinators prettyprint.backend definitions prettyprint prettyprint.backend definitions prettyprint hashtables
hashtables prettyprint.sections sets sequences.private effects prettyprint.sections sets sequences.private effects
effects.parser generic generic.parser compiler.units accessors effects.parser generic generic.parser compiler.units accessors
locals.backend memoize macros.expander lexer locals.backend memoize macros.expander lexer
stack-checker.known-words ; stack-checker.known-words ;
IN: locals IN: locals
! Inspired by ! Inspired by

2
basis/logging/insomniac/insomniac.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: logging.analysis logging.server logging smtp kernel USING: logging.analysis logging.server logging smtp kernel
io.files io.streams.string namespaces alarms assocs io.files io.streams.string namespaces make alarms assocs
io.encodings.utf8 accessors calendar sequences qualified ; io.encodings.utf8 accessors calendar sequences qualified ;
QUALIFIED: io.sockets QUALIFIED: io.sockets
IN: logging.insomniac IN: logging.insomniac

8
basis/logging/logging.factor
View File

@ -76,7 +76,7 @@ PRIVATE>
: input# ( word -- n ) stack-effect in>> length ; : input# ( word -- n ) stack-effect in>> length ;
: input-logging-quot ( quot word level -- quot' ) : input-logging-quot ( quot word level -- quot' )
rot [ [ input# ] keep ] 2dip '[ , , , log-stack @ ] ; rot [ [ input# ] keep ] 2dip '[ _ _ _ log-stack @ ] ;
: add-input-logging ( word level -- ) : add-input-logging ( word level -- )
[ input-logging-quot ] (define-logging) ; [ input-logging-quot ] (define-logging) ;
@ -84,7 +84,7 @@ PRIVATE>
: output# ( word -- n ) stack-effect out>> length ; : output# ( word -- n ) stack-effect out>> length ;
: output-logging-quot ( quot word level -- quot' ) : output-logging-quot ( quot word level -- quot' )
[ [ output# ] keep ] dip '[ @ , , , log-stack ] ; [ [ output# ] keep ] dip '[ @ _ _ _ log-stack ] ;
: add-output-logging ( word level -- ) : add-output-logging ( word level -- )
[ output-logging-quot ] (define-logging) ; [ output-logging-quot ] (define-logging) ;
@ -107,7 +107,7 @@ PRIVATE>
: error-logging-quot ( quot word -- quot' ) : error-logging-quot ( quot word -- quot' )
dup stack-effect stack-balancer dup stack-effect stack-balancer
'[ , [ , log-error @ ] recover ] ; '[ _ [ _ log-error @ ] recover ] ;
: add-error-logging ( word level -- ) : add-error-logging ( word level -- )
[ [ input-logging-quot ] 2keep drop error-logging-quot ] [ [ input-logging-quot ] 2keep drop error-logging-quot ]
@ -116,7 +116,7 @@ PRIVATE>
: LOG: : LOG:
#! Syntax: name level #! Syntax: name level
CREATE-WORD dup scan-word CREATE-WORD dup scan-word
'[ 1array stack>message , , log-message ] '[ 1array stack>message _ _ log-message ]
(( message -- )) define-declared ; parsing (( message -- )) define-declared ; parsing
USE: vocabs.loader USE: vocabs.loader

5
basis/logging/parser/parser.factor
View File

@ -1,8 +1,9 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors peg peg.parsers memoize kernel sequences USING: accessors peg peg.parsers memoize kernel sequences
logging arrays words strings vectors io io.files io.encodings.utf8 logging arrays words strings vectors io io.files
namespaces combinators logging.server calendar calendar.format ; io.encodings.utf8 namespaces make combinators logging.server
calendar calendar.format ;
IN: logging.parser IN: logging.parser
TUPLE: log-entry date level word-name message ; TUPLE: log-entry date level word-name message ;

5
basis/macros/expander/expander.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences namespaces quotations accessors words USING: kernel sequences namespaces make quotations accessors
continuations vectors effects math stack-checker.transforms ; words continuations vectors effects math
stack-checker.transforms ;
IN: macros.expander IN: macros.expander
GENERIC: expand-macros ( quot -- quot' ) GENERIC: expand-macros ( quot -- quot' )

4
basis/match/match.factor
View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
! !
! Based on pattern matching code from Paul Graham's book 'On Lisp'. ! Based on pattern matching code from Paul Graham's book 'On Lisp'.
USING: parser lexer kernel words namespaces sequences classes.tuple USING: parser lexer kernel words namespaces make sequences
combinators macros assocs math effects ; classes.tuple combinators macros assocs math effects ;
IN: match IN: match
SYMBOL: _ SYMBOL: _

Some files were not shown because too many files have changed in this diff Show More