! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
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
UNION: value-type array struct-type ;
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
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
layouts system compiler.units io.files io.encodings.binary
accessors combinators effects continuations ;
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
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
TUPLE: field-spec name offset type reader writer ;
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
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
vectors words quotations assocs system layouts splitting
grouping growable classes classes.builtin classes.tuple
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.strings
-arrays assocs combinators compiler kernel
-math namespaces parser prettyprint prettyprint.sections
-quotations sequences strings words cocoa.runtime io macros
-memoize debugger io.encodings.ascii effects compiler.generator
-libc libc.private ;
+USING: accessors alien alien.c-types alien.strings arrays assocs
+combinators compiler kernel math namespaces make parser
+prettyprint prettyprint.sections quotations sequences strings
+words cocoa.runtime io macros memoize debugger
+io.encodings.ascii effects compiler.generator libc libc.private ;
IN: cocoa.messages
: make-sender ( method function -- quot )
combinators compiler hashtables kernel libc math namespaces
parser sequences words cocoa.messages cocoa.runtime
compiler.units io.encodings.ascii generalizations
-continuations ;
+continuations make ;
IN: cocoa.subclassing
: init-method ( method -- sel imp types )
! Copyright (C) 2006, 2007 Slava Pestov
! 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
continuations ;
IN: cocoa.views
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
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
combinators math.bitwise words.private cpu.architecture
math.order accessors growable ;
- ! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes combinators
cpu.architecture effects generic hashtables io kernel
-kernel.private layouts math math.parser namespaces prettyprint
-quotations sequences system threads words vectors sets deques
-continuations.private summary alien alien.c-types
+kernel.private layouts math math.parser namespaces make
+prettyprint quotations sequences system threads words vectors
+sets deques continuations.private summary alien alien.c-types
alien.structs alien.strings alien.arrays libc compiler.errors
-stack-checker.inlining
-compiler.tree compiler.tree.builder compiler.tree.combinators
-compiler.tree.propagation.info compiler.generator.fixup
-compiler.generator.registers compiler.generator.iterator ;
+stack-checker.inlining compiler.tree compiler.tree.builder
+compiler.tree.combinators compiler.tree.propagation.info
+compiler.generator.fixup compiler.generator.registers
+compiler.generator.iterator ;
IN: compiler.generator
SYMBOL: compile-queue
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs classes classes.private classes.algebra
-combinators hashtables kernel layouts math namespaces quotations
-sequences system vectors words effects alien byte-arrays
-accessors sets math.order cpu.architecture
+combinators hashtables kernel layouts math namespaces make
+quotations sequences system vectors words effects alien
+byte-arrays accessors sets math.order cpu.architecture
compiler.generator.fixup ;
IN: compiler.generator.registers
[ [ >r "A" throw r> ] [ "B" throw ] if ]
cleaned-up-tree drop
] 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
! Copyright (C) 2006, 2008 Slava Pestov.
! 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
prettyprint prettyprint.backend prettyprint.sections math words
combinators io sorting hints
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
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
byte-arrays alien.accessors
compiler.intrinsics
! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings alien.syntax kernel
-math sequences namespaces assocs init accessors continuations
-combinators core-foundation core-foundation.run-loop
-io.encodings.utf8 destructors ;
+math sequences namespaces make assocs init accessors
+continuations combinators core-foundation
+core-foundation.run-loop io.encodings.utf8 destructors ;
IN: core-foundation.fsevents
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays generic kernel kernel.private math memory
-namespaces sequences layouts system hashtables classes alien
-byte-arrays combinators words sets ;
+namespaces make sequences layouts system hashtables classes
+alien byte-arrays combinators words sets ;
IN: cpu.architecture
! Register classes
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types arrays cpu.x86.assembler
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
layouts combinators compiler.constants math.order ;
IN: cpu.x86.architecture
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
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
cpu.x86.assembler.syntax ;
IN: cpu.x86.assembler
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: slots arrays definitions generic hashtables summary io
-kernel math namespaces prettyprint prettyprint.config sequences
-assocs sequences.private strings io.styles io.files vectors
-words system splitting math.parser classes.tuple continuations
-continuations.private combinators generic.math classes.builtin
-classes compiler.units generic.standard vocabs init
-kernel.private io.encodings accessors math.order
+kernel math namespaces make prettyprint prettyprint.config
+sequences assocs sequences.private strings io.styles io.files
+vectors words system splitting math.parser classes.tuple
+continuations continuations.private combinators generic.math
+classes.builtin classes compiler.units generic.standard vocabs
+init kernel.private io.encodings accessors math.order
destructors source-files parser classes.tuple.parser
effects.parser lexer compiler.errors generic.parser
strings.parser ;
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
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
: error-in-thread. ( thread -- )
! See http://factorcode.org/license.txt for BSD license.
USING: accessors parser generic kernel classes classes.tuple
words slots assocs sequences arrays vectors definitions
-prettyprint math hashtables sets macros namespaces ;
+prettyprint math hashtables sets macros namespaces make ;
IN: delegate
: protocol-words ( protocol -- words )
! Copyright (C) 2006, 2007 Slava Pestov
! 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
math.order ;
IN: documents
HELP: @\r
{ $description "Fry specifier. Splices a quotation into the fried quotation." } ;\r
\r
-HELP: _\r
-{ $description "Fry specifier. Shifts all fry specifiers to the left down by one stack position." } ;\r
-\r
HELP: fry\r
{ $values { "quot" quotation } { "quot'" quotation } }\r
{ $description "Outputs a quotation that when called, fries " { $snippet "quot" } " by taking values from the stack and substituting them in." }\r
"{ 8 13 14 27 } [ even? ] 5 [ dup ] swap [ ? ] curry 3compose map"\r
"{ 8 13 14 27 } [ even? dup 5 ? ] map"\r
}\r
-"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:"\r
-{ $code \r
- "{ 10 20 30 } 1 '[ , _ / ] map"\r
- "{ 10 20 30 } 1 [ [ ] curry dip / ] curry map"\r
- "{ 10 20 30 } 1 [ swap / ] curry map"\r
- "{ 10 20 30 } [ 1 swap / ] map"\r
-}\r
-"For any quotation body " { $snippet "X" } ", the following two are equivalent:"\r
-{ $code\r
- "[ [ X ] dip ]"\r
- "'[ X _ ]"\r
-}\r
"Here are some built-in combinators rewritten in terms of fried quotations:"\r
{ $table\r
{ { $link literalize } { $snippet ": literalize '[ , ] ;" } }\r
{ { $link slip } { $snippet ": slip '[ @ , ] call ;" } }\r
- { { $link dip } { $snippet ": dip '[ @ _ ] call ;" } }\r
{ { $link curry } { $snippet ": curry '[ , @ ] ;" } }\r
- { { $link with } { $snippet ": with swapd '[ , _ @ ] ;" } }\r
{ { $link compose } { $snippet ": compose '[ @ @ ] ;" } }\r
{ { $link bi@ } { $snippet ": bi@ tuck '[ , @ , @ ] call ;" } }\r
} ;\r
{ $code\r
"'[ 3 , + 4 , / ]"\r
"[let | a [ ] b [ ] | [ 3 a + 4 b / ] ]"\r
-}\r
-"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:"\r
-{ $code\r
- "'[ , 2 + , * _ / ]"\r
- "[let | a [ ] b [ ] | [ [ a 2 + b * ] dip / ] ]"\r
} ;\r
\r
ARTICLE: "fry.limitations" "Fried quotation limitations"\r
"Fried quotations contain zero or more " { $emphasis "fry specifiers" } ":"\r
{ $subsection , }\r
{ $subsection @ }\r
-{ $subsection _ }\r
"When a fried quotation is being evaluated, values are consumed from the stack and spliced into the quotation from right to left."\r
{ $subsection "fry.examples" }\r
{ $subsection "fry.philosophy" }\r
[ [ + ] [ - ] '[ 1 2 @ 3 4 @ ] ] unit-test
[ 1/2 ] [
- 1 '[ , _ / ] 2 swap call
+ 1 '[ [ , ] dip / ] 2 swap call
] unit-test
[ { { 1 "a" "A" } { 1 "b" "B" } { 1 "c" "C" } } ] [
- 1 '[ , _ _ 3array ]
+ 1 '[ [ , ] 2dip 3array ]
{ "a" "b" "c" } { "A" "B" "C" } rot 2map
] unit-test
[ { { 1 "a" } { 1 "b" } { 1 "c" } } ] [
- '[ 1 _ 2array ]
+ '[ [ 1 ] dip 2array ]
{ "a" "b" "c" } swap map
] unit-test
-[ 1 2 ] [
- 1 2 '[ _ , ] call
-] unit-test
-
[ { { 1 "a" 2 } { 1 "b" 2 } { 1 "c" 2 } } ] [
- 1 2 '[ , _ , 3array ]
+ 1 2 '[ [ , ] dip , 3array ]
{ "a" "b" "c" } swap map
] unit-test
-: funny-dip '[ @ _ ] call ; inline
+: funny-dip '[ [ @ ] dip ] call ; inline
[ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test
! Copyright (C) 2008 Slava Pestov, Eduardo Cavazos.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences combinators parser splitting math
-quotations arrays namespaces qualified ;
-QUALIFIED: namespaces
+quotations arrays make qualified words ;
+QUALIFIED: make
IN: fry
: , ( -- * ) "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
] unless-empty ; inline
: (shallow-fry) ( accum quot -- result )
- [
- 1quotation
- ] [
+ [ 1quotation ] [
unclip {
{ \ , [ [ curry ] ((shallow-fry)) ] }
{ \ @ [ [ compose ] ((shallow-fry)) ] }
! to avoid confusion, remove if fry goes core
- { \ namespaces:, [ [ curry ] ((shallow-fry)) ] }
+ { \ make:, [ [ curry ] ((shallow-fry)) ] }
[ swap >r suffix r> (shallow-fry) ]
} case
: shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ;
-: deep-fry ( quot -- quot )
- { _ } last-split1 dup [
- shallow-fry [ >r ] rot
- deep-fry [ [ dip ] curry r> compose ] 4array concat
- ] [
- drop shallow-fry
- ] if ;
+PREDICATE: fry-specifier < word { , make:, @ } memq? ;
-: fry-specifier? ( obj -- ? ) { , namespaces:, @ } member? ;
+GENERIC: count-inputs ( quot -- n )
+
+M: callable count-inputs [ count-inputs ] sigma ;
+M: fry-specifier count-inputs drop 1 ;
+M: object count-inputs drop 0 ;
+
+PRIVATE>
-: count-inputs ( quot -- n )
- [
- {
- { [ dup callable? ] [ count-inputs ] }
- { [ dup fry-specifier? ] [ drop 1 ] }
- [ drop 0 ]
- } cond
- ] map sum ;
-
: fry ( quot -- quot' )
[
[
dup callable? [
[ count-inputs \ , <repetition> % ] [ fry % ] bi
- ] [ namespaces:, ] if
+ ] [ make:, ] if
] each
- ] [ ] make deep-fry ;
+ ] [ ] make shallow-fry ;
: '[ \ ] parse-until fry over push-all ; parsing
: compile-link-attrs ( tag -- )
#! Side-effects current namespace.
- attrs>> '[ [ , _ link-attr ] each-responder ] [code] ;
+ attrs>> '[ [ [ , ] dip link-attr ] each-responder ] [code] ;
: a-start-tag ( tag -- )
[ compile-link-attrs ] [ compile-a-url ] bi
\r
MACRO: firstn ( n -- )\r
dup zero? [ drop [ drop ] ] [\r
- [ [ '[ , _ nth-unsafe ] ] map ]\r
- [ 1- '[ , _ bounds-check 2drop ] ]\r
+ [ [ '[ [ , ] dip nth-unsafe ] ] map ]\r
+ [ 1- '[ [ , ] dip bounds-check 2drop ] ]\r
bi prefix '[ , cleave ]\r
] if ;\r
\r
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays io io.styles kernel namespaces parser
-prettyprint sequences words assocs definitions generic
+USING: accessors arrays io io.styles kernel namespaces make
+parser prettyprint sequences words assocs definitions generic
quotations effects slots continuations classes.tuple debugger
combinators vocabs help.stylesheet help.topics help.crossref
help.markup sorting classes vocabs.loader ;
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: fry accessors sequences parser kernel help help.markup
-help.topics words strings classes tools.vocabs namespaces io
-io.streams.string prettyprint definitions arrays vectors
+help.topics words strings classes tools.vocabs namespaces make
+io io.streams.string prettyprint definitions arrays vectors
combinators combinators.short-circuit splitting debugger
hashtables sorting effects vocabs vocabs.loader assocs editors
continuations classes.predicate macros math sets eval ;
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
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
vocabs help.stylesheet help.topics vocabs.loader alias ;
IN: help.markup
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.x
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 ;
IN: help.topics
swap set-value ;
: validate-values ( assoc validators -- assoc' )
- swap '[ dup , at _ validate-value ] assoc-each ;
+ swap '[ [ dup , at ] dip validate-value ] assoc-each ;
[ clone ] change-cookies ;
: get-cookie ( request/response name -- cookie/f )
- [ cookies>> ] dip '[ , _ name>> = ] find nip ;
+ [ cookies>> ] dip '[ [ , ] dip name>> = ] find nip ;
: delete-cookie ( request/response name -- )
over cookies>> [ get-cookie ] dip delete ;
! Copyright (C) 2008 Daniel Ehrenberg.\r
! See http://factorcode.org/license.txt for BSD license.\r
USING: kernel sequences arrays accessors grouping math.order\r
-sorting binary-search math assocs locals namespaces ;\r
+sorting binary-search math assocs locals namespaces make ;\r
IN: interval-maps\r
\r
TUPLE: interval-map array ;\r
PRIVATE>
: with-datagrams ( seq service quot -- )
- '[ [ , _ spawn-datagrams ] parallel-each ] with-logging ; inline
+ '[ [ [ , ] dip spawn-datagrams ] parallel-each ] with-logging ; inline
USING: alien alien.c-types generic assocs kernel kernel.private
math io.ports sequences strings structs sbufs threads unix
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
locals ;
QUALIFIED: io
! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces sequences sequences.private assocs math
- vectors strings classes.tuple generalizations
- parser words quotations debugger macros arrays macros splitting
- combinators prettyprint.backend definitions prettyprint
- hashtables prettyprint.sections sets sequences.private effects
- effects.parser generic generic.parser compiler.units accessors
- locals.backend memoize macros.expander lexer
- stack-checker.known-words ;
-
+USING: kernel namespaces make sequences sequences.private assocs
+math vectors strings classes.tuple generalizations parser words
+quotations debugger macros arrays macros splitting combinators
+prettyprint.backend definitions prettyprint hashtables
+prettyprint.sections sets sequences.private effects
+effects.parser generic generic.parser compiler.units accessors
+locals.backend memoize macros.expander lexer
+stack-checker.known-words ;
IN: locals
! Inspired by
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences namespaces quotations accessors words
-continuations vectors effects math stack-checker.transforms ;
+USING: kernel sequences namespaces make quotations accessors
+words continuations vectors effects math
+stack-checker.transforms ;
IN: macros.expander
GENERIC: expand-macros ( quot -- quot' )
! See http://factorcode.org/license.txt for BSD license.
!
! Based on pattern matching code from Paul Graham's book 'On Lisp'.
-USING: parser lexer kernel words namespaces sequences classes.tuple
-combinators macros assocs math effects ;
+USING: parser lexer kernel words namespaces make sequences
+classes.tuple combinators macros assocs math effects ;
IN: match
SYMBOL: _
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel kernel.private math math.private words
-sequences parser namespaces assocs quotations arrays locals
+sequences parser namespaces make assocs quotations arrays locals
generic generic.math hashtables effects compiler.units ;
IN: math.partial-dispatch
! Copyright (C) 2007 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel hashtables sequences arrays words namespaces
+USING: kernel hashtables sequences arrays words namespaces make
parser math assocs effects definitions quotations summary
accessors ;
IN: memoize
} ;
MEMO: mime-types ( -- assoc )
- [ mime-db [ unclip '[ , _ set ] each ] each ] H{ } make-assoc
+ [
+ mime-db [ unclip '[ [ , ] dip set ] each ] each
+ ] H{ } make-assoc
nonstandard-mime-types assoc-union ;
: mime-type ( filename -- mime-type )
! Copyright (C) 2007, 2008 Chris Double, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences strings namespaces math assocs shuffle
- vectors arrays math.parser accessors
- unicode.categories sequences.deep peg peg.private
- peg.search math.ranges words ;
+USING: kernel sequences strings namespaces make math assocs
+shuffle vectors arrays math.parser accessors unicode.categories
+sequences.deep peg peg.private peg.search math.ranges words ;
IN: peg.parsers
TUPLE: just-parser p1 ;
! Copyright (C) 2007, 2008 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences strings fry namespaces math assocs shuffle debugger io
- vectors arrays math.parser math.order vectors combinators
- classes sets unicode.categories compiler.units parser
- words quotations effects memoize accessors locals effects splitting
- combinators.short-circuit combinators.short-circuit.smart
- generalizations ;
+USING: kernel sequences strings fry namespaces make math assocs
+shuffle debugger io vectors arrays math.parser math.order
+vectors combinators classes sets unicode.categories
+compiler.units parser words quotations effects memoize accessors
+locals effects splitting combinators.short-circuit
+combinators.short-circuit.smart generalizations ;
IN: peg
USE: prettyprint
IN: persistent.hashtables.nodes.collision
: find-index ( key hashcode collision-node -- n leaf-node )
- leaves>> -rot '[ , , _ matching-key? ] find ; inline
+ leaves>> -rot '[ [ , , ] dip matching-key? ] find ; inline
M:: collision-node (entry-at) ( key hashcode collision-node -- leaf-node )
key hashcode collision-node find-index nip ;
! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays byte-arrays byte-vectors generic
-hashtables io assocs kernel math namespaces sequences strings
-sbufs io.styles vectors words prettyprint.config
+hashtables io assocs kernel math namespaces make sequences
+strings sbufs io.styles vectors words prettyprint.config
prettyprint.sections quotations io io.files math.parser effects
classes.tuple math.order classes.tuple.private classes
combinators colors ;
! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-
-USING: arrays generic generic.standard assocs io kernel
-math namespaces sequences strings io.styles io.streams.string
+USING: arrays generic generic.standard assocs io kernel math
+namespaces make sequences strings io.styles io.streams.string
vectors words prettyprint.backend prettyprint.sections
prettyprint.config sorting splitting grouping math.parser vocabs
definitions effects classes.builtin classes.tuple io.files
classes continuations hashtables classes.mixin classes.union
classes.intersection classes.predicate classes.singleton
combinators quotations sets accessors colors ;
-
IN: prettyprint
: make-pprint ( obj quot -- block in use )
! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays generic hashtables io kernel math assocs
-namespaces sequences strings io.styles vectors words
+namespaces make sequences strings io.styles vectors words
prettyprint.config splitting classes continuations
io.streams.nested accessors sets ;
IN: prettyprint.sections
: phi-inputs ( max-d-in pairs -- newseq )
dup empty? [ nip ] [
- swap '[ , _ first2 unify-inputs ] map
+ swap '[ [ , ] dip first2 unify-inputs ] map
pad-with-bottom
] if ;
] if-empty ;
: branch-variable ( seq symbol -- seq )
- '[ , _ at ] map ;
+ '[ [ , ] dip at ] map ;
: active-variable ( seq symbol -- seq )
[ [ terminated? over at [ drop f ] when ] map ] dip
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: fry accessors arrays kernel words sequences generic math
-namespaces quotations assocs combinators classes.tuple
+namespaces make quotations assocs combinators classes.tuple
classes.tuple.private effects summary hashtables classes generic
sets definitions generic.standard slots.private continuations
stack-checker.backend stack-checker.state stack-checker.visitor
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors classes sequences splitting kernel namespaces
-words math math.parser io.styles prettyprint assocs ;
+make words math math.parser io.styles prettyprint assocs ;
IN: summary
GENERIC: summary ( object -- string )
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces continuations.private kernel.private init
+USING: namespaces make continuations.private kernel.private init
assocs kernel vocabs words sequences memory io system arrays
continuations math definitions mirrors splitting parser classes
summary layouts vocabs.loader prettyprint.config prettyprint
-debugger io.streams.c io.files io.backend
-quotations io.launcher words.private tools.deploy.config
-bootstrap.image io.encodings.utf8 destructors accessors ;
+debugger io.streams.c io.files io.backend quotations io.launcher
+words.private tools.deploy.config bootstrap.image
+io.encodings.utf8 destructors accessors ;
IN: tools.deploy.backend
: copy-vm ( executable bundle-name extension -- vm )
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: io io.files kernel namespaces sequences
+USING: io io.files kernel namespaces make sequences
system tools.deploy.backend tools.deploy.config assocs
hashtables prettyprint io.unix.backend cocoa io.encodings.utf8
io.backend cocoa.application cocoa.classes cocoa.plists
! Copyright (C) 2008 Slava Pestov, Jorge Acereda Macia.
! See http://factorcode.org/license.txt for BSD license.
USING: io.files io words alien kernel math.parser alien.syntax
-io.launcher system assocs arrays sequences namespaces qualified
-system math compiler.generator.fixup io.encodings.ascii
-accessors generic tr ;
+io.launcher system assocs arrays sequences namespaces make
+qualified system math compiler.generator.fixup
+io.encodings.ascii accessors generic tr ;
IN: tools.disassembler
: in-file ( -- path ) "gdb-in.txt" temp-file ;
! Copyright (C) 2007, 2008 Slava Pestov.\r
! See http://factorcode.org/license.txt for BSD license.\r
USING: kernel io io.styles io.files io.encodings.utf8\r
-vocabs.loader vocabs sequences namespaces math.parser arrays\r
-hashtables assocs memoize summary sorting splitting combinators\r
-source-files debugger continuations compiler.errors init\r
-checksums checksums.crc32 sets accessors ;\r
+vocabs.loader vocabs sequences namespaces make math.parser\r
+arrays hashtables assocs memoize summary sorting splitting\r
+combinators source-files debugger continuations compiler.errors\r
+init checksums checksums.crc32 sets accessors ;\r
IN: tools.vocabs\r
\r
: vocab-tests-file ( vocab -- path )\r
sequences math namespaces.private continuations.private
concurrency.messaging quotations kernel.private words
sequences.private assocs models models.filter arrays accessors
-generic generic.standard definitions ;
+generic generic.standard definitions make ;
IN: tools.walker
SYMBOL: show-walker-hook ! ( status continuation thread -- )
USING: accessors ui.gestures help.markup help.syntax strings kernel
-hashtables quotations words classes sequences namespaces
+hashtables quotations words classes sequences namespaces make
arrays assocs ;
IN: ui.commands
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays definitions kernel sequences strings
-math assocs words generic namespaces assocs quotations splitting
-ui.gestures unicode.case unicode.categories tr ;
+math assocs words generic namespaces make assocs quotations
+splitting ui.gestures unicode.case unicode.categories tr ;
IN: ui.commands
SYMBOL: +nullary+
! Copyright (C) 2006, 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays documents io kernel math models
-namespaces opengl opengl.gl sequences strings io.styles
+namespaces make opengl opengl.gl sequences strings io.styles
math.vectors sorting colors combinators assocs math.order
ui.clipboards ui.commands ui.gadgets ui.gadgets.borders
ui.gadgets.buttons ui.gadgets.labels ui.gadgets.scrollers
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays hashtables kernel models math namespaces
- sequences quotations math.vectors combinators sorting
- binary-search vectors dlists deques models threads
- concurrency.flags math.order math.geometry.rect ;
-
+make sequences quotations math.vectors combinators sorting
+binary-search vectors dlists deques models threads
+concurrency.flags math.order math.geometry.rect ;
IN: ui.gadgets
SYMBOL: ui-notify-flag
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel math namespaces sequences words io
+USING: arrays kernel math namespaces make sequences words io
io.streams.string math.vectors ui.gadgets columns accessors
math.geometry.rect ;
IN: ui.gadgets.grids
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays hashtables io kernel math namespaces
-opengl sequences strings splitting
-ui.gadgets ui.gadgets.tracks ui.gadgets.theme ui.render colors
-models ;
+make opengl sequences strings splitting ui.gadgets
+ui.gadgets.tracks ui.gadgets.theme ui.render colors models ;
IN: ui.gadgets.labels
! A label gadget draws a string.
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs kernel math models namespaces
-sequences words strings system hashtables math.parser
-math.vectors classes.tuple classes ui.gadgets boxes
-calendar alarms symbols combinators sets columns ;
+make sequences words strings system hashtables math.parser
+math.vectors classes.tuple classes ui.gadgets boxes calendar
+alarms symbols combinators sets columns ;
IN: ui.gestures
: set-gestures ( class hash -- ) "gestures" set-word-prop ;
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays definitions kernel ui.commands
-ui.gestures sequences strings math words generic namespaces
+ui.gestures sequences strings math words generic namespaces make
hashtables help.markup quotations assocs ;
IN: ui.operations
ui.tools.listener ui.tools.traceback ui.gadgets.buttons
ui.gadgets.status-bar ui.gadgets.tracks ui.commands ui.gadgets
models models.filter ui.tools.workspace ui.gestures
-ui.gadgets.labels ui threads namespaces tools.walker assocs
+ui.gadgets.labels ui threads namespaces make tools.walker assocs
combinators ;
IN: ui.tools.walker
! Copyright (C) 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors namespaces sequences kernel math arrays io ui.gadgets
-generic combinators ;
+USING: accessors namespaces make sequences kernel math arrays io
+ui.gadgets generic combinators ;
IN: ui.traverse
TUPLE: node value children ;
ARTICLE: "ui-layouts" "Gadget hierarchy and layouts"
"A layout gadget is a gadget whose sole purpose is to contain other gadgets. Layout gadgets position and resize children according to a certain policy, taking the preferred size of the children into account. Gadget hierarchies are constructed by building up nested layouts."
{ $subsection "ui-layout-basics" }
-{ $subsection "ui-layout-combinators" }
"Common layout gadgets:"
{ $subsection "ui-pack-layout" }
{ $subsection "ui-track-layout" }
{ $subsection pref-dim* }
"To get a gadget's preferred size, do not call the above word, instead use " { $link pref-dim } ", which caches the result." ;
-ARTICLE: "ui-layout-combinators" "Creating layouts using combinators"
-"The " { $link make } " combinator provides a convenient way of constructing sequences by keeping the intermediate sequence off the stack until construction is done. The " { $link , } " and " { $link % } " words operate on this implicit sequence, reducing stack noise."
-$nl
-"Similar tools exist for constructing complex gadget hierarchies. Different words are used for different types of gadgets; see " { $link "ui-pack-layout" } ", " { $link "ui-track-layout" } " and " { $link "ui-frame-layout" } " for specifics. This section documents their common factors."
-;
-
ARTICLE: "ui-null-layout" "Manual layouts"
"When automatic layout is not appropriate, gadgets can be added to a parent with no layout policy, and then positioned and sized manually by setting the " { $snippet "loc" } " field." ;
! Copyright (C) 2006, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays assocs io kernel math models namespaces
+USING: arrays assocs io kernel math models namespaces make
prettyprint dlists deques sequences threads sequences words
debugger ui.gadgets ui.gadgets.worlds ui.gadgets.tracks
ui.gestures ui.backend ui.render continuations init combinators
-USING: unicode.data sequences sequences.next namespaces
+USING: unicode.data sequences sequences.next namespaces make
unicode.normalize math unicode.categories combinators
assocs strings splitting kernel accessors ;
IN: unicode.case
-USING: sequences namespaces unicode.data kernel math arrays
+USING: sequences namespaces make unicode.data kernel math arrays
locals sorting.insertion accessors ;
IN: unicode.normalize
-USING: unicode.data kernel math sequences parser lexer bit-arrays
-namespaces sequences.private arrays quotations assocs
-classes.predicate math.order eval ;
+USING: unicode.data kernel math sequences parser lexer
+bit-arrays namespaces make sequences.private arrays quotations
+assocs classes.predicate math.order eval ;
IN: unicode.syntax
! Character classes (categories)
swap query>> at ;
: set-query-param ( url value key -- url )
- '[ , , _ ?set-at ] change-query ;
+ '[ [ , , ] dip ?set-at ] change-query ;
: parse-host ( string -- host port )
":" split1 [ url-decode ] [
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays definitions assocs kernel kernel.private
-slots.private namespaces sequences strings words vectors math
-quotations combinators sorting effects graphs vocabs sets ;
+slots.private namespaces make sequences strings words vectors
+math quotations combinators sorting effects graphs vocabs sets ;
IN: classes
SYMBOL: class<=-cache
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: classes classes.algebra kernel namespaces words sequences
-quotations arrays kernel.private assocs combinators ;
+USING: classes classes.algebra kernel namespaces make words
+sequences quotations arrays kernel.private assocs combinators ;
IN: classes.predicate
PREDICATE: predicate-class < class
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel sets namespaces sequences parser
+USING: accessors kernel sets namespaces make sequences parser
lexer combinators words classes.parser classes.tuple arrays
slots math assocs ;
IN: classes.tuple.parser
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays definitions hashtables kernel kernel.private math
-namespaces sequences sequences.private strings vectors words
-quotations memory combinators generic classes classes.algebra
-classes.builtin classes.private slots.private slots
-compiler.units math.private accessors assocs effects ;
+namespaces make sequences sequences.private strings vectors
+words quotations memory combinators generic classes
+classes.algebra classes.builtin classes.private slots.private
+slots compiler.units math.private accessors assocs effects ;
IN: classes.tuple
PREDICATE: tuple-class < class
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces assocs io sequences
+USING: kernel namespaces make assocs io sequences
sorting continuations math math.parser ;
IN: compiler.errors
! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays vectors kernel kernel.private sequences
-namespaces math splitting sorting quotations assocs
+namespaces make math splitting sorting quotations assocs
combinators accessors ;
IN: continuations
! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors continuations kernel namespaces
+USING: accessors continuations kernel namespaces make
sequences vectors ;
IN: destructors
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.parser namespaces sequences strings
+USING: kernel math math.parser namespaces make sequences strings
words assocs combinators accessors arrays ;
IN: effects
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors words kernel sequences namespaces assocs
+USING: accessors words kernel sequences namespaces make assocs
hashtables definitions kernel.private classes classes.private
classes.algebra quotations arrays vocabs effects combinators
sets ;
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays generic hashtables kernel kernel.private
-math namespaces sequences words quotations layouts combinators
+USING: arrays generic hashtables kernel kernel.private math
+namespaces make sequences words quotations layouts combinators
sequences.private classes classes.builtin classes.algebra
definitions math.order ;
IN: generic.math
-USING: classes.private generic.standard.engines namespaces
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: classes.private generic.standard.engines namespaces make
arrays assocs sequences.private quotations kernel.private
math slots.private math.private kernel accessors words
layouts ;
! See http://factorcode.org/license.txt for BSD license.
USING: kernel classes.tuple.private hashtables assocs sorting
accessors combinators sequences slots.private math.parser words
-effects namespaces generic generic.standard.engines
+effects namespaces make generic generic.standard.engines
classes.algebra math math.private kernel.private
quotations arrays definitions ;
IN: generic.standard.engines.tuple
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs kernel kernel.private slots.private math
-namespaces sequences vectors words quotations definitions
+namespaces make sequences vectors words quotations definitions
hashtables layouts combinators sequences.private generic
classes classes.algebra classes.private generic.standard.engines
generic.standard.engines.tag generic.standard.engines.predicate
! Copyright (C) 2003, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: hashtables generic kernel math namespaces sequences
+USING: hashtables generic kernel math namespaces make sequences
continuations destructors assocs ;
IN: io
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel kernel.private namespaces io io.encodings
+USING: kernel kernel.private namespaces make io io.encodings
sequences math generic threads.private classes io.backend
io.files continuations destructors byte-arrays accessors ;
IN: io.streams.c
USING: help.markup help.syntax math math.private prettyprint
-namespaces strings ;
+namespaces make strings ;
IN: math.parser
ARTICLE: "number-strings" "Converting between numbers and strings"
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math.private namespaces sequences strings arrays
-combinators splitting math assocs ;
+USING: kernel math.private namespaces make sequences strings
+arrays combinators splitting math assocs ;
IN: math.parser
: digit> ( ch -- n )
{ $subsection get-global }
{ $subsection set-global } ;
-ARTICLE: "namespaces-make" "Constructing sequences"
-"There is a lexicon of words for constructing sequences without passing the partial sequence being built on the stack. This reduces stack noise."
-{ $subsection make }
-{ $subsection , }
-{ $subsection % }
-{ $subsection # } ;
-
ARTICLE: "namespaces.private" "Namespace implementation details"
"The namestack holds namespaces."
{ $subsection namestack }
{ $subsection "namespaces-change" }
{ $subsection "namespaces-combinators" }
{ $subsection "namespaces-global" }
-"A useful facility for constructing sequences by holding an accumulator sequence in a variable:"
-{ $subsection "namespaces-make" }
"Implementation details your code probably does not care about:"
{ $subsection "namespaces.private" }
"An alternative to dynamic scope is lexical scope. Lexically-scoped values and closures are implemented in the " { $vocab-link "locals" } " vocabulary." ;
HELP: ndrop
{ $description "Pops a namespace from the name stack." } ;
-HELP: building
-{ $var-description "Temporary mutable growable sequence holding elements accumulated so far by " { $link make } "." } ;
-
-HELP: make
-{ $values { "quot" quotation } { "exemplar" "a sequence" } { "seq" "a new sequence" } }
-{ $description "Calls the quotation in a new " { $emphasis "dynamic scope" } ". The quotation and any words it calls can execute the " { $link , } " and " { $link % } " words to accumulate elements. When the quotation returns, all accumulated elements are collected into a sequence with the same type as " { $snippet "exemplar" } "." }
-{ $examples { $example "USING: namespaces prettyprint ;" "[ 1 , 2 , 3 , ] { } make ." "{ 1 2 3 }" } } ;
-
-HELP: ,
-{ $values { "elt" object } }
-{ $description "Adds an element to the end of the sequence being constructed by " { $link make } "." } ;
-
-HELP: %
-{ $values { "seq" "a sequence" } }
-{ $description "Appends a sequence to the end of the sequence being constructed by " { $link make } "." } ;
-
HELP: init-namespaces
{ $description "Resets the name stack to its initial state, holding a single copy of the global namespace." }
$low-level-note ;
-! Copyright (C) 2003, 2007 Slava Pestov.
+! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel vectors sequences hashtables
arrays kernel.private math strings assocs ;
<PRIVATE
-: namestack* ( -- namestack )
- 0 getenv { vector } declare ; inline
-
+: namestack* ( -- namestack ) 0 getenv { vector } declare ; inline
: >n ( namespace -- ) namestack* push ;
: ndrop ( -- ) namestack* pop* ;
: off ( variable -- ) f swap set ; inline
: get-global ( variable -- value ) global at ;
: set-global ( value variable -- ) global set-at ;
-
-: change ( variable quot -- )
- >r dup get r> rot slip set ; inline
-
+: change ( variable quot -- ) >r dup get r> rot slip set ; inline
: +@ ( n variable -- ) [ 0 or + ] change ;
-
: inc ( variable -- ) 1 swap +@ ; inline
-
: dec ( variable -- ) -1 swap +@ ; inline
-
: bind ( ns quot -- ) swap >n call ndrop ; inline
-
: counter ( variable -- n ) global [ dup inc get ] bind ;
: make-assoc ( quot exemplar -- hash )
: with-variable ( value key quot -- )
>r associate >n r> call ndrop ; inline
-
-! Building sequences
-SYMBOL: building
-
-: make ( quot exemplar -- seq )
- [
- [
- 1024 swap new-resizable [
- building set call
- ] keep
- ] keep like
- ] with-scope ; inline
-
-: , ( elt -- ) building get push ;
-
-: % ( seq -- ) building get push-all ;
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays byte-arrays kernel kernel.private math namespaces
-sequences strings words effects generic generic.standard classes
-classes.algebra slots.private combinators accessors words
-sequences.private assocs alien ;
+make sequences strings words effects generic generic.standard
+classes classes.algebra slots.private combinators accessors
+words sequences.private assocs alien ;
IN: slots
TUPLE: slot-spec name offset class initial read-only ;
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math namespaces strings arrays vectors sequences
+USING: kernel math make strings arrays vectors sequences
sets math.order accessors ;
IN: splitting
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel assocs namespaces splitting sequences
+USING: kernel assocs namespaces make splitting sequences
strings math.parser lexer accessors ;
IN: strings.parser
! Copyright (C) 2007, 2008 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces sequences io.files kernel assocs words vocabs
-definitions parser continuations io hashtables sorting
+USING: namespaces make sequences io.files kernel assocs words
+vocabs definitions parser continuations io hashtables sorting
source-files arrays combinators strings system math.parser
compiler.errors splitting init accessors ;
IN: vocabs.loader
M: identity-monad return drop identity boa ;
M: identity-monad fail "Fail" throw ;
-M: identity >>= value>> '[ , _ call ] ;
+M: identity >>= value>> '[ , swap call ] ;
: run-identity ( identity -- value ) value>> ;
M: maybe-monad fail 2drop nothing ;
M: nothing >>= '[ drop , ] ;
-M: just >>= value>> '[ , _ call ] ;
+M: just >>= value>> '[ , swap call ] ;
: if-maybe ( maybe just-quot nothing-quot -- )
pick nothing? [ 2nip call ] [ drop [ value>> ] dip call ] if ; inline
M: either-monad fail drop left ;
M: left >>= '[ drop , ] ;
-M: right >>= value>> '[ , _ call ] ;
+M: right >>= value>> '[ , swap call ] ;
: if-either ( value left-quot right-quot -- )
[ [ value>> ] [ left? ] bi ] 2dip if ; inline
M: array monad-of drop array-monad ;
-M: array >>= '[ , _ map concat ] ;
+M: array >>= '[ , swap map concat ] ;
! List
SINGLETON: list-monad
M: list monad-of drop list-monad ;
-M: list >>= '[ , _ lazy-map lconcat ] ;
+M: list >>= '[ , swap lazy-map lconcat ] ;
! State
SINGLETON: state-monad
: mcall ( state -- ) quot>> call ;
-M: state >>= '[ , _ '[ , mcall first2 @ mcall ] state ] ;
+M: state >>= '[ , swap '[ , mcall first2 @ mcall ] state ] ;
: get-st ( -- state ) [ dup 2array ] state ;
: put-st ( value -- state ) '[ drop , f 2array ] state ;
M: reader-monad return drop '[ drop , ] reader ;
M: reader-monad fail "Fail" throw ;
-M: reader >>= '[ , _ '[ dup , mcall @ mcall ] reader ] ;
+M: reader >>= '[ , swap '[ dup , mcall @ mcall ] reader ] ;
: run-reader ( reader env -- ) swap mcall ;
: run-writer ( writer -- value log ) [ value>> ] [ log>> ] bi ;
-M: writer >>= '[ , run-writer _ '[ @ run-writer ] dip append writer ] ;
+M: writer >>= '[ [ , run-writer ] dip '[ @ run-writer ] dip append writer ] ;
: pass ( writer -- writer' ) run-writer [ first2 ] dip swap call writer ;
: listen ( writer -- writer' ) run-writer [ 2array ] keep writer ;
[ names>> ] [ model>> ] [ toggler>> ] tri\r
[ clear-gadget ] keep\r
[ [ length ] keep ] 2dip\r
- '[ , _ _ , add-toggle ] 2each ;\r
+ '[ [ , ] 2dip , add-toggle ] 2each ;\r
\r
: refresh-book ( tabbed -- )\r
model>> [ ] change-model ;\r
<article> select-tuple
dup [ revision>> <revision> select-tuple ] when ;
-: init-relative-link-prefix ( -- )
- URL" $wiki/view/" adjust-url present relative-link-prefix set ;
-
: <view-article-action> ( -- action )
<action>
"title" >>rest
- [
- validate-title
- init-relative-link-prefix
- ] >>init
+ [ validate-title ] >>init
[
"title" value dup latest-revision [
validate-integer-id
"id" value <revision>
select-tuple from-object
- init-relative-link-prefix
] >>init
{ wiki "view" } >>template
"noreply@concatenative.org" lost-password-from set-global
"website@concatenative.org" insomniac-sender set-global
"slava@factorcode.org" insomniac-recipients set-global
- <factor-website> main-responder set-global
init-factor-db ;
: init-testing ( -- )
"resource:basis/openssl/test/dh1024.pem" dh-file set-global
"resource:basis/openssl/test/server.pem" key-file set-global
"password" key-password set-global
- common-configuration ;
+ common-configuration
+ <factor-website> main-responder set-global ;
+
+: no-www-prefix ( -- responder )
+ "http://concatenative.org" <permanent-redirect> <trivial-responder> ;
: init-production ( -- )
- f dh-file set-global
- f key-password set-global
- "/home/slava/cert/host.pem" key-file set-global
- common-configuration ;
+ common-configuration
+ <vhost-dispatcher>
+ <factor-website> "concatenative.org" add-responder
+ no-www-prefix "www.concatenative.org" add-responder
+ main-responder set-global ;
: <factor-secure-config> ( -- config )
<secure-config>
projects / factor.git / commitdiff