From 2676807f72b134eb55a08b865cc542290c45b273 Mon Sep 17 00:00:00 2001
From: "U-SLAVA-DFB8FF805\\Slava" <Slava@slava-dfb8ff805.(none)>
Date: Wed, 3 Dec 2008 23:53:08 -0600
Subject: [PATCH 01/46] Fix typo
---
basis/io/windows/nt/files/files.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
mode change 100644 => 100755 basis/io/windows/nt/files/files.factor
diff --git a/basis/io/windows/nt/files/files.factor b/basis/io/windows/nt/files/files.factor
old mode 100644
new mode 100755
index e54f032873..892a5c4d31
--- a/basis/io/windows/nt/files/files.factor
+++ b/basis/io/windows/nt/files/files.factor
@@ -1,6 +1,6 @@
USING: continuations destructors io.buffers io.files io.backend
io.timeouts io.ports io.files.private io.windows
-io.windows.files io.windows.nt.backend io.encodings.ut16n
+io.windows.files io.windows.nt.backend io.encodings.utf16n
windows windows.kernel32 kernel libc math threads system
environment alien.c-types alien.arrays alien.strings sequences
combinators combinators.short-circuit ascii splitting alien
From 7771a3e5112d2dfe701e9d616d1180bafc578a08 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 6 Dec 2008 04:57:38 -0600
Subject: [PATCH 02/46] :> word work in progress, split up llocals
---
basis/locals/definitions/definitions.factor | 57 ++
basis/locals/errors/errors.factor | 31 ++
basis/locals/fry/fry.factor | 18 +
basis/locals/locals.factor | 506 +-----------------
basis/locals/macros/macros.factor | 16 +
basis/locals/parser/parser.factor | 96 ++++
basis/locals/prettyprint/prettyprint.factor | 47 ++
basis/locals/rewrite/closures/closures.factor | 55 ++
.../rewrite/point-free/point-free.factor | 76 +++
basis/locals/rewrite/sugar/sugar.factor | 122 +++++
basis/locals/types/types.factor | 63 +++
11 files changed, 590 insertions(+), 497 deletions(-)
create mode 100644 basis/locals/definitions/definitions.factor
create mode 100644 basis/locals/errors/errors.factor
create mode 100644 basis/locals/fry/fry.factor
create mode 100644 basis/locals/macros/macros.factor
create mode 100644 basis/locals/parser/parser.factor
create mode 100644 basis/locals/prettyprint/prettyprint.factor
create mode 100644 basis/locals/rewrite/closures/closures.factor
create mode 100644 basis/locals/rewrite/point-free/point-free.factor
create mode 100644 basis/locals/rewrite/sugar/sugar.factor
create mode 100644 basis/locals/types/types.factor
diff --git a/basis/locals/definitions/definitions.factor b/basis/locals/definitions/definitions.factor
new file mode 100644
index 0000000000..99f9d0bd22
--- /dev/null
+++ b/basis/locals/definitions/definitions.factor
@@ -0,0 +1,57 @@
+! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors definitions effects generic kernel locals
+macros memoize prettyprint prettyprint.backend words ;
+IN: locals.definitions
+
+PREDICATE: lambda-word < word "lambda" word-prop >boolean ;
+
+M: lambda-word definer drop \ :: \ ; ;
+
+M: lambda-word definition
+ "lambda" word-prop body>> ;
+
+M: lambda-word reset-word
+ [ call-next-method ] [ f "lambda" set-word-prop ] bi ;
+
+INTERSECTION: lambda-macro macro lambda-word ;
+
+M: lambda-macro definer drop \ MACRO:: \ ; ;
+
+M: lambda-macro definition
+ "lambda" word-prop body>> ;
+
+M: lambda-macro reset-word
+ [ call-next-method ] [ f "lambda" set-word-prop ] bi ;
+
+INTERSECTION: lambda-method method-body lambda-word ;
+
+M: lambda-method definer drop \ M:: \ ; ;
+
+M: lambda-method definition
+ "lambda" word-prop body>> ;
+
+M: lambda-method reset-word
+ [ call-next-method ] [ f "lambda" set-word-prop ] bi ;
+
+INTERSECTION: lambda-memoized memoized lambda-word ;
+
+M: lambda-memoized definer drop \ MEMO:: \ ; ;
+
+M: lambda-memoized definition
+ "lambda" word-prop body>> ;
+
+M: lambda-memoized reset-word
+ [ call-next-method ] [ f "lambda" set-word-prop ] bi ;
+
+: method-stack-effect ( method -- effect )
+ dup "lambda" word-prop vars>>
+ swap "method-generic" word-prop stack-effect
+ dup [ out>> ] when
+ <effect> ;
+
+M: lambda-method synopsis*
+ dup dup dup definer.
+ "method-class" word-prop pprint-word
+ "method-generic" word-prop pprint-word
+ method-stack-effect effect>string comment. ;
diff --git a/basis/locals/errors/errors.factor b/basis/locals/errors/errors.factor
new file mode 100644
index 0000000000..9f9c2beecc
--- /dev/null
+++ b/basis/locals/errors/errors.factor
@@ -0,0 +1,31 @@
+! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel summary ;
+IN: locals.errors
+
+ERROR: >r/r>-in-lambda-error ;
+
+M: >r/r>-in-lambda-error summary
+ drop
+ "Explicit retain stack manipulation is not permitted in lambda bodies" ;
+
+ERROR: binding-form-in-literal-error ;
+
+M: binding-form-in-literal-error summary
+ drop "[let, [let* and [wlet not permitted inside literals" ;
+
+ERROR: local-writer-in-literal-error ;
+
+M: local-writer-in-literal-error summary
+ drop "Local writer words not permitted inside literals" ;
+
+ERROR: local-word-in-literal-error ;
+
+M: local-word-in-literal-error summary
+ drop "Local words not permitted inside literals" ;
+
+ERROR: bad-lambda-rewrite output ;
+
+M: bad-lambda-rewrite summary
+ drop "You have found a bug in locals. Please report." ;
+
diff --git a/basis/locals/fry/fry.factor b/basis/locals/fry/fry.factor
new file mode 100644
index 0000000000..9dc924334c
--- /dev/null
+++ b/basis/locals/fry/fry.factor
@@ -0,0 +1,18 @@
+! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors fry fry.private generalizations kernel
+locals.types make sequences ;
+IN: locals.fry
+
+! Support for mixing locals with fry
+
+M: binding-form count-inputs body>> count-inputs ;
+
+M: lambda count-inputs body>> count-inputs ;
+
+M: lambda deep-fry
+ clone [ shallow-fry swap ] change-body
+ [ [ vars>> length ] keep '[ _ _ mnswap @ ] , ] [ drop [ncurry] % ] 2bi ;
+
+M: binding-form deep-fry
+ clone [ fry '[ @ call ] ] change-body , ;
diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor
index b78b95bc24..494c72bc03 100644
--- a/basis/locals/locals.factor
+++ b/basis/locals/locals.factor
@@ -1,397 +1,10 @@
! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
! See http://factorcode.org/license.txt for BSD license.
-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 classes summary fry
-fry.private ;
+USING: lexer locals.parser locals.types macros memoize parser
+sequences vocabs.loader words ;
IN: locals
-ERROR: >r/r>-in-lambda-error ;
-
-M: >r/r>-in-lambda-error summary
- drop
- "Explicit retain stack manipulation is not permitted in lambda bodies" ;
-
-ERROR: binding-form-in-literal-error ;
-
-M: binding-form-in-literal-error summary
- drop "[let, [let* and [wlet not permitted inside literals" ;
-
-ERROR: local-writer-in-literal-error ;
-
-M: local-writer-in-literal-error summary
- drop "Local writer words not permitted inside literals" ;
-
-ERROR: local-word-in-literal-error ;
-
-M: local-word-in-literal-error summary
- drop "Local words not permitted inside literals" ;
-
-ERROR: bad-lambda-rewrite output ;
-
-M: bad-lambda-rewrite summary
- drop "You have found a bug in locals. Please report." ;
-
-<PRIVATE
-
-TUPLE: lambda vars body ;
-
-C: <lambda> lambda
-
-TUPLE: binding-form bindings body ;
-
-TUPLE: let < binding-form ;
-
-C: <let> let
-
-TUPLE: let* < binding-form ;
-
-C: <let*> let*
-
-TUPLE: wlet < binding-form ;
-
-C: <wlet> wlet
-
-M: lambda expand-macros clone [ expand-macros ] change-body ;
-
-M: lambda expand-macros* expand-macros literal ;
-
-M: binding-form expand-macros
- clone
- [ [ expand-macros ] assoc-map ] change-bindings
- [ expand-macros ] change-body ;
-
-M: binding-form expand-macros* expand-macros literal ;
-
-PREDICATE: local < word "local?" word-prop ;
-
-: <local> ( name -- word )
- #! Create a local variable identifier
- f <word>
- dup t "local?" set-word-prop ;
-
-PREDICATE: local-word < word "local-word?" word-prop ;
-
-: <local-word> ( name -- word )
- f <word> dup t "local-word?" set-word-prop ;
-
-PREDICATE: local-reader < word "local-reader?" word-prop ;
-
-: <local-reader> ( name -- word )
- f <word>
- dup t "local-reader?" set-word-prop ;
-
-PREDICATE: local-writer < word "local-writer?" word-prop ;
-
-: <local-writer> ( reader -- word )
- dup name>> "!" append f <word> {
- [ nip t "local-writer?" set-word-prop ]
- [ swap "local-reader" set-word-prop ]
- [ "local-writer" set-word-prop ]
- [ nip ]
- } 2cleave ;
-
-TUPLE: quote local ;
-
-C: <quote> quote
-
-: local-index ( obj args -- n )
- [ dup quote? [ local>> ] when eq? ] with find drop ;
-
-: read-local-quot ( obj args -- quot )
- local-index neg [ get-local ] curry ;
-
-GENERIC# localize 1 ( obj args -- quot )
-
-M: local localize read-local-quot ;
-
-M: quote localize [ local>> ] dip read-local-quot ;
-
-M: local-word localize read-local-quot [ call ] append ;
-
-M: local-reader localize read-local-quot [ local-value ] append ;
-
-M: local-writer localize
- [ "local-reader" word-prop ] dip
- read-local-quot [ set-local-value ] append ;
-
-M: object localize drop 1quotation ;
-
-UNION: special local quote local-word local-reader local-writer ;
-
-: load-locals-quot ( args -- quot )
- [ [ ] ] [
- dup [ local-reader? ] contains? [
- dup [ local-reader? [ 1array ] [ ] ? ] map spread>quot
- ] [ [ ] ] if swap length [ load-locals ] curry append
- ] if-empty ;
-
-: drop-locals-quot ( args -- quot )
- [ [ ] ] [ length [ drop-locals ] curry ] if-empty ;
-
-: point-free-body ( quot args -- newquot )
- [ but-last-slice ] dip '[ _ localize ] map concat ;
-
-: point-free-end ( quot args -- newquot )
- over peek special?
- [ dup drop-locals-quot [ [ peek ] dip localize ] dip append ]
- [ drop-locals-quot swap peek suffix ]
- if ;
-
-: (point-free) ( quot args -- newquot )
- [ nip load-locals-quot ]
- [ reverse point-free-body ]
- [ reverse point-free-end ]
- 2tri [ ] 3append-as ;
-
-: point-free ( quot args -- newquot )
- over empty? [ nip length '[ _ ndrop ] ] [ (point-free) ] if ;
-
-UNION: lexical local local-reader local-writer local-word ;
-
-GENERIC: free-vars* ( form -- )
-
-: free-vars ( form -- vars )
- [ free-vars* ] { } make prune ;
-
-M: local-writer free-vars* "local-reader" word-prop , ;
-
-M: lexical free-vars* , ;
-
-M: quote free-vars* , ;
-
-M: object free-vars* drop ;
-
-M: quotation free-vars* [ free-vars* ] each ;
-
-M: lambda free-vars* [ vars>> ] [ body>> ] bi free-vars swap diff % ;
-
-GENERIC: lambda-rewrite* ( obj -- )
-
-GENERIC: local-rewrite* ( obj -- )
-
-: lambda-rewrite ( form -- form' )
- expand-macros
- [ local-rewrite* ] [ ] make
- [ [ lambda-rewrite* ] each ] [ ] make ;
-
-UNION: block callable lambda ;
-
-GENERIC: block-vars ( block -- seq )
-
-GENERIC: block-body ( block -- quot )
-
-M: callable block-vars drop { } ;
-
-M: callable block-body ;
-
-M: callable local-rewrite*
- [ [ local-rewrite* ] each ] [ ] make , ;
-
-M: lambda block-vars vars>> ;
-
-M: lambda block-body body>> ;
-
-M: lambda local-rewrite*
- [ vars>> ] [ body>> ] bi
- [ [ local-rewrite* ] each ] [ ] make <lambda> , ;
-
-M: block lambda-rewrite*
- #! Turn free variables into bound variables, curry them
- #! onto the body
- dup free-vars [ <quote> ] map dup % [
- over block-vars prepend
- swap block-body [ [ lambda-rewrite* ] each ] [ ] make
- swap point-free ,
- ] keep length \ curry <repetition> % ;
-
-GENERIC: rewrite-literal? ( obj -- ? )
-
-M: special rewrite-literal? drop t ;
-
-M: array rewrite-literal? [ rewrite-literal? ] contains? ;
-
-M: quotation rewrite-literal? [ rewrite-literal? ] contains? ;
-
-M: wrapper rewrite-literal? drop t ;
-
-M: hashtable rewrite-literal? drop t ;
-
-M: vector rewrite-literal? drop t ;
-
-M: tuple rewrite-literal? drop t ;
-
-M: object rewrite-literal? drop f ;
-
-GENERIC: rewrite-element ( obj -- )
-
-: rewrite-elements ( seq -- )
- [ rewrite-element ] each ;
-
-: rewrite-sequence ( seq -- )
- [ rewrite-elements ] [ length , ] [ 0 head , ] tri \ nsequence , ;
-
-M: array rewrite-element
- dup rewrite-literal? [ rewrite-sequence ] [ , ] if ;
-
-M: vector rewrite-element rewrite-sequence ;
-
-M: hashtable rewrite-element >alist rewrite-sequence \ >hashtable , ;
-
-M: tuple rewrite-element
- [ tuple-slots rewrite-elements ] [ class literalize , ] bi \ boa , ;
-
-M: quotation rewrite-element local-rewrite* ;
-
-M: lambda rewrite-element local-rewrite* ;
-
-M: binding-form rewrite-element binding-form-in-literal-error ;
-
-M: local rewrite-element , ;
-
-M: local-reader rewrite-element , ;
-
-M: local-writer rewrite-element
- local-writer-in-literal-error ;
-
-M: local-word rewrite-element
- local-word-in-literal-error ;
-
-M: word rewrite-element literalize , ;
-
-M: wrapper rewrite-element
- dup rewrite-literal? [ wrapped>> rewrite-element ] [ , ] if ;
-
-M: object rewrite-element , ;
-
-M: array local-rewrite* rewrite-element ;
-
-M: vector local-rewrite* rewrite-element ;
-
-M: tuple local-rewrite* rewrite-element ;
-
-M: hashtable local-rewrite* rewrite-element ;
-
-M: wrapper local-rewrite* rewrite-element ;
-
-M: word local-rewrite*
- dup { >r r> load-locals get-local drop-locals } memq?
- [ >r/r>-in-lambda-error ] [ call-next-method ] if ;
-
-M: object lambda-rewrite* , ;
-
-M: object local-rewrite* , ;
-
-: make-local ( name -- word )
- "!" ?tail [
- <local-reader>
- dup <local-writer> dup name>> set
- ] [ <local> ] if
- dup dup name>> set ;
-
-: make-locals ( seq -- words assoc )
- [ [ make-local ] map ] H{ } make-assoc ;
-
-: make-local-word ( name def -- word )
- [ <local-word> [ dup name>> set ] [ ] [ ] tri ] dip
- "local-word-def" set-word-prop ;
-
-: push-locals ( assoc -- )
- use get push ;
-
-: pop-locals ( assoc -- )
- use get delete ;
-
-SYMBOL: in-lambda?
-
-: (parse-lambda) ( assoc end -- quot )
- t in-lambda? [ parse-until ] with-variable
- >quotation swap pop-locals ;
-
-: parse-lambda ( -- lambda )
- "|" parse-tokens make-locals dup push-locals
- \ ] (parse-lambda) <lambda> ;
-
-: parse-binding ( end -- pair/f )
- scan {
- { [ dup not ] [ unexpected-eof ] }
- { [ 2dup = ] [ 2drop f ] }
- [ nip scan-object 2array ]
- } cond ;
-
-: (parse-bindings) ( end -- )
- dup parse-binding dup [
- first2 [ make-local ] dip 2array ,
- (parse-bindings)
- ] [ 2drop ] if ;
-
-: parse-bindings ( end -- bindings vars )
- [
- [ (parse-bindings) ] H{ } make-assoc
- dup push-locals
- ] { } make swap ;
-
-: parse-bindings* ( end -- words assoc )
- [
- [
- namespace push-locals
-
- (parse-bindings)
- ] { } make-assoc
- ] { } make swap ;
-
-: (parse-wbindings) ( end -- )
- dup parse-binding dup [
- first2 [ make-local-word ] keep 2array ,
- (parse-wbindings)
- ] [ 2drop ] if ;
-
-: parse-wbindings ( end -- bindings vars )
- [
- [ (parse-wbindings) ] H{ } make-assoc
- dup push-locals
- ] { } make swap ;
-
-: let-rewrite ( body bindings -- )
- <reversed> [
- [ 1array ] dip spin <lambda> '[ @ @ ]
- ] assoc-each local-rewrite* \ call , ;
-
-M: let local-rewrite*
- [ body>> ] [ bindings>> ] bi let-rewrite ;
-
-M: let* local-rewrite*
- [ body>> ] [ bindings>> ] bi let-rewrite ;
-
-M: wlet local-rewrite*
- [ body>> ] [ bindings>> ] bi
- [ '[ _ ] ] assoc-map
- let-rewrite ;
-
-: parse-locals ( -- vars assoc )
- "(" expect ")" parse-effect
- word [ over "declared-effect" set-word-prop ] when*
- in>> [ dup pair? [ first ] when ] map make-locals dup push-locals ;
-
-: parse-locals-definition ( word -- word quot )
- parse-locals \ ; (parse-lambda) <lambda>
- 2dup "lambda" set-word-prop
- lambda-rewrite dup length 1 = [ first ] [ bad-lambda-rewrite ] if ;
-
-: (::) ( -- word def ) CREATE-WORD parse-locals-definition ;
-
-: (M::) ( -- word def )
- CREATE-METHOD
- [ parse-locals-definition ] with-method-definition ;
-
-: parsed-lambda ( accum form -- accum )
- in-lambda? get [ parsed ] [ lambda-rewrite over push-all ] if ;
-
-PRIVATE>
+: :> scan <local> <def> parsed ; parsing
: [| parse-lambda parsed-lambda ; parsing
@@ -415,110 +28,9 @@ PRIVATE>
: MEMO:: (::) define-memoized ; parsing
-<PRIVATE
-
-! Pretty-printing locals
-SYMBOL: |
-
-: pprint-var ( var -- )
- #! Prettyprint a read/write local as its writer, just like
- #! in the input syntax: [| x! | ... x 3 + x! ]
- dup local-reader? [
- "local-writer" word-prop
- ] when pprint-word ;
-
-: pprint-vars ( vars -- ) [ pprint-var ] each ;
-
-M: lambda pprint*
- <flow
- \ [| pprint-word
- dup vars>> pprint-vars
- \ | pprint-word
- f <inset body>> pprint-elements block>
- \ ] pprint-word
- block> ;
-
-: pprint-let ( let word -- )
- pprint-word
- [ body>> ] [ bindings>> ] bi
- \ | pprint-word
- t <inset
- <block
- [ <block [ pprint-var ] dip pprint* block> ] assoc-each
- block>
- \ | pprint-word
- <block pprint-elements block>
- block>
- \ ] pprint-word ;
-
-M: let pprint* \ [let pprint-let ;
-
-M: wlet pprint* \ [wlet pprint-let ;
-
-M: let* pprint* \ [let* pprint-let ;
-
-PREDICATE: lambda-word < word "lambda" word-prop >boolean ;
-
-M: lambda-word definer drop \ :: \ ; ;
-
-M: lambda-word definition
- "lambda" word-prop body>> ;
-
-M: lambda-word reset-word
- [ call-next-method ] [ f "lambda" set-word-prop ] bi ;
-
-INTERSECTION: lambda-macro macro lambda-word ;
-
-M: lambda-macro definer drop \ MACRO:: \ ; ;
-
-M: lambda-macro definition
- "lambda" word-prop body>> ;
-
-M: lambda-macro reset-word
- [ call-next-method ] [ f "lambda" set-word-prop ] bi ;
-
-INTERSECTION: lambda-method method-body lambda-word ;
-
-M: lambda-method definer drop \ M:: \ ; ;
-
-M: lambda-method definition
- "lambda" word-prop body>> ;
-
-M: lambda-method reset-word
- [ call-next-method ] [ f "lambda" set-word-prop ] bi ;
-
-INTERSECTION: lambda-memoized memoized lambda-word ;
-
-M: lambda-memoized definer drop \ MEMO:: \ ; ;
-
-M: lambda-memoized definition
- "lambda" word-prop body>> ;
-
-M: lambda-memoized reset-word
- [ call-next-method ] [ f "lambda" set-word-prop ] bi ;
-
-: method-stack-effect ( method -- effect )
- dup "lambda" word-prop vars>>
- swap "method-generic" word-prop stack-effect
- dup [ out>> ] when
- <effect> ;
-
-M: lambda-method synopsis*
- dup dup dup definer.
- "method-class" word-prop pprint-word
- "method-generic" word-prop pprint-word
- method-stack-effect effect>string comment. ;
-
-PRIVATE>
-
-! Locals and fry
-M: binding-form count-inputs body>> count-inputs ;
-
-M: lambda count-inputs body>> count-inputs ;
-
-M: lambda deep-fry
- clone [ shallow-fry swap ] change-body
- [ [ vars>> length ] keep '[ _ _ mnswap @ ] , ] [ drop [ncurry] % ] 2bi ;
-
-M: binding-form deep-fry
- clone [ fry '[ @ call ] ] change-body , ;
+{
+ "locals.prettyprint"
+ "locals.definitions"
+ "locals.macros"
+ "locals.fry"
+} [ require ] each
diff --git a/basis/locals/macros/macros.factor b/basis/locals/macros/macros.factor
new file mode 100644
index 0000000000..7bde67a792
--- /dev/null
+++ b/basis/locals/macros/macros.factor
@@ -0,0 +1,16 @@
+! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs kernel locals.types macros.expander ;
+IN: locals.macros
+
+M: lambda expand-macros clone [ expand-macros ] change-body ;
+
+M: lambda expand-macros* expand-macros literal ;
+
+M: binding-form expand-macros
+ clone
+ [ [ expand-macros ] assoc-map ] change-bindings
+ [ expand-macros ] change-body ;
+
+M: binding-form expand-macros* expand-macros literal ;
+
diff --git a/basis/locals/parser/parser.factor b/basis/locals/parser/parser.factor
new file mode 100644
index 0000000000..5b2e7c3eeb
--- /dev/null
+++ b/basis/locals/parser/parser.factor
@@ -0,0 +1,96 @@
+! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays combinators effects.parser
+generic.parser kernel lexer locals.errors
+locals.rewrite.closures locals.types make namespaces parser
+quotations sequences splitting words ;
+IN: locals.parser
+
+: make-local ( name -- word )
+ "!" ?tail [
+ <local-reader>
+ dup <local-writer> dup name>> set
+ ] [ <local> ] if
+ dup dup name>> set ;
+
+: make-locals ( seq -- words assoc )
+ [ [ make-local ] map ] H{ } make-assoc ;
+
+: make-local-word ( name def -- word )
+ [ <local-word> [ dup name>> set ] [ ] [ ] tri ] dip
+ "local-word-def" set-word-prop ;
+
+: push-locals ( assoc -- )
+ use get push ;
+
+: pop-locals ( assoc -- )
+ use get delete ;
+
+SYMBOL: in-lambda?
+
+: (parse-lambda) ( assoc end -- quot )
+ t in-lambda? [ parse-until ] with-variable
+ >quotation swap pop-locals ;
+
+: parse-lambda ( -- lambda )
+ "|" parse-tokens make-locals dup push-locals
+ \ ] (parse-lambda) <lambda> ;
+
+: parse-binding ( end -- pair/f )
+ scan {
+ { [ dup not ] [ unexpected-eof ] }
+ { [ 2dup = ] [ 2drop f ] }
+ [ nip scan-object 2array ]
+ } cond ;
+
+: (parse-bindings) ( end -- )
+ dup parse-binding dup [
+ first2 [ make-local ] dip 2array ,
+ (parse-bindings)
+ ] [ 2drop ] if ;
+
+: parse-bindings ( end -- bindings vars )
+ [
+ [ (parse-bindings) ] H{ } make-assoc
+ dup push-locals
+ ] { } make swap ;
+
+: parse-bindings* ( end -- words assoc )
+ [
+ [
+ namespace push-locals
+
+ (parse-bindings)
+ ] { } make-assoc
+ ] { } make swap ;
+
+: (parse-wbindings) ( end -- )
+ dup parse-binding dup [
+ first2 [ make-local-word ] keep 2array ,
+ (parse-wbindings)
+ ] [ 2drop ] if ;
+
+: parse-wbindings ( end -- bindings vars )
+ [
+ [ (parse-wbindings) ] H{ } make-assoc
+ dup push-locals
+ ] { } make swap ;
+
+: parse-locals ( -- vars assoc )
+ "(" expect ")" parse-effect
+ word [ over "declared-effect" set-word-prop ] when*
+ in>> [ dup pair? [ first ] when ] map make-locals dup push-locals ;
+
+: parse-locals-definition ( word -- word quot )
+ parse-locals \ ; (parse-lambda) <lambda>
+ 2dup "lambda" set-word-prop
+ rewrite-closures dup length 1 = [ first ] [ bad-lambda-rewrite ] if ;
+
+: (::) ( -- word def ) CREATE-WORD parse-locals-definition ;
+
+: (M::) ( -- word def )
+ CREATE-METHOD
+ [ parse-locals-definition ] with-method-definition ;
+
+: parsed-lambda ( accum form -- accum )
+ in-lambda? get [ parsed ] [ rewrite-closures over push-all ] if ;
diff --git a/basis/locals/prettyprint/prettyprint.factor b/basis/locals/prettyprint/prettyprint.factor
new file mode 100644
index 0000000000..255917a0a5
--- /dev/null
+++ b/basis/locals/prettyprint/prettyprint.factor
@@ -0,0 +1,47 @@
+! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs kernel locals locals.types
+prettyprint.backend prettyprint.sections sequences words ;
+IN: locals.prettyprint
+
+SYMBOL: |
+
+: pprint-var ( var -- )
+ #! Prettyprint a read/write local as its writer, just like
+ #! in the input syntax: [| x! | ... x 3 + x! ]
+ dup local-reader? [
+ "local-writer" word-prop
+ ] when pprint-word ;
+
+: pprint-vars ( vars -- ) [ pprint-var ] each ;
+
+M: lambda pprint*
+ <flow
+ \ [| pprint-word
+ dup vars>> pprint-vars
+ \ | pprint-word
+ f <inset body>> pprint-elements block>
+ \ ] pprint-word
+ block> ;
+
+: pprint-let ( let word -- )
+ pprint-word
+ [ body>> ] [ bindings>> ] bi
+ \ | pprint-word
+ t <inset
+ <block
+ [ <block [ pprint-var ] dip pprint* block> ] assoc-each
+ block>
+ \ | pprint-word
+ <block pprint-elements block>
+ block>
+ \ ] pprint-word ;
+
+M: let pprint* \ [let pprint-let ;
+
+M: wlet pprint* \ [wlet pprint-let ;
+
+M: let* pprint* \ [let* pprint-let ;
+
+M: def pprint*
+ <block \ :> pprint-word local>> pprint-word block> ;
diff --git a/basis/locals/rewrite/closures/closures.factor b/basis/locals/rewrite/closures/closures.factor
new file mode 100644
index 0000000000..d85155daad
--- /dev/null
+++ b/basis/locals/rewrite/closures/closures.factor
@@ -0,0 +1,55 @@
+! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel locals.rewrite.point-free
+locals.rewrite.sugar locals.types macros.expander make
+quotations sequences sets words ;
+IN: locals.rewrite.closures
+
+! Step 2: identify free variables and make them into explicit
+! parameters of lambdas which are curried on
+
+GENERIC: rewrite-closures* ( obj -- )
+
+: (rewrite-closures) ( form -- form' )
+ [ [ rewrite-closures* ] each ] [ ] make ;
+
+: rewrite-closures ( form -- form' )
+ expand-macros (rewrite-sugar) (rewrite-closures) point-free ;
+
+GENERIC: defs-vars* ( seq form -- seq' )
+
+: defs-vars ( form -- vars ) { } [ defs-vars* ] reduce prune ;
+
+M: def defs-vars* local>> unquote suffix ;
+
+M: quotation defs-vars* [ defs-vars* ] each ;
+
+M: object defs-vars* drop ;
+
+GENERIC: uses-vars* ( seq form -- seq' )
+
+: uses-vars ( form -- vars ) { } [ uses-vars* ] reduce prune ;
+
+M: local-writer uses-vars* "local-reader" word-prop suffix ;
+
+M: lexical uses-vars* suffix ;
+
+M: quote uses-vars* local>> uses-vars* ;
+
+M: object uses-vars* drop ;
+
+M: quotation uses-vars* [ uses-vars* ] each ;
+
+: free-vars ( form -- seq )
+ [ uses-vars ] [ defs-vars ] bi diff ;
+
+M: callable rewrite-closures*
+ #! Turn free variables into bound variables, curry them
+ #! onto the body
+ dup free-vars [ <quote> ] map
+ [ % ]
+ [ var-defs prepend (rewrite-closures) point-free , ]
+ [ length \ curry <repetition> % ]
+ tri ;
+
+M: object rewrite-closures* , ;
diff --git a/basis/locals/rewrite/point-free/point-free.factor b/basis/locals/rewrite/point-free/point-free.factor
new file mode 100644
index 0000000000..1741bf044f
--- /dev/null
+++ b/basis/locals/rewrite/point-free/point-free.factor
@@ -0,0 +1,76 @@
+! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays fry kernel locals.backend locals.types
+math quotations sequences words combinators make ;
+IN: locals.rewrite.point-free
+
+! Step 3: rewrite locals usage within a single quotation into
+! retain stack manipulation
+
+ERROR: bad-local args obj ;
+
+: local-index ( args obj -- n )
+ 2dup '[ unquote _ eq? ] find drop
+ dup [ 2nip ] [ drop bad-local ] if ;
+
+: read-local-quot ( args obj -- quot )
+ local-index neg [ get-local ] curry ;
+
+GENERIC: localize ( args obj -- args quot )
+
+M: local localize dupd read-local-quot ;
+
+M: quote localize dupd local>> read-local-quot ;
+
+M: local-word localize dupd read-local-quot [ call ] append ;
+
+M: local-reader localize dupd read-local-quot [ local-value ] append ;
+
+M: local-writer localize
+ dupd "local-reader" word-prop
+ read-local-quot [ set-local-value ] append ;
+
+M: def localize
+ local>> [ prefix ] [ local-reader? [ 1array >r ] [ >r ] ? ] bi ;
+
+M: object localize 1quotation ;
+
+! We special-case all the :> at the start of a quotation
+: load-locals-quot ( args -- quot )
+ [ [ ] ] [
+ dup [ local-reader? ] contains? [
+ dup [ local-reader? [ 1array ] [ ] ? ] map
+ spread>quot
+ ] [ [ ] ] if swap length [ load-locals ] curry append
+ ] if-empty ;
+
+: load-locals-index ( quot -- n )
+ [ [ dup def? [ local>> local-reader? ] [ drop t ] if ] find drop ]
+ [ length ] bi or ;
+
+: point-free-start ( quot -- args rest )
+ dup load-locals-index
+ cut [ [ local>> ] map dup <reversed> load-locals-quot % ] dip ;
+
+: point-free-body ( args quot -- args )
+ [ localize % ] each ;
+
+: drop-locals-quot ( args -- )
+ [ length , [ drop-locals ] % ] unless-empty ;
+
+: point-free-end ( args obj -- )
+ dup special?
+ [ localize % drop-locals-quot ]
+ [ [ drop-locals-quot ] [ , ] bi* ]
+ if ;
+
+: point-free ( quot -- newquot )
+ [
+ point-free-start
+ [ drop-locals-quot ] [
+ unclip-last
+ [ point-free-body ]
+ [ point-free-end ]
+ bi*
+ ] if-empty
+ ] [ ] make ;
diff --git a/basis/locals/rewrite/sugar/sugar.factor b/basis/locals/rewrite/sugar/sugar.factor
new file mode 100644
index 0000000000..05b1e2345e
--- /dev/null
+++ b/basis/locals/rewrite/sugar/sugar.factor
@@ -0,0 +1,122 @@
+! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays assocs classes classes.tuple fry
+generalizations hashtables kernel locals locals.backend
+locals.errors locals.types make quotations sequences vectors
+words ;
+IN: locals.rewrite.sugar
+
+! Step 1: rewrite [| [let [let* [wlet into :> forms, turn
+! literals with locals in them into code which constructs
+! the literal after pushing locals on the stack
+
+GENERIC: rewrite-sugar* ( obj -- )
+
+: (rewrite-sugar) ( form -- form' )
+ [ rewrite-sugar* ] [ ] make ;
+
+GENERIC: quotation-rewrite ( form -- form' )
+
+M: callable quotation-rewrite [ [ rewrite-sugar* ] each ] [ ] make ;
+
+: var-defs ( vars -- defs ) <reversed> [ <def> ] [ ] map-as ;
+
+M: lambda quotation-rewrite
+ [ body>> ] [ vars>> var-defs ] bi
+ prepend quotation-rewrite ;
+
+M: callable rewrite-sugar* quotation-rewrite , ;
+
+M: lambda rewrite-sugar* quotation-rewrite , ;
+
+GENERIC: rewrite-literal? ( obj -- ? )
+
+M: special rewrite-literal? drop t ;
+
+M: array rewrite-literal? [ rewrite-literal? ] contains? ;
+
+M: quotation rewrite-literal? [ rewrite-literal? ] contains? ;
+
+M: wrapper rewrite-literal? drop t ;
+
+M: hashtable rewrite-literal? drop t ;
+
+M: vector rewrite-literal? drop t ;
+
+M: tuple rewrite-literal? drop t ;
+
+M: object rewrite-literal? drop f ;
+
+GENERIC: rewrite-element ( obj -- )
+
+: rewrite-elements ( seq -- )
+ [ rewrite-element ] each ;
+
+: rewrite-sequence ( seq -- )
+ [ rewrite-elements ] [ length , ] [ 0 head , ] tri \ nsequence , ;
+
+M: array rewrite-element
+ dup rewrite-literal? [ rewrite-sequence ] [ , ] if ;
+
+M: vector rewrite-element rewrite-sequence ;
+
+M: hashtable rewrite-element >alist rewrite-sequence \ >hashtable , ;
+
+M: tuple rewrite-element
+ [ tuple-slots rewrite-elements ] [ class literalize , ] bi \ boa , ;
+
+M: quotation rewrite-element rewrite-sugar* ;
+
+M: lambda rewrite-element rewrite-sugar* ;
+
+M: binding-form rewrite-element binding-form-in-literal-error ;
+
+M: local rewrite-element , ;
+
+M: local-reader rewrite-element , ;
+
+M: local-writer rewrite-element
+ local-writer-in-literal-error ;
+
+M: local-word rewrite-element
+ local-word-in-literal-error ;
+
+M: word rewrite-element literalize , ;
+
+M: wrapper rewrite-element
+ dup rewrite-literal? [ wrapped>> rewrite-element ] [ , ] if ;
+
+M: object rewrite-element , ;
+
+M: array rewrite-sugar* rewrite-element ;
+
+M: vector rewrite-sugar* rewrite-element ;
+
+M: tuple rewrite-sugar* rewrite-element ;
+
+M: def rewrite-sugar* , ;
+
+M: hashtable rewrite-sugar* rewrite-element ;
+
+M: wrapper rewrite-sugar* rewrite-element ;
+
+M: word rewrite-sugar*
+ dup { >r r> load-locals get-local drop-locals } memq?
+ [ >r/r>-in-lambda-error ] [ call-next-method ] if ;
+
+M: object rewrite-sugar* , ;
+
+: let-rewrite ( body bindings -- )
+ [ quotation-rewrite % <def> , ] assoc-each
+ quotation-rewrite % ;
+
+M: let rewrite-sugar*
+ [ body>> ] [ bindings>> ] bi let-rewrite ;
+
+M: let* rewrite-sugar*
+ [ body>> ] [ bindings>> ] bi let-rewrite ;
+
+M: wlet rewrite-sugar*
+ [ body>> ] [ bindings>> ] bi
+ [ '[ _ ] ] assoc-map
+ let-rewrite ;
diff --git a/basis/locals/types/types.factor b/basis/locals/types/types.factor
new file mode 100644
index 0000000000..7a8dac1947
--- /dev/null
+++ b/basis/locals/types/types.factor
@@ -0,0 +1,63 @@
+! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors combinators kernel sequences words ;
+IN: locals.types
+
+TUPLE: lambda vars body ;
+
+C: <lambda> lambda
+
+TUPLE: binding-form bindings body ;
+
+TUPLE: let < binding-form ;
+
+C: <let> let
+
+TUPLE: let* < binding-form ;
+
+C: <let*> let*
+
+TUPLE: wlet < binding-form ;
+
+C: <wlet> wlet
+
+TUPLE: quote local ;
+
+C: <quote> quote
+
+: unquote ( quote -- local ) dup quote? [ local>> ] when ; inline
+
+TUPLE: def local ;
+
+C: <def> def
+
+PREDICATE: local < word "local?" word-prop ;
+
+: <local> ( name -- word )
+ #! Create a local variable identifier
+ f <word>
+ dup t "local?" set-word-prop ;
+
+PREDICATE: local-word < word "local-word?" word-prop ;
+
+: <local-word> ( name -- word )
+ f <word> dup t "local-word?" set-word-prop ;
+
+PREDICATE: local-reader < word "local-reader?" word-prop ;
+
+: <local-reader> ( name -- word )
+ f <word>
+ dup t "local-reader?" set-word-prop ;
+
+PREDICATE: local-writer < word "local-writer?" word-prop ;
+
+: <local-writer> ( reader -- word )
+ dup name>> "!" append f <word> {
+ [ nip t "local-writer?" set-word-prop ]
+ [ swap "local-reader" set-word-prop ]
+ [ "local-writer" set-word-prop ]
+ [ nip ]
+ } 2cleave ;
+
+UNION: lexical local local-reader local-writer local-word ;
+UNION: special lexical quote def ;
From 22dd6a74b622488e58824c408437bcc11464c1d6 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 8 Dec 2008 12:46:44 -0600
Subject: [PATCH 03/46] add a unit test for tools.files
---
basis/tools/files/files-tests.factor | 3 +++
basis/tools/files/files.factor | 2 --
2 files changed, 3 insertions(+), 2 deletions(-)
diff --git a/basis/tools/files/files-tests.factor b/basis/tools/files/files-tests.factor
index 6aa68d8127..4dc4ef23f0 100644
--- a/basis/tools/files/files-tests.factor
+++ b/basis/tools/files/files-tests.factor
@@ -6,3 +6,6 @@ IN: tools.files.tests
\ directory. must-infer
[ ] [ "" directory. ] unit-test
+
+[ ]
+[ { device-name free-space used-space total-space percent-used } file-systems. ] unit-test
diff --git a/basis/tools/files/files.factor b/basis/tools/files/files.factor
index 18baedae0a..db49dcbf61 100755
--- a/basis/tools/files/files.factor
+++ b/basis/tools/files/files.factor
@@ -65,5 +65,3 @@ percent-used percent-free ;
{ [ os unix? ] [ "tools.files.unix" ] }
{ [ os windows? ] [ "tools.files.windows" ] }
} cond require
-
-! { device-name free-space used-space total-space percent-used } file-systems.
From f8bce9885049463dc353c8c5fcbf3dc379b8140c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 13:58:57 -0600
Subject: [PATCH 04/46] Remove unnecessary prettyprinter and debugger
dependencies from UI
---
basis/byte-vectors/byte-vectors-docs.factor | 37 ++++++++++++++
basis/byte-vectors/byte-vectors-tests.factor | 17 +++++++
basis/byte-vectors/byte-vectors.factor | 51 +++++++++++++++++++
basis/byte-vectors/summary.txt | 1 +
basis/byte-vectors/tags.txt | 1 +
.../streams/byte-array/byte-array-docs.factor | 34 +++++++++++++
.../byte-array/byte-array-tests.factor | 9 ++++
basis/io/streams/byte-array/byte-array.factor | 16 ++++++
basis/ui/freetype/freetype.factor | 2 +-
basis/ui/gadgets/labelled/labelled.factor | 2 +-
.../presentations/presentations.factor | 2 +-
basis/ui/gadgets/worlds/worlds.factor | 4 +-
basis/ui/ui.factor | 8 +--
basis/ui/x11/x11.factor | 2 +-
14 files changed, 176 insertions(+), 10 deletions(-)
create mode 100644 basis/byte-vectors/byte-vectors-docs.factor
create mode 100644 basis/byte-vectors/byte-vectors-tests.factor
create mode 100644 basis/byte-vectors/byte-vectors.factor
create mode 100644 basis/byte-vectors/summary.txt
create mode 100644 basis/byte-vectors/tags.txt
create mode 100644 basis/io/streams/byte-array/byte-array-docs.factor
create mode 100644 basis/io/streams/byte-array/byte-array-tests.factor
create mode 100644 basis/io/streams/byte-array/byte-array.factor
diff --git a/basis/byte-vectors/byte-vectors-docs.factor b/basis/byte-vectors/byte-vectors-docs.factor
new file mode 100644
index 0000000000..3873f73bfe
--- /dev/null
+++ b/basis/byte-vectors/byte-vectors-docs.factor
@@ -0,0 +1,37 @@
+USING: arrays byte-arrays help.markup help.syntax kernel
+byte-vectors.private combinators ;
+IN: byte-vectors
+
+ARTICLE: "byte-vectors" "Byte vectors"
+"A byte vector is a resizable mutable sequence of unsigned bytes. Byte vector words are found in the " { $vocab-link "byte-vectors" } " vocabulary."
+$nl
+"Byte vectors form a class:"
+{ $subsection byte-vector }
+{ $subsection byte-vector? }
+"Creating byte vectors:"
+{ $subsection >byte-vector }
+{ $subsection <byte-vector> }
+"Literal syntax:"
+{ $subsection POSTPONE: BV{ }
+"If you don't care about initial capacity, a more elegant way to create a new byte vector is to write:"
+{ $code "BV{ } clone" } ;
+
+ABOUT: "byte-vectors"
+
+HELP: byte-vector
+{ $description "The class of resizable byte vectors. See " { $link "byte-vectors" } " for information." } ;
+
+HELP: <byte-vector>
+{ $values { "n" "a positive integer specifying initial capacity" } { "byte-vector" byte-vector } }
+{ $description "Creates a new byte vector that can hold " { $snippet "n" } " bytes before resizing." } ;
+
+HELP: >byte-vector
+{ $values { "seq" "a sequence" } { "byte-vector" byte-vector } }
+{ $description "Outputs a freshly-allocated byte vector with the same elements as a given sequence." }
+{ $errors "Throws an error if the sequence contains elements other than integers." } ;
+
+HELP: BV{
+{ $syntax "BV{ elements... }" }
+{ $values { "elements" "a list of bytes" } }
+{ $description "Marks the beginning of a literal byte vector. Literal byte vectors are terminated by " { $link POSTPONE: } } "." }
+{ $examples { $code "BV{ 1 2 3 12 }" } } ;
diff --git a/basis/byte-vectors/byte-vectors-tests.factor b/basis/byte-vectors/byte-vectors-tests.factor
new file mode 100644
index 0000000000..9a100d9795
--- /dev/null
+++ b/basis/byte-vectors/byte-vectors-tests.factor
@@ -0,0 +1,17 @@
+IN: byte-vectors.tests
+USING: tools.test byte-vectors vectors sequences kernel
+prettyprint ;
+
+[ 0 ] [ 123 <byte-vector> length ] unit-test
+
+: do-it
+ 123 [ over push ] each ;
+
+[ t ] [
+ 3 <byte-vector> do-it
+ 3 <vector> do-it sequence=
+] unit-test
+
+[ t ] [ BV{ } byte-vector? ] unit-test
+
+[ "BV{ }" ] [ BV{ } unparse ] unit-test
diff --git a/basis/byte-vectors/byte-vectors.factor b/basis/byte-vectors/byte-vectors.factor
new file mode 100644
index 0000000000..b2c0d55c0f
--- /dev/null
+++ b/basis/byte-vectors/byte-vectors.factor
@@ -0,0 +1,51 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays kernel kernel.private math sequences
+sequences.private growable byte-arrays accessors parser
+prettyprint.backend ;
+IN: byte-vectors
+
+TUPLE: byte-vector
+{ underlying byte-array }
+{ length array-capacity } ;
+
+: <byte-vector> ( n -- byte-vector )
+ <byte-array> 0 byte-vector boa ; inline
+
+: >byte-vector ( seq -- byte-vector )
+ T{ byte-vector f B{ } 0 } clone-like ;
+
+M: byte-vector like
+ drop dup byte-vector? [
+ dup byte-array?
+ [ dup length byte-vector boa ] [ >byte-vector ] if
+ ] unless ;
+
+M: byte-vector new-sequence
+ drop [ <byte-array> ] [ >fixnum ] bi byte-vector boa ;
+
+M: byte-vector equal?
+ over byte-vector? [ sequence= ] [ 2drop f ] if ;
+
+M: byte-array like
+ #! If we have an byte-array, we're done.
+ #! If we have a byte-vector, and it's at full capacity,
+ #! we're done. Otherwise, call resize-byte-array, which is a
+ #! relatively fast primitive.
+ drop dup byte-array? [
+ dup byte-vector? [
+ [ length ] [ underlying>> ] bi
+ 2dup length eq?
+ [ nip ] [ resize-byte-array ] if
+ ] [ >byte-array ] if
+ ] unless ;
+
+M: byte-array new-resizable drop <byte-vector> ;
+
+: BV{ \ } [ >byte-vector ] parse-literal ; parsing
+
+M: byte-vector pprint* pprint-object ;
+M: byte-vector pprint-delims drop \ BV{ \ } ;
+M: byte-vector >pprint-sequence ;
+
+INSTANCE: byte-vector growable
diff --git a/basis/byte-vectors/summary.txt b/basis/byte-vectors/summary.txt
new file mode 100644
index 0000000000..e914ebb319
--- /dev/null
+++ b/basis/byte-vectors/summary.txt
@@ -0,0 +1 @@
+Growable byte arrays
diff --git a/basis/byte-vectors/tags.txt b/basis/byte-vectors/tags.txt
new file mode 100644
index 0000000000..42d711b32b
--- /dev/null
+++ b/basis/byte-vectors/tags.txt
@@ -0,0 +1 @@
+collections
diff --git a/basis/io/streams/byte-array/byte-array-docs.factor b/basis/io/streams/byte-array/byte-array-docs.factor
new file mode 100644
index 0000000000..7b27621343
--- /dev/null
+++ b/basis/io/streams/byte-array/byte-array-docs.factor
@@ -0,0 +1,34 @@
+USING: help.syntax help.markup io byte-arrays quotations ;
+IN: io.streams.byte-array
+
+ABOUT: "io.streams.byte-array"
+
+ARTICLE: "io.streams.byte-array" "Byte-array streams"
+"Byte array streams:"
+{ $subsection <byte-reader> }
+{ $subsection <byte-writer> }
+"Utility combinators:"
+{ $subsection with-byte-reader }
+{ $subsection with-byte-writer } ;
+
+HELP: <byte-reader>
+{ $values { "byte-array" byte-array }
+ { "encoding" "an encoding descriptor" }
+ { "stream" "a new byte reader" } }
+{ $description "Creates an input stream reading from a byte array using an encoding." } ;
+
+HELP: <byte-writer>
+{ $values { "encoding" "an encoding descriptor" }
+ { "stream" "a new byte writer" } }
+{ $description "Creates an output stream writing data to a byte array using an encoding." } ;
+
+HELP: with-byte-reader
+{ $values { "encoding" "an encoding descriptor" }
+ { "quot" quotation } { "byte-array" byte-array } }
+{ $description "Calls the quotation in a new dynamic scope with " { $link input-stream } " rebound to an input stream for reading from a byte array using an encoding." } ;
+
+HELP: with-byte-writer
+{ $values { "encoding" "an encoding descriptor" }
+ { "quot" quotation }
+ { "byte-array" byte-array } }
+{ $description "Calls the quotation in a new dynamic scope with " { $link output-stream } " rebound to an output stream writing data to a byte array using an encoding." } ;
diff --git a/basis/io/streams/byte-array/byte-array-tests.factor b/basis/io/streams/byte-array/byte-array-tests.factor
new file mode 100644
index 0000000000..77a9126740
--- /dev/null
+++ b/basis/io/streams/byte-array/byte-array-tests.factor
@@ -0,0 +1,9 @@
+USING: tools.test io.streams.byte-array io.encodings.binary
+io.encodings.utf8 io kernel arrays strings ;
+
+[ B{ 1 2 3 } ] [ binary [ { 1 2 3 } write ] with-byte-writer ] unit-test
+[ B{ 1 2 3 } ] [ { 1 2 3 } binary [ 3 read ] with-byte-reader ] unit-test
+
+[ B{ BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 BIN: 11101111 BIN: 10000000 BIN: 10111111 BIN: 11011111 BIN: 10000000 CHAR: x } ]
+[ { BIN: 101111111000000111111 BIN: 1111000000111111 BIN: 11111000000 CHAR: x } utf8 [ write ] with-byte-writer ] unit-test
+[ { BIN: 101111111000000111111 } t ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 } utf8 <byte-reader> contents dup >array swap string? ] unit-test
diff --git a/basis/io/streams/byte-array/byte-array.factor b/basis/io/streams/byte-array/byte-array.factor
new file mode 100644
index 0000000000..9d89c3d814
--- /dev/null
+++ b/basis/io/streams/byte-array/byte-array.factor
@@ -0,0 +1,16 @@
+USING: byte-arrays byte-vectors kernel io.encodings io.streams.string
+sequences io namespaces io.encodings.private accessors ;
+IN: io.streams.byte-array
+
+: <byte-writer> ( encoding -- stream )
+ 512 <byte-vector> swap <encoder> ;
+
+: with-byte-writer ( encoding quot -- byte-array )
+ [ <byte-writer> ] dip [ output-stream get ] compose with-output-stream*
+ dup encoder? [ stream>> ] when >byte-array ; inline
+
+: <byte-reader> ( byte-array encoding -- stream )
+ [ >byte-vector dup reverse-here ] dip <decoder> ;
+
+: with-byte-reader ( byte-array encoding quot -- )
+ [ <byte-reader> ] dip with-input-stream* ; inline
diff --git a/basis/ui/freetype/freetype.factor b/basis/ui/freetype/freetype.factor
index 6c0eaaa9ac..22a4f1722d 100644
--- a/basis/ui/freetype/freetype.factor
+++ b/basis/ui/freetype/freetype.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.accessors alien.c-types arrays io kernel libc
-math math.vectors namespaces opengl opengl.gl prettyprint assocs
+math math.vectors namespaces opengl opengl.gl assocs
sequences io.files io.styles continuations freetype
ui.gadgets.worlds ui.render ui.backend byte-arrays accessors
locals specialized-arrays.direct.uchar ;
diff --git a/basis/ui/gadgets/labelled/labelled.factor b/basis/ui/gadgets/labelled/labelled.factor
index 108c5ae461..636e25cea5 100644
--- a/basis/ui/gadgets/labelled/labelled.factor
+++ b/basis/ui/gadgets/labelled/labelled.factor
@@ -3,7 +3,7 @@
USING: arrays ui.gadgets.buttons ui.gadgets.borders
ui.gadgets.labels ui.gadgets.panes ui.gadgets.scrollers
ui.gadgets.tracks ui.gadgets.theme ui.gadgets.frames
-ui.gadgets.grids io kernel math models namespaces prettyprint
+ui.gadgets.grids io kernel math models namespaces
sequences sequences words classes.tuple ui.gadgets ui.render
colors accessors ;
IN: ui.gadgets.labelled
diff --git a/basis/ui/gadgets/presentations/presentations.factor b/basis/ui/gadgets/presentations/presentations.factor
index 33ef3bbe3a..61a55e926b 100644
--- a/basis/ui/gadgets/presentations/presentations.factor
+++ b/basis/ui/gadgets/presentations/presentations.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays accessors definitions hashtables io kernel
-prettyprint sequences strings io.styles words help math models
+sequences strings io.styles words help math models
namespaces quotations
ui.gadgets ui.gadgets.borders ui.gadgets.buttons
ui.gadgets.labels ui.gadgets.menus ui.gadgets.worlds
diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor
index 68a2a18210..3b9b2fa1f3 100644
--- a/basis/ui/gadgets/worlds/worlds.factor
+++ b/basis/ui/gadgets/worlds/worlds.factor
@@ -3,7 +3,7 @@
USING: accessors arrays assocs continuations kernel math models
namespaces opengl sequences io combinators fry math.vectors
ui.gadgets ui.gestures ui.render ui.backend ui.gadgets.tracks
-debugger math.geometry.rect ;
+math.geometry.rect ;
IN: ui.gadgets.worlds
TUPLE: world < track
@@ -76,7 +76,7 @@ C: <world-error> world-error
SYMBOL: ui-error-hook
: ui-error ( error -- )
- ui-error-hook get [ call ] [ print-error ] if* ;
+ ui-error-hook get [ call ] [ die ] if* ;
ui-error-hook global [ [ rethrow ] or ] change-at
diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor
index de2eb71307..88f0a353b9 100644
--- a/basis/ui/ui.factor
+++ b/basis/ui/ui.factor
@@ -1,10 +1,10 @@
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
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
-hashtables concurrency.flags sets accessors calendar ;
+dlists deques sequences threads sequences words ui.gadgets
+ui.gadgets.worlds ui.gadgets.tracks ui.gestures ui.backend
+ui.render continuations init combinators hashtables
+concurrency.flags sets accessors calendar ;
IN: ui
! Assoc mapping aliens to gadgets
diff --git a/basis/ui/x11/x11.factor b/basis/ui/x11/x11.factor
index b65236d1f9..a532a13b69 100755
--- a/basis/ui/x11/x11.factor
+++ b/basis/ui/x11/x11.factor
@@ -5,7 +5,7 @@ ui.gestures ui.backend ui.clipboards ui.gadgets.worlds ui.render
assocs kernel math namespaces opengl sequences strings x11.xlib
x11.events x11.xim x11.glx x11.clipboard x11.constants
x11.windows io.encodings.string io.encodings.ascii
-io.encodings.utf8 combinators debugger command-line qualified
+io.encodings.utf8 combinators command-line qualified
math.vectors classes.tuple opengl.gl threads math.geometry.rect
environment ascii ;
IN: ui.x11
From ca8091443cf5540d930d8f46c50a36702c682403 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 13:59:25 -0600
Subject: [PATCH 05/46] Move byte-vectors and io.streams.byte-array to basis
---
core/byte-vectors/byte-vectors-docs.factor | 37 ----------------
core/byte-vectors/byte-vectors-tests.factor | 17 -------
core/byte-vectors/byte-vectors.factor | 44 -------------------
core/byte-vectors/summary.txt | 1 -
core/byte-vectors/tags.txt | 1 -
.../streams/byte-array/byte-array-docs.factor | 34 --------------
.../byte-array/byte-array-tests.factor | 9 ----
core/io/streams/byte-array/byte-array.factor | 16 -------
8 files changed, 159 deletions(-)
delete mode 100644 core/byte-vectors/byte-vectors-docs.factor
delete mode 100644 core/byte-vectors/byte-vectors-tests.factor
delete mode 100644 core/byte-vectors/byte-vectors.factor
delete mode 100644 core/byte-vectors/summary.txt
delete mode 100644 core/byte-vectors/tags.txt
delete mode 100644 core/io/streams/byte-array/byte-array-docs.factor
delete mode 100644 core/io/streams/byte-array/byte-array-tests.factor
delete mode 100644 core/io/streams/byte-array/byte-array.factor
diff --git a/core/byte-vectors/byte-vectors-docs.factor b/core/byte-vectors/byte-vectors-docs.factor
deleted file mode 100644
index 3873f73bfe..0000000000
--- a/core/byte-vectors/byte-vectors-docs.factor
+++ /dev/null
@@ -1,37 +0,0 @@
-USING: arrays byte-arrays help.markup help.syntax kernel
-byte-vectors.private combinators ;
-IN: byte-vectors
-
-ARTICLE: "byte-vectors" "Byte vectors"
-"A byte vector is a resizable mutable sequence of unsigned bytes. Byte vector words are found in the " { $vocab-link "byte-vectors" } " vocabulary."
-$nl
-"Byte vectors form a class:"
-{ $subsection byte-vector }
-{ $subsection byte-vector? }
-"Creating byte vectors:"
-{ $subsection >byte-vector }
-{ $subsection <byte-vector> }
-"Literal syntax:"
-{ $subsection POSTPONE: BV{ }
-"If you don't care about initial capacity, a more elegant way to create a new byte vector is to write:"
-{ $code "BV{ } clone" } ;
-
-ABOUT: "byte-vectors"
-
-HELP: byte-vector
-{ $description "The class of resizable byte vectors. See " { $link "byte-vectors" } " for information." } ;
-
-HELP: <byte-vector>
-{ $values { "n" "a positive integer specifying initial capacity" } { "byte-vector" byte-vector } }
-{ $description "Creates a new byte vector that can hold " { $snippet "n" } " bytes before resizing." } ;
-
-HELP: >byte-vector
-{ $values { "seq" "a sequence" } { "byte-vector" byte-vector } }
-{ $description "Outputs a freshly-allocated byte vector with the same elements as a given sequence." }
-{ $errors "Throws an error if the sequence contains elements other than integers." } ;
-
-HELP: BV{
-{ $syntax "BV{ elements... }" }
-{ $values { "elements" "a list of bytes" } }
-{ $description "Marks the beginning of a literal byte vector. Literal byte vectors are terminated by " { $link POSTPONE: } } "." }
-{ $examples { $code "BV{ 1 2 3 12 }" } } ;
diff --git a/core/byte-vectors/byte-vectors-tests.factor b/core/byte-vectors/byte-vectors-tests.factor
deleted file mode 100644
index 9a100d9795..0000000000
--- a/core/byte-vectors/byte-vectors-tests.factor
+++ /dev/null
@@ -1,17 +0,0 @@
-IN: byte-vectors.tests
-USING: tools.test byte-vectors vectors sequences kernel
-prettyprint ;
-
-[ 0 ] [ 123 <byte-vector> length ] unit-test
-
-: do-it
- 123 [ over push ] each ;
-
-[ t ] [
- 3 <byte-vector> do-it
- 3 <vector> do-it sequence=
-] unit-test
-
-[ t ] [ BV{ } byte-vector? ] unit-test
-
-[ "BV{ }" ] [ BV{ } unparse ] unit-test
diff --git a/core/byte-vectors/byte-vectors.factor b/core/byte-vectors/byte-vectors.factor
deleted file mode 100644
index 6938d02b2f..0000000000
--- a/core/byte-vectors/byte-vectors.factor
+++ /dev/null
@@ -1,44 +0,0 @@
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel kernel.private math sequences
-sequences.private growable byte-arrays accessors ;
-IN: byte-vectors
-
-TUPLE: byte-vector
-{ underlying byte-array }
-{ length array-capacity } ;
-
-: <byte-vector> ( n -- byte-vector )
- <byte-array> 0 byte-vector boa ; inline
-
-: >byte-vector ( seq -- byte-vector )
- T{ byte-vector f B{ } 0 } clone-like ;
-
-M: byte-vector like
- drop dup byte-vector? [
- dup byte-array?
- [ dup length byte-vector boa ] [ >byte-vector ] if
- ] unless ;
-
-M: byte-vector new-sequence
- drop [ <byte-array> ] [ >fixnum ] bi byte-vector boa ;
-
-M: byte-vector equal?
- over byte-vector? [ sequence= ] [ 2drop f ] if ;
-
-M: byte-array like
- #! If we have an byte-array, we're done.
- #! If we have a byte-vector, and it's at full capacity,
- #! we're done. Otherwise, call resize-byte-array, which is a
- #! relatively fast primitive.
- drop dup byte-array? [
- dup byte-vector? [
- [ length ] [ underlying>> ] bi
- 2dup length eq?
- [ nip ] [ resize-byte-array ] if
- ] [ >byte-array ] if
- ] unless ;
-
-M: byte-array new-resizable drop <byte-vector> ;
-
-INSTANCE: byte-vector growable
diff --git a/core/byte-vectors/summary.txt b/core/byte-vectors/summary.txt
deleted file mode 100644
index e914ebb319..0000000000
--- a/core/byte-vectors/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-Growable byte arrays
diff --git a/core/byte-vectors/tags.txt b/core/byte-vectors/tags.txt
deleted file mode 100644
index 42d711b32b..0000000000
--- a/core/byte-vectors/tags.txt
+++ /dev/null
@@ -1 +0,0 @@
-collections
diff --git a/core/io/streams/byte-array/byte-array-docs.factor b/core/io/streams/byte-array/byte-array-docs.factor
deleted file mode 100644
index 7b27621343..0000000000
--- a/core/io/streams/byte-array/byte-array-docs.factor
+++ /dev/null
@@ -1,34 +0,0 @@
-USING: help.syntax help.markup io byte-arrays quotations ;
-IN: io.streams.byte-array
-
-ABOUT: "io.streams.byte-array"
-
-ARTICLE: "io.streams.byte-array" "Byte-array streams"
-"Byte array streams:"
-{ $subsection <byte-reader> }
-{ $subsection <byte-writer> }
-"Utility combinators:"
-{ $subsection with-byte-reader }
-{ $subsection with-byte-writer } ;
-
-HELP: <byte-reader>
-{ $values { "byte-array" byte-array }
- { "encoding" "an encoding descriptor" }
- { "stream" "a new byte reader" } }
-{ $description "Creates an input stream reading from a byte array using an encoding." } ;
-
-HELP: <byte-writer>
-{ $values { "encoding" "an encoding descriptor" }
- { "stream" "a new byte writer" } }
-{ $description "Creates an output stream writing data to a byte array using an encoding." } ;
-
-HELP: with-byte-reader
-{ $values { "encoding" "an encoding descriptor" }
- { "quot" quotation } { "byte-array" byte-array } }
-{ $description "Calls the quotation in a new dynamic scope with " { $link input-stream } " rebound to an input stream for reading from a byte array using an encoding." } ;
-
-HELP: with-byte-writer
-{ $values { "encoding" "an encoding descriptor" }
- { "quot" quotation }
- { "byte-array" byte-array } }
-{ $description "Calls the quotation in a new dynamic scope with " { $link output-stream } " rebound to an output stream writing data to a byte array using an encoding." } ;
diff --git a/core/io/streams/byte-array/byte-array-tests.factor b/core/io/streams/byte-array/byte-array-tests.factor
deleted file mode 100644
index 77a9126740..0000000000
--- a/core/io/streams/byte-array/byte-array-tests.factor
+++ /dev/null
@@ -1,9 +0,0 @@
-USING: tools.test io.streams.byte-array io.encodings.binary
-io.encodings.utf8 io kernel arrays strings ;
-
-[ B{ 1 2 3 } ] [ binary [ { 1 2 3 } write ] with-byte-writer ] unit-test
-[ B{ 1 2 3 } ] [ { 1 2 3 } binary [ 3 read ] with-byte-reader ] unit-test
-
-[ B{ BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 BIN: 11101111 BIN: 10000000 BIN: 10111111 BIN: 11011111 BIN: 10000000 CHAR: x } ]
-[ { BIN: 101111111000000111111 BIN: 1111000000111111 BIN: 11111000000 CHAR: x } utf8 [ write ] with-byte-writer ] unit-test
-[ { BIN: 101111111000000111111 } t ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 } utf8 <byte-reader> contents dup >array swap string? ] unit-test
diff --git a/core/io/streams/byte-array/byte-array.factor b/core/io/streams/byte-array/byte-array.factor
deleted file mode 100644
index 9d89c3d814..0000000000
--- a/core/io/streams/byte-array/byte-array.factor
+++ /dev/null
@@ -1,16 +0,0 @@
-USING: byte-arrays byte-vectors kernel io.encodings io.streams.string
-sequences io namespaces io.encodings.private accessors ;
-IN: io.streams.byte-array
-
-: <byte-writer> ( encoding -- stream )
- 512 <byte-vector> swap <encoder> ;
-
-: with-byte-writer ( encoding quot -- byte-array )
- [ <byte-writer> ] dip [ output-stream get ] compose with-output-stream*
- dup encoder? [ stream>> ] when >byte-array ; inline
-
-: <byte-reader> ( byte-array encoding -- stream )
- [ >byte-vector dup reverse-here ] dip <decoder> ;
-
-: with-byte-reader ( byte-array encoding quot -- )
- [ <byte-reader> ] dip with-input-stream* ; inline
From 73b3cd636762c72acc701d65778e0c6bee7f2153 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 13:59:59 -0600
Subject: [PATCH 06/46] Use eq? instead of number= since we only ever have a
fixnum here
---
core/math/integers/integers.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor
index 30903e3269..b229ea175d 100644
--- a/core/math/integers/integers.factor
+++ b/core/math/integers/integers.factor
@@ -41,7 +41,7 @@ M: fixnum bitnot fixnum-bitnot ;
M: fixnum bit? neg shift 1 bitand 0 > ;
: fixnum-log2 ( x -- n )
- 0 swap [ dup 1 number= not ] [ [ 1+ ] [ 2/ ] bi* ] [ ] while drop ;
+ 0 swap [ dup 1 eq? not ] [ [ 1+ ] [ 2/ ] bi* ] [ ] while drop ;
M: fixnum (log2) fixnum-log2 ;
From 4f0a9f311e13a2007acae2f82949ec0ca500853d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 14:58:00 -0600
Subject: [PATCH 07/46] Untangling some dependencies
---
basis/alien/prettyprint/prettyprint.factor | 14 ++++
basis/alien/syntax/syntax.factor | 12 +---
basis/bit-arrays/bit-arrays.factor | 2 +-
basis/bit-vectors/bit-vectors.factor | 2 +-
basis/bootstrap/bootstrap-error.factor | 8 +++
basis/bootstrap/compiler/compiler.factor | 11 ++-
basis/bootstrap/finish-bootstrap.factor | 16 +++++
basis/bootstrap/finish-staging.factor | 10 +++
basis/bootstrap/math/math.factor | 4 +-
basis/bootstrap/stage2.factor | 29 +++-----
basis/byte-vectors/byte-vectors.factor | 2 +-
basis/checksums/md5/md5.factor | 4 +-
basis/checksums/openssl/openssl.factor | 5 +-
basis/checksums/sha1/sha1.factor | 5 +-
basis/checksums/stream/stream.factor | 12 ++++
basis/command-line/command-line.factor | 21 +-----
.../alias-analysis-tests.factor | 4 +-
.../cfg/dead-code/dead-code-tests.factor | 3 +-
basis/compiler/cfg/debugger/debugger.factor | 20 +++++-
basis/compiler/cfg/registers/registers.factor | 17 +----
.../value-numbering-tests.factor | 5 +-
.../write-barrier/write-barrier-tests.factor | 3 +-
basis/compiler/codegen/fixup/fixup.factor | 10 +--
basis/compiler/compiler.factor | 21 +++---
basis/compiler/tree/debugger/debugger.factor | 5 +-
basis/debugger/debugger.factor | 6 +-
basis/help/definitions/definitions.factor | 3 +-
basis/help/lint/lint.factor | 2 +-
basis/io/styles/styles.factor | 10 ++-
basis/locals/locals.factor | 6 +-
basis/math/complex/complex.factor | 8 +--
.../complex/prettyprint/prettyprint.factor | 8 +++
basis/nibble-arrays/nibble-arrays.factor | 2 +-
basis/persistent/hashtables/hashtables.factor | 2 +-
basis/persistent/vectors/vectors.factor | 2 +-
basis/prettyprint/backend/backend-docs.factor | 8 +--
basis/prettyprint/backend/backend.factor | 21 ++----
basis/prettyprint/custom/custom-docs.factor | 9 +++
basis/prettyprint/custom/custom.factor | 9 +++
basis/prettyprint/prettyprint-docs.factor | 2 +-
basis/prettyprint/prettyprint.factor | 15 +++--
basis/qualified/qualified.factor | 2 +-
basis/regexp/regexp.factor | 10 +--
.../specialized-arrays/functor/functor.factor | 2 +-
.../functor/functor.factor | 2 +-
basis/stack-checker/backend/backend.factor | 12 ++--
basis/stack-checker/errors/errors.factor | 67 +------------------
.../errors/prettyprint/prettyprint.factor | 67 +++++++++++++++++++
.../known-words/known-words.factor | 2 +-
basis/summary/summary.factor | 13 +---
basis/tools/deploy/backend/backend.factor | 11 ++-
basis/tools/deploy/config/config-docs.factor | 29 +-------
basis/tools/deploy/config/config.factor | 20 +-----
.../deploy/config/editor/editor-docs.factor | 27 ++++++++
.../tools/deploy/config/editor/editor.factor | 20 ++++++
basis/tools/deploy/deploy-docs.factor | 5 ++
basis/tools/deploy/shaker/shaker.factor | 34 +++-------
.../disassembler/disassembler-tests.factor | 4 +-
basis/urls/urls.factor | 6 +-
basis/vlists/vlists.factor | 2 +-
core/bootstrap/primitives.factor | 1 -
core/bootstrap/stage1.factor | 2 +-
core/bootstrap/syntax.factor | 1 -
core/checksums/checksums.factor | 7 +-
core/classes/algebra/algebra-docs.factor | 1 +
core/growable/growable-docs.factor | 2 +-
core/syntax/syntax.factor | 18 +++--
67 files changed, 386 insertions(+), 339 deletions(-)
create mode 100644 basis/alien/prettyprint/prettyprint.factor
create mode 100644 basis/bootstrap/bootstrap-error.factor
create mode 100644 basis/bootstrap/finish-bootstrap.factor
create mode 100644 basis/bootstrap/finish-staging.factor
create mode 100644 basis/checksums/stream/stream.factor
create mode 100644 basis/math/complex/prettyprint/prettyprint.factor
create mode 100644 basis/prettyprint/custom/custom-docs.factor
create mode 100644 basis/prettyprint/custom/custom.factor
create mode 100644 basis/stack-checker/errors/prettyprint/prettyprint.factor
create mode 100644 basis/tools/deploy/config/editor/editor-docs.factor
create mode 100644 basis/tools/deploy/config/editor/editor.factor
diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor
new file mode 100644
index 0000000000..0794ab7789
--- /dev/null
+++ b/basis/alien/prettyprint/prettyprint.factor
@@ -0,0 +1,14 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel combinators alien alien.strings alien.syntax
+prettyprint.backend prettyprint.custom prettyprint.sections ;
+IN: alien.prettyprint
+
+M: alien pprint*
+ {
+ { [ dup expired? ] [ drop \ BAD-ALIEN pprint-word ] }
+ { [ dup pinned-c-ptr? not ] [ drop "( displaced alien )" text ] }
+ [ \ ALIEN: [ alien-address pprint* ] pprint-prefix ]
+ } cond ;
+
+M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ;
diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor
index d10c97cd3d..b0ba10a316 100644
--- a/basis/alien/syntax/syntax.factor
+++ b/basis/alien/syntax/syntax.factor
@@ -3,8 +3,7 @@
USING: accessors arrays alien alien.c-types alien.structs
alien.arrays alien.strings kernel math namespaces parser
sequences words quotations math.parser splitting grouping
-effects prettyprint prettyprint.sections prettyprint.backend
-assocs combinators lexer strings.parser alien.parser ;
+effects assocs combinators lexer strings.parser alien.parser ;
IN: alien.syntax
: DLL" lexer get skip-blank parse-string dlopen parsed ; parsing
@@ -34,12 +33,3 @@ IN: alien.syntax
dup length
[ [ create-in ] dip 1quotation define ] 2each ;
parsing
-
-M: alien pprint*
- {
- { [ dup expired? ] [ drop \ BAD-ALIEN pprint-word ] }
- { [ dup pinned-c-ptr? not ] [ drop "( displaced alien )" text ] }
- [ \ ALIEN: [ alien-address pprint* ] pprint-prefix ]
- } cond ;
-
-M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ;
diff --git a/basis/bit-arrays/bit-arrays.factor b/basis/bit-arrays/bit-arrays.factor
index 4cb2032f4f..d5e94f0238 100644
--- a/basis/bit-arrays/bit-arrays.factor
+++ b/basis/bit-arrays/bit-arrays.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types accessors math alien.accessors kernel
kernel.private locals sequences sequences.private byte-arrays
-parser prettyprint.backend fry ;
+parser prettyprint.custom fry ;
IN: bit-arrays
TUPLE: bit-array
diff --git a/basis/bit-vectors/bit-vectors.factor b/basis/bit-vectors/bit-vectors.factor
index 404b26829b..85bea80b2d 100644
--- a/basis/bit-vectors/bit-vectors.factor
+++ b/basis/bit-vectors/bit-vectors.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel kernel.private math sequences
-sequences.private growable bit-arrays prettyprint.backend
+sequences.private growable bit-arrays prettyprint.custom
parser accessors ;
IN: bit-vectors
diff --git a/basis/bootstrap/bootstrap-error.factor b/basis/bootstrap/bootstrap-error.factor
new file mode 100644
index 0000000000..01eb002e44
--- /dev/null
+++ b/basis/bootstrap/bootstrap-error.factor
@@ -0,0 +1,8 @@
+USING: continuations kernel io debugger vocabs words system namespaces ;
+
+:c
+:error
+"listener" vocab
+[ restarts. vocab-main execute ]
+[ die ] if*
+1 exit
diff --git a/basis/bootstrap/compiler/compiler.factor b/basis/bootstrap/compiler/compiler.factor
index 9968af4330..f0d9e8e131 100644
--- a/basis/bootstrap/compiler/compiler.factor
+++ b/basis/bootstrap/compiler/compiler.factor
@@ -5,17 +5,22 @@ sequences namespaces parser kernel kernel.private classes
classes.private arrays hashtables vectors classes.tuple sbufs
hashtables.private sequences.private math classes.tuple.private
growable namespaces.private assocs words command-line vocabs io
-io.encodings.string prettyprint libc splitting math.parser
+io.encodings.string libc splitting math.parser
compiler.units math.order compiler.tree.builder
compiler.tree.optimizer compiler.cfg.optimizer ;
IN: bootstrap.compiler
! Don't bring this in when deploying, since it will store a
! reference to 'eval' in a global variable
-"deploy-vocab" get [
+"deploy-vocab" get "staging" get or [
"alien.remote-control" require
] unless
+"prettyprint" vocab [
+ "stack-checker.errors.prettyprint" require
+ "alien.prettyprint" require
+] when
+
"cpu." cpu name>> append require
enable-compiler
@@ -86,7 +91,7 @@ nl
"." write flush
{
- . malloc calloc free memcpy
+ malloc calloc free memcpy
} compile-uncompiled
"." write flush
diff --git a/basis/bootstrap/finish-bootstrap.factor b/basis/bootstrap/finish-bootstrap.factor
new file mode 100644
index 0000000000..133b64acaa
--- /dev/null
+++ b/basis/bootstrap/finish-bootstrap.factor
@@ -0,0 +1,16 @@
+USING: init command-line debugger system continuations
+namespaces eval kernel vocabs.loader io ;
+
+[
+ boot
+ do-init-hooks
+ [
+ (command-line) parse-command-line
+ load-vocab-roots
+ run-user-init
+ "e" get [ eval ] when*
+ ignore-cli-args? not script get and
+ [ run-script ] [ "run" get run ] if*
+ output-stream get [ stream-flush ] when*
+ ] [ print-error 1 exit ] recover
+] set-boot-quot
diff --git a/basis/bootstrap/finish-staging.factor b/basis/bootstrap/finish-staging.factor
new file mode 100644
index 0000000000..a60ce04e15
--- /dev/null
+++ b/basis/bootstrap/finish-staging.factor
@@ -0,0 +1,10 @@
+USING: init command-line system namespaces kernel vocabs.loader
+io ;
+
+[
+ boot
+ do-init-hooks
+ (command-line) parse-command-line
+ "run" get run
+ output-stream get [ stream-flush ] when*
+] set-boot-quot
diff --git a/basis/bootstrap/math/math.factor b/basis/bootstrap/math/math.factor
index a293efd33e..347969af0d 100644
--- a/basis/bootstrap/math/math.factor
+++ b/basis/bootstrap/math/math.factor
@@ -1,5 +1,7 @@
-USE: vocabs.loader
+USING: vocabs vocabs.loader kernel ;
"math.ratios" require
"math.floats" require
"math.complex" require
+
+"prettyprint" vocab [ "math.complex.prettyprint" require ] when
diff --git a/basis/bootstrap/stage2.factor b/basis/bootstrap/stage2.factor
index 4ab36ec94e..78355a4670 100644
--- a/basis/bootstrap/stage2.factor
+++ b/basis/bootstrap/stage2.factor
@@ -2,10 +2,10 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors init namespaces words io
kernel.private math memory continuations kernel io.files
-io.backend system parser vocabs sequences prettyprint
+io.backend system parser vocabs sequences
vocabs.loader combinators splitting source-files strings
definitions assocs compiler.errors compiler.units
-math.parser generic sets debugger command-line ;
+math.parser generic sets command-line ;
IN: bootstrap.stage2
SYMBOL: core-bootstrap-time
@@ -86,25 +86,18 @@ SYMBOL: bootstrap-time
f error set-global
f error-continuation set-global
+ millis swap - bootstrap-time set-global
+ print-report
+
"deploy-vocab" get [
"tools.deploy.shaker" run
] [
- [
- boot
- do-init-hooks
- handle-command-line
- ] set-boot-quot
-
- millis swap - bootstrap-time set-global
- print-report
+ "staging" get [
+ "resource:basis/bootstrap/finish-staging.factor" run-file
+ ] [
+ "resource:basis/bootstrap/finish-bootstrap.factor" run-file
+ ] if
"output-image" get save-image-and-exit
] if
-] [
- :c
- dup print-error flush
- "listener" vocab
- [ restarts. vocab-main execute ]
- [ die ] if*
- 1 exit
-] recover
+] [ drop "resource:basis/bootstrap/bootstrap-error.factor" run-file ] recover
diff --git a/basis/byte-vectors/byte-vectors.factor b/basis/byte-vectors/byte-vectors.factor
index b2c0d55c0f..e24c808bbc 100644
--- a/basis/byte-vectors/byte-vectors.factor
+++ b/basis/byte-vectors/byte-vectors.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel kernel.private math sequences
sequences.private growable byte-arrays accessors parser
-prettyprint.backend ;
+prettyprint.custom ;
IN: byte-vectors
TUPLE: byte-vector
diff --git a/basis/checksums/md5/md5.factor b/basis/checksums/md5/md5.factor
index 257fd930c4..d919b0e313 100644
--- a/basis/checksums/md5/md5.factor
+++ b/basis/checksums/md5/md5.factor
@@ -4,7 +4,7 @@ USING: kernel io io.binary io.files io.streams.byte-array math
math.functions math.parser namespaces splitting grouping strings
sequences byte-arrays locals sequences.private
io.encodings.binary symbols math.bitwise checksums
-checksums.common ;
+checksums.common checksums.stream ;
IN: checksums.md5
! See http://www.faqs.org/rfcs/rfc1321.html
@@ -180,7 +180,7 @@ PRIVATE>
SINGLETON: md5
-INSTANCE: md5 checksum
+INSTANCE: md5 stream-checksum
M: md5 checksum-stream ( stream -- byte-array )
drop [ initialize-md5 stream>md5 get-md5 ] with-input-stream ;
diff --git a/basis/checksums/openssl/openssl.factor b/basis/checksums/openssl/openssl.factor
index 821cbe2f3a..4bc7a7964a 100644
--- a/basis/checksums/openssl/openssl.factor
+++ b/basis/checksums/openssl/openssl.factor
@@ -1,7 +1,8 @@
! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: accessors byte-arrays alien.c-types kernel continuations
-destructors sequences io openssl openssl.libcrypto checksums ;
+destructors sequences io openssl openssl.libcrypto checksums
+checksums.stream ;
IN: checksums.openssl
ERROR: unknown-digest name ;
@@ -12,7 +13,7 @@ TUPLE: openssl-checksum name ;
: openssl-sha1 T{ openssl-checksum f "sha1" } ;
-INSTANCE: openssl-checksum checksum
+INSTANCE: openssl-checksum stream-checksum
C: <openssl-checksum> openssl-checksum
diff --git a/basis/checksums/sha1/sha1.factor b/basis/checksums/sha1/sha1.factor
index 3767af7c55..6cdc9270aa 100644
--- a/basis/checksums/sha1/sha1.factor
+++ b/basis/checksums/sha1/sha1.factor
@@ -3,7 +3,8 @@
USING: arrays combinators kernel io io.encodings.binary io.files
io.streams.byte-array math.vectors strings sequences namespaces
make math parser sequences assocs grouping vectors io.binary
-hashtables symbols math.bitwise checksums checksums.common ;
+hashtables symbols math.bitwise checksums checksums.common
+checksums.stream ;
IN: checksums.sha1
! Implemented according to RFC 3174.
@@ -113,7 +114,7 @@ SYMBOLS: h0 h1 h2 h3 h4 A B C D E w K ;
SINGLETON: sha1
-INSTANCE: sha1 checksum
+INSTANCE: sha1 stream-checksum
M: sha1 checksum-stream ( stream -- sha1 )
drop [ initialize-sha1 stream>sha1 get-sha1 ] with-input-stream ;
diff --git a/basis/checksums/stream/stream.factor b/basis/checksums/stream/stream.factor
new file mode 100644
index 0000000000..e753467323
--- /dev/null
+++ b/basis/checksums/stream/stream.factor
@@ -0,0 +1,12 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.binary io.streams.byte-array kernel
+checksums ;
+IN: checksums.stream
+
+MIXIN: stream-checksum
+
+M: stream-checksum checksum-bytes
+ [ binary <byte-reader> ] dip checksum-stream ;
+
+INSTANCE: stream-checksum checksum
diff --git a/basis/command-line/command-line.factor b/basis/command-line/command-line.factor
index 1b58053b64..7d5a041951 100644
--- a/basis/command-line/command-line.factor
+++ b/basis/command-line/command-line.factor
@@ -1,8 +1,8 @@
! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: init continuations debugger hashtables io
-io.encodings.utf8 io.files kernel kernel.private namespaces
-parser sequences strings system splitting eval vocabs.loader ;
+USING: init continuations hashtables io io.encodings.utf8
+io.files kernel kernel.private namespaces parser sequences
+strings system splitting vocabs.loader ;
IN: command-line
SYMBOL: script
@@ -31,8 +31,6 @@ SYMBOL: command-line
] [ drop ] if
] when ;
-<PRIVATE
-
: var-param ( name value -- ) swap set-global ;
: bool-param ( name -- ) "no-" ?head not var-param ;
@@ -43,8 +41,6 @@ SYMBOL: command-line
: run-script ( file -- )
t "quiet" set-global run-file ;
-PRIVATE>
-
: parse-command-line ( args -- )
[ command-line off script off ] [
unclip "-" ?head
@@ -76,15 +72,4 @@ SYMBOL: main-vocab-hook
: script-mode ( -- ) ;
-: handle-command-line ( -- )
- [
- (command-line) parse-command-line
- load-vocab-roots
- run-user-init
- "e" get [ eval ] when*
- ignore-cli-args? not script get and
- [ run-script ] [ "run" get run ] if*
- output-stream get [ stream-flush ] when*
- ] [ print-error 1 exit ] recover ;
-
[ default-cli-args ] "command-line" add-init-hook
diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor b/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor
index c7094c8c36..d8bad5ec41 100644
--- a/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor
+++ b/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor
@@ -1,6 +1,6 @@
USING: compiler.cfg.instructions compiler.cfg.registers
-compiler.cfg.alias-analysis cpu.architecture tools.test
-kernel ;
+compiler.cfg.alias-analysis compiler.cfg.debugger
+cpu.architecture tools.test kernel ;
IN: compiler.cfg.alias-analysis.tests
[ ] [
diff --git a/basis/compiler/cfg/dead-code/dead-code-tests.factor b/basis/compiler/cfg/dead-code/dead-code-tests.factor
index b9c3af5215..ee7d8d2a43 100644
--- a/basis/compiler/cfg/dead-code/dead-code-tests.factor
+++ b/basis/compiler/cfg/dead-code/dead-code-tests.factor
@@ -1,5 +1,6 @@
USING: compiler.cfg.dead-code compiler.cfg.instructions
-compiler.cfg.registers cpu.architecture tools.test ;
+compiler.cfg.registers compiler.cfg.debugger
+cpu.architecture tools.test ;
IN: compiler.cfg.dead-code.tests
[ { } ] [
diff --git a/basis/compiler/cfg/debugger/debugger.factor b/basis/compiler/cfg/debugger/debugger.factor
index 7b1b9100c4..ba58e60a4a 100644
--- a/basis/compiler/cfg/debugger/debugger.factor
+++ b/basis/compiler/cfg/debugger/debugger.factor
@@ -2,10 +2,12 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel words sequences quotations namespaces io
classes.tuple accessors prettyprint prettyprint.config
-compiler.tree.builder compiler.tree.optimizer
+prettyprint.backend prettyprint.custom prettyprint.sections
+parser compiler.tree.builder compiler.tree.optimizer
compiler.cfg.builder compiler.cfg.linearization
-compiler.cfg.stack-frame compiler.cfg.linear-scan
-compiler.cfg.two-operand compiler.cfg.optimizer ;
+compiler.cfg.registers compiler.cfg.stack-frame
+compiler.cfg.linear-scan compiler.cfg.two-operand
+compiler.cfg.optimizer ;
IN: compiler.cfg.debugger
GENERIC: test-cfg ( quot -- cfgs )
@@ -40,3 +42,15 @@ SYMBOL: allocate-registers?
instructions>> [ insn. ] each
nl
] each ;
+
+! Prettyprinting
+M: vreg pprint*
+ <block
+ \ V pprint-word [ reg-class>> pprint* ] [ n>> pprint* ] bi
+ block> ;
+
+: pprint-loc ( loc word -- ) <block pprint-word n>> pprint* block> ;
+
+M: ds-loc pprint* \ D pprint-loc ;
+
+M: rs-loc pprint* \ R pprint-loc ;
diff --git a/basis/compiler/cfg/registers/registers.factor b/basis/compiler/cfg/registers/registers.factor
index 21572ec615..2b9d3df6f6 100644
--- a/basis/compiler/cfg/registers/registers.factor
+++ b/basis/compiler/cfg/registers/registers.factor
@@ -1,7 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors namespaces kernel arrays
-parser prettyprint.backend prettyprint.sections ;
+USING: accessors namespaces kernel arrays parser ;
IN: compiler.cfg.registers
! Virtual registers, used by CFG and machine IRs
@@ -18,20 +17,6 @@ C: <ds-loc> ds-loc
TUPLE: rs-loc < loc ;
C: <rs-loc> rs-loc
-! Prettyprinting
: V scan-word scan-word vreg boa parsed ; parsing
-
-M: vreg pprint*
- <block
- \ V pprint-word [ reg-class>> pprint* ] [ n>> pprint* ] bi
- block> ;
-
-: pprint-loc ( loc word -- ) <block pprint-word n>> pprint* block> ;
-
: D scan-word <ds-loc> parsed ; parsing
-
-M: ds-loc pprint* \ D pprint-loc ;
-
: R scan-word <rs-loc> parsed ; parsing
-
-M: rs-loc pprint* \ R pprint-loc ;
diff --git a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor
index 8adeaa21f4..641ccceb5d 100644
--- a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor
+++ b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor
@@ -1,7 +1,8 @@
IN: compiler.cfg.value-numbering.tests
USING: compiler.cfg.value-numbering compiler.cfg.instructions
-compiler.cfg.registers cpu.architecture tools.test kernel math
-combinators.short-circuit accessors sequences ;
+compiler.cfg.registers compiler.cfg.debugger cpu.architecture
+tools.test kernel math combinators.short-circuit accessors
+sequences ;
: trim-temps ( insns -- insns )
[
diff --git a/basis/compiler/cfg/write-barrier/write-barrier-tests.factor b/basis/compiler/cfg/write-barrier/write-barrier-tests.factor
index 7a4b1c488f..73748dbc37 100644
--- a/basis/compiler/cfg/write-barrier/write-barrier-tests.factor
+++ b/basis/compiler/cfg/write-barrier/write-barrier-tests.factor
@@ -1,5 +1,6 @@
USING: compiler.cfg.write-barrier compiler.cfg.instructions
-compiler.cfg.registers cpu.architecture arrays tools.test ;
+compiler.cfg.registers compiler.cfg.debugger cpu.architecture
+arrays tools.test ;
IN: compiler.cfg.write-barrier.tests
[
diff --git a/basis/compiler/codegen/fixup/fixup.factor b/basis/compiler/codegen/fixup/fixup.factor
index a56ae04a7b..e0f391deb5 100755
--- a/basis/compiler/codegen/fixup/fixup.factor
+++ b/basis/compiler/codegen/fixup/fixup.factor
@@ -1,10 +1,10 @@
! 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 make sequences words
-quotations strings alien.accessors alien.strings layouts system
-combinators math.bitwise words.private math.order accessors
-growable cpu.architecture compiler.constants ;
+USING: arrays byte-arrays byte-vectors generic assocs hashtables
+io.binary kernel kernel.private math namespaces make sequences
+words quotations strings alien.accessors alien.strings layouts
+system combinators math.bitwise words.private math.order
+accessors growable cpu.architecture compiler.constants ;
IN: compiler.codegen.fixup
GENERIC: fixup* ( obj -- )
diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor
index e5cbd888d9..0d24daef71 100644
--- a/basis/compiler/compiler.factor
+++ b/basis/compiler/compiler.factor
@@ -1,15 +1,14 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel namespaces arrays sequences io debugger
-words fry continuations vocabs assocs dlists definitions
-math threads graphs generic combinators deques search-deques
-prettyprint io stack-checker stack-checker.state
-stack-checker.inlining compiler.errors compiler.units
-compiler.tree.builder compiler.tree.optimizer
-compiler.cfg.builder compiler.cfg.optimizer
-compiler.cfg.linearization compiler.cfg.two-operand
-compiler.cfg.linear-scan compiler.cfg.stack-frame
-compiler.codegen ;
+USING: accessors kernel namespaces arrays sequences io
+words fry continuations vocabs assocs dlists definitions math
+threads graphs generic combinators deques search-deques io
+stack-checker stack-checker.state stack-checker.inlining
+compiler.errors compiler.units compiler.tree.builder
+compiler.tree.optimizer compiler.cfg.builder
+compiler.cfg.optimizer compiler.cfg.linearization
+compiler.cfg.two-operand compiler.cfg.linear-scan
+compiler.cfg.stack-frame compiler.codegen ;
IN: compiler
SYMBOL: compile-queue
@@ -45,7 +44,7 @@ SYMBOL: +failed+
2bi ;
: start ( word -- )
- "trace-compilation" get [ dup . flush ] when
+ "trace-compilation" get [ dup name>> print flush ] when
H{ } clone dependencies set
H{ } clone generic-dependencies set
f swap compiler-error ;
diff --git a/basis/compiler/tree/debugger/debugger.factor b/basis/compiler/tree/debugger/debugger.factor
index 8d764a2833..8a2823010d 100644
--- a/basis/compiler/tree/debugger/debugger.factor
+++ b/basis/compiler/tree/debugger/debugger.factor
@@ -2,8 +2,9 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel assocs match fry accessors namespaces make effects
sequences sequences.private quotations generic macros arrays
-prettyprint prettyprint.backend prettyprint.sections math words
-combinators combinators.short-circuit io sorting hints qualified
+prettyprint prettyprint.backend prettyprint.custom
+prettyprint.sections math words combinators
+combinators.short-circuit io sorting hints qualified
compiler.tree
compiler.tree.recursive
compiler.tree.normalization
diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor
index 35b09713d3..4e0c4e8840 100644
--- a/basis/debugger/debugger.factor
+++ b/basis/debugger/debugger.factor
@@ -22,9 +22,6 @@ M: tuple error-help class ;
M: string error. print ;
-: :error ( -- )
- error get error. ;
-
: :s ( -- )
error-continuation get data>> stack. ;
@@ -63,6 +60,9 @@ M: string error. print ;
[ global [ "Error in print-error!" print drop ] bind ]
recover ;
+: :error ( -- )
+ error get print-error ;
+
: print-error-and-restarts ( error -- )
print-error
restarts.
diff --git a/basis/help/definitions/definitions.factor b/basis/help/definitions/definitions.factor
index e5202e1306..3e4066d8b7 100644
--- a/basis/help/definitions/definitions.factor
+++ b/basis/help/definitions/definitions.factor
@@ -1,7 +1,8 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors definitions help help.topics help.syntax
-prettyprint.backend prettyprint words kernel effects ;
+prettyprint.backend prettyprint.custom prettyprint words kernel
+effects ;
IN: help.definitions
! Definition protocol implementation
diff --git a/basis/help/lint/lint.factor b/basis/help/lint/lint.factor
index 0a392733ac..fbebc7f0f6 100644
--- a/basis/help/lint/lint.factor
+++ b/basis/help/lint/lint.factor
@@ -150,7 +150,7 @@ M: help-error error.
] [
[
swap vocab-heading.
- [ error. nl ] each
+ [ print-error nl ] each
] assoc-each
] if-empty ;
diff --git a/basis/io/styles/styles.factor b/basis/io/styles/styles.factor
index c9ba8f66df..e07753c640 100644
--- a/basis/io/styles/styles.factor
+++ b/basis/io/styles/styles.factor
@@ -1,6 +1,7 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: hashtables io colors ;
+USING: hashtables io colors summary make accessors splitting
+kernel ;
IN: io.styles
SYMBOL: plain
@@ -43,4 +44,11 @@ TUPLE: input string ;
C: <input> input
+M: input summary
+ [
+ "Input: " %
+ string>> "\n" split1 swap %
+ "..." "" ? %
+ ] "" make ;
+
: write-object ( str obj -- ) presented associate format ;
diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor
index b78b95bc24..80bafb0b55 100644
--- a/basis/locals/locals.factor
+++ b/basis/locals/locals.factor
@@ -2,9 +2,9 @@
! See http://factorcode.org/license.txt for BSD license.
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
+quotations macros arrays macros splitting combinators
+prettyprint.backend prettyprint.custom definitions prettyprint
+hashtables prettyprint.sections sets sequences.private effects
effects.parser generic generic.parser compiler.units accessors
locals.backend memoize macros.expander lexer classes summary fry
fry.private ;
diff --git a/basis/math/complex/complex.factor b/basis/math/complex/complex.factor
index c228684e32..90713cd40f 100644
--- a/basis/math/complex/complex.factor
+++ b/basis/math/complex/complex.factor
@@ -1,8 +1,8 @@
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel kernel.private math math.private
-math.libm math.functions prettyprint.backend arrays
-math.functions.private sequences parser ;
+math.libm math.functions arrays math.functions.private sequences
+parser ;
IN: math.complex.private
M: real real-part ;
@@ -47,7 +47,3 @@ M: complex sqrt >polar [ fsqrt ] [ 2.0 / ] bi* polar> ;
IN: syntax
: C{ \ } [ first2 rect> ] parse-literal ; parsing
-
-M: complex pprint-delims drop \ C{ \ } ;
-M: complex >pprint-sequence >rect 2array ;
-M: complex pprint* pprint-object ;
diff --git a/basis/math/complex/prettyprint/prettyprint.factor b/basis/math/complex/prettyprint/prettyprint.factor
new file mode 100644
index 0000000000..09eeb8045c
--- /dev/null
+++ b/basis/math/complex/prettyprint/prettyprint.factor
@@ -0,0 +1,8 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: math math.functions arrays prettyprint.custom kernel ;
+IN: math.complex.prettyprint
+
+M: complex pprint* pprint-object ;
+M: complex pprint-delims drop \ C{ \ } ;
+M: complex >pprint-sequence >rect 2array ;
diff --git a/basis/nibble-arrays/nibble-arrays.factor b/basis/nibble-arrays/nibble-arrays.factor
index c753d0fb78..82643bef15 100644
--- a/basis/nibble-arrays/nibble-arrays.factor
+++ b/basis/nibble-arrays/nibble-arrays.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: math kernel sequences sequences.private byte-arrays
-alien.c-types prettyprint.backend parser accessors ;
+alien.c-types prettyprint.custom parser accessors ;
IN: nibble-arrays
TUPLE: nibble-array
diff --git a/basis/persistent/hashtables/hashtables.factor b/basis/persistent/hashtables/hashtables.factor
index e50fd52c10..8c80782a2e 100644
--- a/basis/persistent/hashtables/hashtables.factor
+++ b/basis/persistent/hashtables/hashtables.factor
@@ -1,7 +1,7 @@
! Based on Clojure's PersistentHashMap by Rich Hickey.
USING: kernel math accessors assocs fry combinators parser
-prettyprint.backend make
+prettyprint.custom make
persistent.assocs
persistent.hashtables.nodes
persistent.hashtables.nodes.empty
diff --git a/basis/persistent/vectors/vectors.factor b/basis/persistent/vectors/vectors.factor
index 92b3f82a54..cd8e7c49e0 100644
--- a/basis/persistent/vectors/vectors.factor
+++ b/basis/persistent/vectors/vectors.factor
@@ -1,7 +1,7 @@
! Based on Clojure's PersistentVector by Rich Hickey.
USING: math accessors kernel sequences.private sequences arrays
-combinators combinators.short-circuit parser prettyprint.backend
+combinators combinators.short-circuit parser prettyprint.custom
persistent.sequences ;
IN: persistent.vectors
diff --git a/basis/prettyprint/backend/backend-docs.factor b/basis/prettyprint/backend/backend-docs.factor
index 64e1fd45ff..165621887f 100644
--- a/basis/prettyprint/backend/backend-docs.factor
+++ b/basis/prettyprint/backend/backend-docs.factor
@@ -1,14 +1,10 @@
USING: help.markup help.syntax io kernel
-prettyprint.config prettyprint.sections words strings ;
+prettyprint.config prettyprint.sections prettyprint.custom
+words strings ;
IN: prettyprint.backend
ABOUT: "prettyprint-extension"
-HELP: pprint*
-{ $values { "obj" "an object" } }
-{ $contract "Adds sections to the current block corresponding to the prettyprinted representation of the object." }
-$prettyprinting-note ;
-
HELP: pprint-word
{ $values { "word" "a word" } }
{ $description "Adds a text section for the word. Unlike the " { $link word } " method of " { $link pprint* } ", this does not add a " { $link POSTPONE: POSTPONE: } " prefix to parsing words." }
diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor
index 76c3918f63..92d039a15d 100644
--- a/basis/prettyprint/backend/backend.factor
+++ b/basis/prettyprint/backend/backend.factor
@@ -1,15 +1,13 @@
! 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 make sequences
-strings sbufs io.styles vectors words prettyprint.config
+USING: accessors arrays byte-arrays generic hashtables io assocs
+kernel math namespaces make sequences strings sbufs io.styles
+vectors words prettyprint.config prettyprint.custom
prettyprint.sections quotations io io.files math.parser effects
classes.tuple math.order classes.tuple.private classes
combinators colors ;
IN: prettyprint.backend
-GENERIC: pprint* ( obj -- )
-
M: effect pprint* effect>string "(" ")" surround text ;
: ?effect-height ( word -- n )
@@ -161,26 +159,19 @@ M: tuple pprint*
[ [ pprint* ] each ] dip
[ "~" swap number>string " more~" 3append text ] when* ;
-GENERIC: pprint-delims ( obj -- start end )
-
M: quotation pprint-delims drop \ [ \ ] ;
M: curry pprint-delims drop \ [ \ ] ;
M: compose pprint-delims drop \ [ \ ] ;
M: array pprint-delims drop \ { \ } ;
M: byte-array pprint-delims drop \ B{ \ } ;
-M: byte-vector pprint-delims drop \ BV{ \ } ;
M: vector pprint-delims drop \ V{ \ } ;
M: hashtable pprint-delims drop \ H{ \ } ;
M: tuple pprint-delims drop \ T{ \ } ;
M: wrapper pprint-delims drop \ W{ \ } ;
M: callstack pprint-delims drop \ CS{ \ } ;
-GENERIC: >pprint-sequence ( obj -- seq )
-
M: object >pprint-sequence ;
-
M: vector >pprint-sequence ;
-M: byte-vector >pprint-sequence ;
M: curry >pprint-sequence ;
M: compose >pprint-sequence ;
M: hashtable >pprint-sequence >alist ;
@@ -191,16 +182,13 @@ M: tuple >pprint-sequence
[ class ] [ tuple-slots ] bi
[ 1array ] [ [ f 2array ] dip append ] if-empty ;
-GENERIC: pprint-narrow? ( obj -- ? )
-
M: object pprint-narrow? drop f ;
-
M: array pprint-narrow? drop t ;
M: vector pprint-narrow? drop t ;
M: hashtable pprint-narrow? drop t ;
M: tuple pprint-narrow? drop t ;
-: pprint-object ( obj -- )
+M: object pprint-object ( obj -- )
[
<flow
dup pprint-delims [
@@ -213,7 +201,6 @@ M: tuple pprint-narrow? drop t ;
M: object pprint* pprint-object ;
M: vector pprint* pprint-object ;
-M: byte-vector pprint* pprint-object ;
M: hashtable pprint* pprint-object ;
M: curry pprint* pprint-object ;
M: compose pprint* pprint-object ;
diff --git a/basis/prettyprint/custom/custom-docs.factor b/basis/prettyprint/custom/custom-docs.factor
new file mode 100644
index 0000000000..60557e6e16
--- /dev/null
+++ b/basis/prettyprint/custom/custom-docs.factor
@@ -0,0 +1,9 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel help.markup help.syntax ;
+IN: prettyprint.custom
+
+HELP: pprint*
+{ $values { "obj" object } }
+{ $contract "Adds sections to the current block corresponding to the prettyprinted representation of the object." }
+$prettyprinting-note ;
diff --git a/basis/prettyprint/custom/custom.factor b/basis/prettyprint/custom/custom.factor
new file mode 100644
index 0000000000..9fd940ce0f
--- /dev/null
+++ b/basis/prettyprint/custom/custom.factor
@@ -0,0 +1,9 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: prettyprint.custom
+
+GENERIC: pprint* ( obj -- )
+GENERIC: pprint-object ( obj -- )
+GENERIC: pprint-delims ( obj -- start end )
+GENERIC: >pprint-sequence ( obj -- seq )
+GENERIC: pprint-narrow? ( obj -- ? )
diff --git a/basis/prettyprint/prettyprint-docs.factor b/basis/prettyprint/prettyprint-docs.factor
index 3c004e5b30..46d4e6e5ff 100644
--- a/basis/prettyprint/prettyprint-docs.factor
+++ b/basis/prettyprint/prettyprint-docs.factor
@@ -1,4 +1,4 @@
-USING: prettyprint.backend prettyprint.config
+USING: prettyprint.backend prettyprint.config prettyprint.custom
prettyprint.sections prettyprint.private help.markup help.syntax
io kernel words definitions quotations strings generic classes ;
IN: prettyprint
diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor
index 7c4de1e973..9d5af9e6a5 100644
--- a/basis/prettyprint/prettyprint.factor
+++ b/basis/prettyprint/prettyprint.factor
@@ -2,12 +2,13 @@
! See http://factorcode.org/license.txt for BSD license.
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 parser ;
+vectors words prettyprint.backend prettyprint.custom
+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 parser summary ;
IN: prettyprint
: make-pprint ( obj quot -- block in use )
@@ -231,6 +232,8 @@ M: pathname synopsis* pprint* ;
[ synopsis* ] with-in
] with-string-writer ;
+M: word summary synopsis ;
+
: synopsis-alist ( definitions -- alist )
[ dup synopsis swap ] { } map>assoc ;
diff --git a/basis/qualified/qualified.factor b/basis/qualified/qualified.factor
index 25d04ed929..2cd64e90bf 100644
--- a/basis/qualified/qualified.factor
+++ b/basis/qualified/qualified.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2007, 2008 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences assocs hashtables parser lexer
-vocabs words namespaces vocabs.loader debugger sets fry ;
+vocabs words namespaces vocabs.loader sets fry ;
IN: qualified
: define-qualified ( vocab-name prefix-name -- )
diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor
index b41e4d271e..c615719cc4 100644
--- a/basis/regexp/regexp.factor
+++ b/basis/regexp/regexp.factor
@@ -1,10 +1,10 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators kernel math sequences strings
-sets assocs prettyprint.backend make lexer namespaces parser
-arrays fry regexp.backend regexp.utils regexp.parser regexp.nfa
-regexp.dfa regexp.traversal regexp.transition-tables splitting
-sorting ;
+USING: accessors combinators kernel math sequences strings sets
+assocs prettyprint.backend prettyprint.custom make lexer
+namespaces parser arrays fry regexp.backend regexp.utils
+regexp.parser regexp.nfa regexp.dfa regexp.traversal
+regexp.transition-tables splitting sorting ;
IN: regexp
: default-regexp ( string -- regexp )
diff --git a/basis/specialized-arrays/functor/functor.factor b/basis/specialized-arrays/functor/functor.factor
index 52977dc22a..2894649428 100644
--- a/basis/specialized-arrays/functor/functor.factor
+++ b/basis/specialized-arrays/functor/functor.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: functors sequences sequences.private prettyprint.backend
+USING: functors sequences sequences.private prettyprint.custom
kernel words classes math parser alien.c-types byte-arrays
accessors summary ;
IN: specialized-arrays.functor
diff --git a/basis/specialized-vectors/functor/functor.factor b/basis/specialized-vectors/functor/functor.factor
index 0628f8b484..8ba5354dc4 100644
--- a/basis/specialized-vectors/functor/functor.factor
+++ b/basis/specialized-vectors/functor/functor.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: functors sequences sequences.private growable
-prettyprint.backend kernel words classes math parser ;
+prettyprint.custom kernel words classes math parser ;
IN: specialized-vectors.functor
FUNCTOR: define-vector ( T -- )
diff --git a/basis/stack-checker/backend/backend.factor b/basis/stack-checker/backend/backend.factor
index 7f8c920b19..147749864d 100644
--- a/basis/stack-checker/backend/backend.factor
+++ b/basis/stack-checker/backend/backend.factor
@@ -1,12 +1,12 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: fry arrays generic io io.streams.string kernel math
-namespaces parser prettyprint sequences strings vectors words
-quotations effects classes continuations debugger assocs
-combinators compiler.errors accessors math.order definitions
-sets generic.standard.engines.tuple hints stack-checker.state
-stack-checker.visitor stack-checker.errors
-stack-checker.values stack-checker.recursive-state ;
+namespaces parser sequences strings vectors words quotations
+effects classes continuations assocs combinators
+compiler.errors accessors math.order definitions sets
+generic.standard.engines.tuple hints stack-checker.state
+stack-checker.visitor stack-checker.errors stack-checker.values
+stack-checker.recursive-state ;
IN: stack-checker.backend
: push-d ( obj -- ) meta-d push ;
diff --git a/basis/stack-checker/errors/errors.factor b/basis/stack-checker/errors/errors.factor
index 5b6b3c0893..58944e7bc4 100644
--- a/basis/stack-checker/errors/errors.factor
+++ b/basis/stack-checker/errors/errors.factor
@@ -1,8 +1,7 @@
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel generic sequences prettyprint io words arrays
-summary effects debugger assocs accessors namespaces
-compiler.errors stack-checker.values
+USING: kernel generic sequences io words arrays summary effects
+assocs accessors namespaces compiler.errors stack-checker.values
stack-checker.recursive-state ;
IN: stack-checker.errors
@@ -10,8 +9,6 @@ TUPLE: inference-error error type word ;
M: inference-error compiler-error-type type>> ;
-M: inference-error error-help error>> error-help ;
-
: (inference-error) ( ... class type -- * )
[ boa ] dip
recursive-state get word>>
@@ -23,14 +20,8 @@ M: inference-error error-help error>> error-help ;
: inference-warning ( ... class -- * )
+warning+ (inference-error) ; inline
-M: inference-error error.
- [ word>> [ "In word: " write . ] when* ] [ error>> error. ] bi ;
-
TUPLE: literal-expected ;
-M: literal-expected summary
- drop "Literal value expected" ;
-
M: object (literal) \ literal-expected inference-warning ;
TUPLE: unbalanced-branches-error branches quots ;
@@ -38,79 +29,25 @@ TUPLE: unbalanced-branches-error branches quots ;
: unbalanced-branches-error ( branches quots -- * )
\ unbalanced-branches-error inference-error ;
-M: unbalanced-branches-error error.
- "Unbalanced branches:" print
- [ quots>> ] [ branches>> [ length <effect> ] { } assoc>map ] bi zip
- [ [ first pprint-short bl ] [ second effect>string print ] bi ] each ;
-
TUPLE: too-many->r ;
-M: too-many->r summary
- drop
- "Quotation pushes elements on retain stack without popping them" ;
-
TUPLE: too-many-r> ;
-M: too-many-r> summary
- drop
- "Quotation pops retain stack elements which it did not push" ;
-
TUPLE: missing-effect word ;
-M: missing-effect error.
- "The word " write
- word>> pprint
- " must declare a stack effect" print ;
-
TUPLE: effect-error word inferred declared ;
: effect-error ( word inferred declared -- * )
\ effect-error inference-error ;
-M: effect-error error.
- "Stack effects of the word " write
- [ word>> pprint " do not match." print ]
- [ "Inferred: " write inferred>> . ]
- [ "Declared: " write declared>> . ] tri ;
-
TUPLE: recursive-quotation-error quot ;
-M: recursive-quotation-error error.
- "The quotation " write
- quot>> pprint
- " calls itself." print
- "Stack effect inference is undecidable when quotation-level recursion is permitted." print ;
-
TUPLE: undeclared-recursion-error word ;
-M: undeclared-recursion-error error.
- "The inline recursive word " write
- word>> pprint
- " must be declared recursive" print ;
-
TUPLE: diverging-recursion-error word ;
-M: diverging-recursion-error error.
- "The recursive word " write
- word>> pprint
- " digs arbitrarily deep into the stack" print ;
-
TUPLE: unbalanced-recursion-error word height ;
-M: unbalanced-recursion-error error.
- "The recursive word " write
- word>> pprint
- " leaves with the stack having the wrong height" print ;
-
TUPLE: inconsistent-recursive-call-error word ;
-M: inconsistent-recursive-call-error error.
- "The recursive word " write
- word>> pprint
- " calls itself with a different set of quotation parameters than were input" print ;
-
TUPLE: unknown-primitive-error ;
-
-M: unknown-primitive-error error.
- drop
- "Cannot determine stack effect statically" print ;
diff --git a/basis/stack-checker/errors/prettyprint/prettyprint.factor b/basis/stack-checker/errors/prettyprint/prettyprint.factor
new file mode 100644
index 0000000000..21c6d64402
--- /dev/null
+++ b/basis/stack-checker/errors/prettyprint/prettyprint.factor
@@ -0,0 +1,67 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel prettyprint io debugger
+sequences assocs stack-checker.errors summary effects ;
+IN: stack-checker.errors.prettyprint
+
+M: inference-error error-help error>> error-help ;
+
+M: inference-error error.
+ [ word>> [ "In word: " write . ] when* ] [ error>> error. ] bi ;
+
+M: literal-expected summary
+ drop "Literal value expected" ;
+
+M: unbalanced-branches-error error.
+ "Unbalanced branches:" print
+ [ quots>> ] [ branches>> [ length <effect> ] { } assoc>map ] bi zip
+ [ [ first pprint-short bl ] [ second effect>string print ] bi ] each ;
+
+M: too-many->r summary
+ drop
+ "Quotation pushes elements on retain stack without popping them" ;
+
+M: too-many-r> summary
+ drop
+ "Quotation pops retain stack elements which it did not push" ;
+
+M: missing-effect error.
+ "The word " write
+ word>> pprint
+ " must declare a stack effect" print ;
+
+M: effect-error error.
+ "Stack effects of the word " write
+ [ word>> pprint " do not match." print ]
+ [ "Inferred: " write inferred>> . ]
+ [ "Declared: " write declared>> . ] tri ;
+
+M: recursive-quotation-error error.
+ "The quotation " write
+ quot>> pprint
+ " calls itself." print
+ "Stack effect inference is undecidable when quotation-level recursion is permitted." print ;
+
+M: undeclared-recursion-error error.
+ "The inline recursive word " write
+ word>> pprint
+ " must be declared recursive" print ;
+
+M: diverging-recursion-error error.
+ "The recursive word " write
+ word>> pprint
+ " digs arbitrarily deep into the stack" print ;
+
+M: unbalanced-recursion-error error.
+ "The recursive word " write
+ word>> pprint
+ " leaves with the stack having the wrong height" print ;
+
+M: inconsistent-recursive-call-error error.
+ "The recursive word " write
+ word>> pprint
+ " calls itself with a different set of quotation parameters than were input" print ;
+
+M: unknown-primitive-error error.
+ drop
+ "Cannot determine stack effect statically" print ;
diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor
index 28634f2d44..0442d4c227 100644
--- a/basis/stack-checker/known-words/known-words.factor
+++ b/basis/stack-checker/known-words/known-words.factor
@@ -5,7 +5,7 @@ classes sequences.private continuations.private effects generic
hashtables hashtables.private io io.backend io.files
io.files.private io.streams.c kernel kernel.private math
math.private memory namespaces namespaces.private parser
-prettyprint quotations quotations.private sbufs sbufs.private
+quotations quotations.private sbufs sbufs.private
sequences sequences.private slots.private strings
strings.private system threads.private classes.tuple
classes.tuple.private vectors vectors.private words definitions
diff --git a/basis/summary/summary.factor b/basis/summary/summary.factor
index ea2c19fd6d..44e5374dc5 100644
--- a/basis/summary/summary.factor
+++ b/basis/summary/summary.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors classes sequences splitting kernel namespaces
-make words math math.parser io.styles prettyprint assocs ;
+USING: accessors classes sequences kernel namespaces
+make words math math.parser assocs ;
IN: summary
GENERIC: summary ( object -- string )
@@ -11,15 +11,6 @@ GENERIC: summary ( object -- string )
M: object summary object-summary ;
-M: input summary
- [
- "Input: " %
- string>> "\n" split1 swap %
- "..." "" ? %
- ] "" make ;
-
-M: word summary synopsis ;
-
M: sequence summary
[
dup class name>> %
diff --git a/basis/tools/deploy/backend/backend.factor b/basis/tools/deploy/backend/backend.factor
index 18713c7b0c..f33e4840eb 100644
--- a/basis/tools/deploy/backend/backend.factor
+++ b/basis/tools/deploy/backend/backend.factor
@@ -5,8 +5,8 @@ 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 ;
+words.private tools.deploy.config tools.deploy.config.editor
+bootstrap.image io.encodings.utf8 destructors accessors ;
IN: tools.deploy.backend
: copy-vm ( executable bundle-name extension -- vm )
@@ -88,6 +88,10 @@ DEFER: ?make-staging-image
dup staging-image-name exists?
[ drop ] [ make-staging-image ] if ;
+: make-deploy-config ( vocab -- file )
+ [ deploy-config unparse-use ] [ "deploy-config-" prepend ] bi
+ [ utf8 set-file-contents ] keep ;
+
: deploy-command-line ( image vocab config -- flags )
[
bootstrap-profile ?make-staging-image
@@ -99,7 +103,8 @@ DEFER: ?make-staging-image
"-run=tools.deploy.shaker" ,
- "-deploy-vocab=" prepend ,
+ [ "-deploy-vocab=" prepend , ]
+ [ make-deploy-config "-deploy-config=" prepend , ] bi
"-output-image=" prepend ,
diff --git a/basis/tools/deploy/config/config-docs.factor b/basis/tools/deploy/config/config-docs.factor
index e8dcd2b90e..c8249e4e41 100644
--- a/basis/tools/deploy/config/config-docs.factor
+++ b/basis/tools/deploy/config/config-docs.factor
@@ -2,16 +2,6 @@ USING: help.markup help.syntax words alien.c-types assocs
kernel math ;
IN: tools.deploy.config
-ARTICLE: "deploy-config" "Deployment configuration"
-"The deployment configuration is a key/value mapping stored in the " { $snippet "deploy.factor" } " file in the vocabulary's directory. If this file does not exist, the default deployment configuration is used:"
-{ $subsection default-config }
-"The deployment configuration can be read and written with a pair of words:"
-{ $subsection deploy-config }
-{ $subsection set-deploy-config }
-"A utility word is provided to load the configuration, change a flag, and store it back to disk:"
-{ $subsection set-deploy-flag }
-"The " { $link "ui.tools.deploy" } " provides a graphical way of editing the configuration." ;
-
ARTICLE: "deploy-flags" "Deployment flags"
"There are two sets of deployment flags. The first set controls the major subsystems which are to be included in the deployment image:"
{ $subsection deploy-math? }
@@ -25,12 +15,7 @@ ARTICLE: "deploy-flags" "Deployment flags"
{ $subsection deploy-word-props? }
{ $subsection deploy-c-types? } ;
-ARTICLE: "prepare-deploy" "Preparing to deploy an application"
-"In order to deploy an application as a stand-alone image, the application's vocabulary must first be given a " { $link POSTPONE: MAIN: } " hook. Then, a " { $emphasis "deployment configuration" } " must be created."
-{ $subsection "deploy-config" }
-{ $subsection "deploy-flags" } ;
-
-ABOUT: "prepare-deploy"
+ABOUT: "deploy-flags"
HELP: deploy-name
{ $description "Deploy setting. The name of the executable."
@@ -114,15 +99,3 @@ HELP: deploy-reflection
HELP: default-config
{ $values { "vocab" "a vocabulary specifier" } { "assoc" assoc } }
{ $description "Outputs the default deployment configuration for a vocabulary." } ;
-
-HELP: deploy-config
-{ $values { "vocab" "a vocabulary specifier" } { "assoc" assoc } }
-{ $description "Loads a vocabulary's deployment configuration from the " { $snippet "deploy.factor" } " file in the vocabulary's directory. If the file does not exist, the " { $link default-config } " is output." } ;
-
-HELP: set-deploy-config
-{ $values { "assoc" assoc } { "vocab" "a vocabulary specifier" } }
-{ $description "Stores a vocabulary's deployment configuration to the " { $snippet "deploy.factor" } " file in the vocabulary's directory." } ;
-
-HELP: set-deploy-flag
-{ $values { "value" object } { "key" object } { "vocab" "a vocabulary specifier" } }
-{ $description "Modifies an entry in a vocabulary's deployment configuration on disk." } ;
diff --git a/basis/tools/deploy/config/config.factor b/basis/tools/deploy/config/config.factor
index 84bfab682b..1d9761e885 100644
--- a/basis/tools/deploy/config/config.factor
+++ b/basis/tools/deploy/config/config.factor
@@ -1,8 +1,7 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: vocabs.loader io.files io kernel sequences assocs
-splitting parser prettyprint namespaces math vocabs
-hashtables tools.vocabs ;
+USING: io.files io kernel sequences assocs splitting parser
+namespaces math vocabs hashtables ;
IN: tools.deploy.config
SYMBOL: deploy-name
@@ -66,18 +65,3 @@ SYMBOL: deploy-image
! default value for deploy.macosx
{ "stop-after-last-window?" t }
} assoc-union ;
-
-: deploy-config-path ( vocab -- string )
- vocab-dir "deploy.factor" append-path ;
-
-: deploy-config ( vocab -- assoc )
- dup default-config swap
- dup deploy-config-path vocab-file-contents
- parse-fresh [ first assoc-union ] unless-empty ;
-
-: set-deploy-config ( assoc vocab -- )
- [ unparse-use string-lines ] dip
- dup deploy-config-path set-vocab-file-contents ;
-
-: set-deploy-flag ( value key vocab -- )
- [ deploy-config [ set-at ] keep ] keep set-deploy-config ;
diff --git a/basis/tools/deploy/config/editor/editor-docs.factor b/basis/tools/deploy/config/editor/editor-docs.factor
new file mode 100644
index 0000000000..b677d37f95
--- /dev/null
+++ b/basis/tools/deploy/config/editor/editor-docs.factor
@@ -0,0 +1,27 @@
+USING: assocs help.markup help.syntax kernel
+tools.deploy.config ;
+IN: tools.deploy.config.editor
+
+ARTICLE: "deploy-config" "Deployment configuration"
+"The deployment configuration is a key/value mapping stored in the " { $snippet "deploy.factor" } " file in the vocabulary's directory. If this file does not exist, the default deployment configuration is used:"
+{ $subsection default-config }
+"The deployment configuration can be read and written with a pair of words:"
+{ $subsection deploy-config }
+{ $subsection set-deploy-config }
+"A utility word is provided to load the configuration, change a flag, and store it back to disk:"
+{ $subsection set-deploy-flag }
+"The " { $link "ui.tools.deploy" } " provides a graphical way of editing the configuration." ;
+
+HELP: deploy-config
+{ $values { "vocab" "a vocabulary specifier" } { "assoc" assoc } }
+{ $description "Loads a vocabulary's deployment configuration from the " { $snippet "deploy.factor" } " file in the vocabulary's directory. If the file does not exist, the " { $link default-config } " is output." } ;
+
+HELP: set-deploy-config
+{ $values { "assoc" assoc } { "vocab" "a vocabulary specifier" } }
+{ $description "Stores a vocabulary's deployment configuration to the " { $snippet "deploy.factor" } " file in the vocabulary's directory." } ;
+
+HELP: set-deploy-flag
+{ $values { "value" object } { "key" object } { "vocab" "a vocabulary specifier" } }
+{ $description "Modifies an entry in a vocabulary's deployment configuration on disk." } ;
+
+ABOUT: "deploy-config"
diff --git a/basis/tools/deploy/config/editor/editor.factor b/basis/tools/deploy/config/editor/editor.factor
new file mode 100644
index 0000000000..2b5788adfc
--- /dev/null
+++ b/basis/tools/deploy/config/editor/editor.factor
@@ -0,0 +1,20 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs io.files kernel parser prettyprint sequences
+splitting tools.deploy.config tools.vocabs vocabs.loader ;
+IN: tools.deploy.config.editor
+
+: deploy-config-path ( vocab -- string )
+ vocab-dir "deploy.factor" append-path ;
+
+: deploy-config ( vocab -- assoc )
+ dup default-config swap
+ dup deploy-config-path vocab-file-contents
+ parse-fresh [ first assoc-union ] unless-empty ;
+
+: set-deploy-config ( assoc vocab -- )
+ [ unparse-use string-lines ] dip
+ dup deploy-config-path set-vocab-file-contents ;
+
+: set-deploy-flag ( value key vocab -- )
+ [ deploy-config [ set-at ] keep ] keep set-deploy-config ;
diff --git a/basis/tools/deploy/deploy-docs.factor b/basis/tools/deploy/deploy-docs.factor
index eccb3982c7..00e747cf00 100644
--- a/basis/tools/deploy/deploy-docs.factor
+++ b/basis/tools/deploy/deploy-docs.factor
@@ -2,6 +2,11 @@ USING: help.markup help.syntax words alien.c-types assocs
kernel ;
IN: tools.deploy
+ARTICLE: "prepare-deploy" "Preparing to deploy an application"
+"In order to deploy an application as a stand-alone image, the application's vocabulary must first be given a " { $link POSTPONE: MAIN: } " hook. Then, a " { $emphasis "deployment configuration" } " must be created."
+{ $subsection "deploy-config" }
+{ $subsection "deploy-flags" } ;
+
ARTICLE: "tools.deploy" "Application deployment"
"The stand-alone application deployment tool compiles a vocabulary down to a native executable which runs the vocabulary's " { $link POSTPONE: MAIN: } " hook. Deployed executables do not depend on Factor being installed, and do not expose any source code, and thus are suitable for delivering commercial end-user applications."
$nl
diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index 15fd2a37d7..01cc80e90d 100755
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -1,11 +1,11 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors qualified io.backend io.streams.c init fry
-namespaces make assocs kernel parser lexer strings.parser
-tools.deploy.config vocabs sequences words words.private memory
-kernel.private continuations io prettyprint vocabs.loader
-debugger system strings sets vectors quotations byte-arrays
-sorting compiler.units definitions generic generic.standard ;
+namespaces make assocs kernel parser lexer strings.parser vocabs
+sequences words words.private memory kernel.private
+continuations io vocabs.loader system strings sets
+vectors quotations byte-arrays sorting compiler.units
+definitions generic generic.standard tools.deploy.config ;
QUALIFIED: bootstrap.stage2
QUALIFIED: classes
QUALIFIED: command-line
@@ -14,7 +14,6 @@ QUALIFIED: continuations
QUALIFIED: definitions
QUALIFIED: init
QUALIFIED: layouts
-QUALIFIED: prettyprint.config
QUALIFIED: source-files
QUALIFIED: vocabs
IN: tools.deploy.shaker
@@ -41,7 +40,7 @@ IN: tools.deploy.shaker
] when ;
: strip-debugger ( -- )
- strip-debugger? [
+ strip-debugger? "debugger" vocab and [
"Stripping debugger" show
"resource:basis/tools/deploy/shaker/strip-debugger.factor"
run-file
@@ -81,14 +80,11 @@ IN: tools.deploy.shaker
>alist f like
] change-props drop
] each
- ] [
- "Remaining word properties:\n" show
- [ props>> keys ] gather unparse show
] [
H{ } clone '[
[ [ _ [ ] cache ] map ] change-props drop
] each
- ] tri ;
+ ] bi ;
: stripped-word-props ( -- seq )
[
@@ -275,12 +271,7 @@ IN: tools.deploy.shaker
] when
strip-prettyprint? [
- {
- prettyprint.config:margin
- prettyprint.config:string-limit?
- prettyprint.config:boa-tuples?
- prettyprint.config:tab-size
- } %
+ { } { "prettyprint.config" } strip-vocab-globals %
] when
strip-debugger? [
@@ -308,7 +299,6 @@ IN: tools.deploy.shaker
'[ drop _ member? not ] assoc-filter
[ drop string? not ] assoc-filter ! strip CLI args
sift-assoc
- dup keys unparse show
21 setenv
] [ drop ] if ;
@@ -362,7 +352,7 @@ SYMBOL: deploy-vocab
init-hooks get values concat %
,
strip-io? [ \ flush , ] unless
- ] [ ] make "Boot quotation: " show dup unparse show
+ ] [ ] make
set-boot-quot ;
: init-stripper ( -- )
@@ -405,16 +395,14 @@ SYMBOL: deploy-vocab
deploy-vocab get require
strip
finish-deploy
- ] [
- print-error flush 1 exit
- ] recover
+ ] [ die 1 exit ] recover
] bind ;
: do-deploy ( -- )
"output-image" get
"deploy-vocab" get
"Deploying " write dup write "..." print
- dup deploy-config dup .
+ "deploy-config" get parse-file first
(deploy) ;
MAIN: do-deploy
diff --git a/basis/tools/disassembler/disassembler-tests.factor b/basis/tools/disassembler/disassembler-tests.factor
index 782f244c68..96f5a04378 100644
--- a/basis/tools/disassembler/disassembler-tests.factor
+++ b/basis/tools/disassembler/disassembler-tests.factor
@@ -1,6 +1,6 @@
IN: tools.disassembler.tests
-USING: math classes.tuple prettyprint.backend tools.disassembler
-tools.test strings ;
+USING: math classes.tuple prettyprint.custom
+tools.disassembler tools.test strings ;
[ ] [ \ + disassemble ] unit-test
[ ] [ { string pprint* } disassemble ] unit-test
diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor
index c0fb1695c3..5f6d04a54f 100644
--- a/basis/urls/urls.factor
+++ b/basis/urls/urls.factor
@@ -2,9 +2,9 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel ascii combinators combinators.short-circuit
sequences splitting fry namespaces make assocs arrays strings
-io.sockets io.encodings.string
-io.encodings.utf8 math math.parser accessors parser
-strings.parser lexer prettyprint.backend hashtables present
+io.sockets io.encodings.string io.encodings.utf8 math
+math.parser accessors parser strings.parser lexer
+prettyprint.backend prettyprint.custom hashtables present
peg.ebnf urls.encoding ;
IN: urls
diff --git a/basis/vlists/vlists.factor b/basis/vlists/vlists.factor
index e0f7e55554..ea40594964 100644
--- a/basis/vlists/vlists.factor
+++ b/basis/vlists/vlists.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays accessors sequences sequences.private
persistent.sequences assocs persistent.assocs kernel math
-vectors parser prettyprint.backend ;
+vectors parser prettyprint.custom ;
IN: vlists
TUPLE: vlist
diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index f90ba23999..42e1de19ee 100644
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -68,7 +68,6 @@ bootstrapping? on
"alien.accessors"
"arrays"
"byte-arrays"
- "byte-vectors"
"classes.private"
"classes.tuple"
"classes.tuple.private"
diff --git a/core/bootstrap/stage1.factor b/core/bootstrap/stage1.factor
index 26a27ecefb..874a9dd0d2 100644
--- a/core/bootstrap/stage1.factor
+++ b/core/bootstrap/stage1.factor
@@ -31,7 +31,7 @@ load-help? off
"math.integers" require
"math.floats" require
"memory" require
-
+
"io.streams.c" require
"vocabs.loader" require
diff --git a/core/bootstrap/syntax.factor b/core/bootstrap/syntax.factor
index e7dd333ed8..badc1f5218 100644
--- a/core/bootstrap/syntax.factor
+++ b/core/bootstrap/syntax.factor
@@ -16,7 +16,6 @@ IN: bootstrap.syntax
"<PRIVATE"
"BIN:"
"B{"
- "BV{"
"C:"
"CHAR:"
"DEFER:"
diff --git a/core/checksums/checksums.factor b/core/checksums/checksums.factor
index 4b0d9e5072..699d93b8b4 100644
--- a/core/checksums/checksums.factor
+++ b/core/checksums/checksums.factor
@@ -1,7 +1,7 @@
! Copyright (c) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: sequences math.parser io io.streams.byte-array
-io.encodings.binary io.files kernel ;
+USING: sequences math.parser io io.encodings.binary io.files
+kernel ;
IN: checksums
MIXIN: checksum
@@ -12,9 +12,6 @@ GENERIC: checksum-stream ( stream checksum -- value )
GENERIC: checksum-lines ( lines checksum -- value )
-M: checksum checksum-bytes
- [ binary <byte-reader> ] dip checksum-stream ;
-
M: checksum checksum-stream
[ contents ] dip checksum-bytes ;
diff --git a/core/classes/algebra/algebra-docs.factor b/core/classes/algebra/algebra-docs.factor
index 810bdbe10f..2730e4683b 100644
--- a/core/classes/algebra/algebra-docs.factor
+++ b/core/classes/algebra/algebra-docs.factor
@@ -4,6 +4,7 @@ IN: classes.algebra
ARTICLE: "class-operations" "Class operations"
"Set-theoretic operations on classes:"
+{ $subsection class= }
{ $subsection class< }
{ $subsection class<= }
{ $subsection class-and }
diff --git a/core/growable/growable-docs.factor b/core/growable/growable-docs.factor
index 9f950aa36c..e1ab50cdcd 100644
--- a/core/growable/growable-docs.factor
+++ b/core/growable/growable-docs.factor
@@ -14,7 +14,7 @@ $nl
}
"The underlying sequence must implement a generic word:"
{ $subsection resize }
-{ $link "vectors" } ", " { $link "byte-vectors" } " and " { $link "sbufs" } " are implemented using the resizable sequence facility." ;
+{ $link "vectors" } " and " { $link "sbufs" } " are implemented using the resizable sequence facility." ;
ABOUT: "growable"
diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor
index c951750b34..0b7d9d008f 100644
--- a/core/syntax/syntax.factor
+++ b/core/syntax/syntax.factor
@@ -1,14 +1,13 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien arrays byte-arrays byte-vectors
-definitions generic hashtables kernel math namespaces parser
-lexer sequences strings strings.parser sbufs vectors
-words quotations io assocs splitting classes.tuple
-generic.standard generic.math generic.parser classes io.files
-vocabs classes.parser classes.union
-classes.intersection classes.mixin classes.predicate
-classes.singleton classes.tuple.parser compiler.units
-combinators effects.parser slots ;
+USING: accessors alien arrays byte-arrays definitions generic
+hashtables kernel math namespaces parser lexer sequences strings
+strings.parser sbufs vectors words quotations io assocs
+splitting classes.tuple generic.standard generic.math
+generic.parser classes io.files vocabs classes.parser
+classes.union classes.intersection classes.mixin
+classes.predicate classes.singleton classes.tuple.parser
+compiler.units combinators effects.parser slots ;
IN: bootstrap.syntax
! These words are defined as a top-level form, instead of with
@@ -81,7 +80,6 @@ IN: bootstrap.syntax
"{" [ \ } [ >array ] parse-literal ] define-syntax
"V{" [ \ } [ >vector ] parse-literal ] define-syntax
"B{" [ \ } [ >byte-array ] parse-literal ] define-syntax
- "BV{" [ \ } [ >byte-vector ] parse-literal ] define-syntax
"H{" [ \ } [ >hashtable ] parse-literal ] define-syntax
"T{" [ parse-tuple-literal parsed ] define-syntax
"W{" [ \ } [ first <wrapper> ] parse-literal ] define-syntax
From 6edb771d05ec2626b53196816d419451f93b82d6 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 16:01:11 -0600
Subject: [PATCH 08/46] Re-arrange some code so that core-foundation.run-loop
no longer depends on calendar
---
basis/core-foundation/run-loop/run-loop.factor | 11 +----------
basis/core-foundation/run-loop/thread/thread.factor | 10 +++++++++-
2 files changed, 10 insertions(+), 11 deletions(-)
diff --git a/basis/core-foundation/run-loop/run-loop.factor b/basis/core-foundation/run-loop/run-loop.factor
index c334297122..39f4101301 100644
--- a/basis/core-foundation/run-loop/run-loop.factor
+++ b/basis/core-foundation/run-loop/run-loop.factor
@@ -1,7 +1,6 @@
! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel threads init namespaces alien
-core-foundation calendar ;
+USING: alien alien.syntax core-foundation kernel namespaces ;
IN: core-foundation.run-loop
: kCFRunLoopRunFinished 1 ; inline
@@ -40,11 +39,3 @@ FUNCTION: void CFRunLoopAddSource (
"kCFRunLoopDefaultMode" <CFString>
dup \ CFRunLoopDefaultMode set-global
] when ;
-
-: run-loop-thread ( -- )
- CFRunLoopDefaultMode 0 f CFRunLoopRunInMode
- kCFRunLoopRunHandledSource = [ 1 seconds sleep ] unless
- run-loop-thread ;
-
-: start-run-loop-thread ( -- )
- [ run-loop-thread t ] "CFRunLoop dispatcher" spawn-server drop ;
diff --git a/basis/core-foundation/run-loop/thread/thread.factor b/basis/core-foundation/run-loop/thread/thread.factor
index 326226ec0e..aeeff312cb 100644
--- a/basis/core-foundation/run-loop/thread/thread.factor
+++ b/basis/core-foundation/run-loop/thread/thread.factor
@@ -1,8 +1,16 @@
! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: init core-foundation.run-loop ;
+USING: calendar core-foundation.run-loop init kernel threads ;
IN: core-foundation.run-loop.thread
! Load this vocabulary if you need a run loop running.
+: run-loop-thread ( -- )
+ CFRunLoopDefaultMode 0 f CFRunLoopRunInMode
+ kCFRunLoopRunHandledSource = [ 1 seconds sleep ] unless
+ run-loop-thread ;
+
+: start-run-loop-thread ( -- )
+ [ run-loop-thread t ] "CFRunLoop dispatcher" spawn-server drop ;
+
[ start-run-loop-thread ] "core-foundation.run-loop.thread" add-init-hook
From ba6f63ff56a6bc5bfa2150a599384f155c3b106e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 16:02:10 -0600
Subject: [PATCH 09/46] calendar.format now depends on present instead of the
other way around
---
basis/calendar/format/format.factor | 11 +++++++----
basis/present/present.factor | 5 +----
2 files changed, 8 insertions(+), 8 deletions(-)
diff --git a/basis/calendar/format/format.factor b/basis/calendar/format/format.factor
index 8d34e8a3a4..a7c4410aa5 100644
--- a/basis/calendar/format/format.factor
+++ b/basis/calendar/format/format.factor
@@ -1,7 +1,8 @@
-USING: math math.order math.parser math.functions kernel sequences io
-accessors arrays io.streams.string splitting
-combinators accessors debugger
-calendar calendar.format.macros ;
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: math math.order math.parser math.functions kernel
+sequences io accessors arrays io.streams.string splitting
+combinators accessors calendar calendar.format.macros present ;
IN: calendar.format
: pad-00 ( n -- str ) number>string 2 CHAR: 0 pad-left ;
@@ -288,3 +289,5 @@ ERROR: invalid-timestamp-format ;
]
} formatted
] with-string-writer ;
+
+M: timestamp present timestamp>string ;
diff --git a/basis/present/present.factor b/basis/present/present.factor
index 519e995fe5..fe7025d559 100644
--- a/basis/present/present.factor
+++ b/basis/present/present.factor
@@ -1,15 +1,12 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors math math.parser calendar calendar.format
-strings words kernel effects ;
+USING: accessors math math.parser strings words kernel effects ;
IN: present
GENERIC: present ( object -- string )
M: real present number>string ;
-M: timestamp present timestamp>string ;
-
M: string present ;
M: word present name>> ;
From 7940020491f4bc1afa86ab9c14c3d339e5c13dbe Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 16:02:31 -0600
Subject: [PATCH 10/46] Untangling more dependencies
---
basis/alarms/alarms.factor | 2 +-
basis/bootstrap/threads/threads.factor | 6 +++-
basis/cocoa/application/application.factor | 6 ++--
basis/cocoa/messages/messages.factor | 36 ++++---------------
basis/functors/functors.factor | 10 +++---
basis/help/handbook/handbook.factor | 4 +--
.../known-words/known-words.factor | 2 +-
basis/tools/cocoa/cocoa.factor | 16 +++++++++
basis/tools/cocoa/tags.txt | 1 +
basis/tools/deploy/backend/backend.factor | 3 +-
basis/tools/deploy/deploy-tests.factor | 4 +++
basis/tools/deploy/macosx/macosx.factor | 11 +++---
basis/tools/deploy/shaker/strip-cocoa.factor | 5 ---
basis/ui/cocoa/cocoa.factor | 11 +++---
basis/ui/tools/deploy/deploy.factor | 10 +++---
basis/unix/debugger/debugger.factor | 18 ++++++++++
basis/unix/unix.factor | 22 ++++--------
core/source-files/source-files.factor | 2 +-
18 files changed, 90 insertions(+), 79 deletions(-)
create mode 100644 basis/tools/cocoa/cocoa.factor
create mode 100644 basis/tools/cocoa/tags.txt
create mode 100644 basis/unix/debugger/debugger.factor
diff --git a/basis/alarms/alarms.factor b/basis/alarms/alarms.factor
index ad1838b3df..9cc05b4159 100644
--- a/basis/alarms/alarms.factor
+++ b/basis/alarms/alarms.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays calendar combinators generic init
-kernel math namespaces sequences heaps boxes threads debugger
+kernel math namespaces sequences heaps boxes threads
quotations assocs math.order ;
IN: alarms
diff --git a/basis/bootstrap/threads/threads.factor b/basis/bootstrap/threads/threads.factor
index 6c30489bb4..8b751f8458 100644
--- a/basis/bootstrap/threads/threads.factor
+++ b/basis/bootstrap/threads/threads.factor
@@ -1,7 +1,11 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
+USING: vocabs vocabs.loader kernel ;
IN: bootstrap.threads
USE: io.thread
USE: threads
-USE: debugger.threads
+
+"debugger" vocab [
+ "debugger.threads" require
+] when
diff --git a/basis/cocoa/application/application.factor b/basis/cocoa/application/application.factor
index ab12a93a31..e2c853ea77 100644
--- a/basis/cocoa/application/application.factor
+++ b/basis/cocoa/application/application.factor
@@ -1,9 +1,9 @@
-! Copyright (C) 2006, 2007 Slava Pestov
+! Copyright (C) 2006, 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.syntax io kernel namespaces core-foundation
core-foundation.run-loop cocoa.messages cocoa cocoa.classes
-cocoa.runtime sequences threads debugger init summary
-kernel.private assocs ;
+cocoa.runtime sequences threads init summary kernel.private
+assocs ;
IN: cocoa.application
: <NSString> ( str -- alien ) <CFString> -> autorelease ;
diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor
index e33217a691..5f548bdeb8 100644
--- a/basis/cocoa/messages/messages.factor
+++ b/basis/cocoa/messages/messages.factor
@@ -2,21 +2,17 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.strings arrays assocs
continuations combinators compiler compiler.alien kernel math
-namespaces make parser prettyprint prettyprint.sections
-quotations sequences strings words cocoa.runtime io macros
-memoize debugger io.encodings.ascii effects libc libc.private
-parser lexer init core-foundation fry generalizations
-specialized-arrays.direct.alien ;
+namespaces make parser quotations sequences strings words
+cocoa.runtime io macros memoize io.encodings.ascii
+effects libc libc.private parser lexer init core-foundation fry
+generalizations specialized-arrays.direct.alien ;
IN: cocoa.messages
: make-sender ( method function -- quot )
[ over first , f , , second , \ alien-invoke , ] [ ] make ;
-: sender-stub-name ( method function -- string )
- [ % "_" % unparse % ] "" make ;
-
: sender-stub ( method function -- word )
- [ sender-stub-name f <word> dup ] 2keep
+ [ "( sender-stub )" f <word> dup ] 2dip
over first large-struct? [ "_stret" append ] when
make-sender define ;
@@ -78,12 +74,8 @@ MACRO: (send) ( selector super? -- quot )
: send ( receiver args... selector -- return... ) f (send) ; inline
-\ send soft "break-after" set-word-prop
-
: super-send ( receiver args... selector -- return... ) t (send) ; inline
-\ super-send soft "break-after" set-word-prop
-
! Runtime introspection
SYMBOL: class-init-hooks
@@ -216,17 +208,6 @@ assoc-union alien>objc-types set-global
: register-objc-methods ( class -- )
[ register-objc-method ] each-method-in-class ;
-: method. ( method -- )
- {
- [ method_getName sel_getName ]
- [ method-return-type ]
- [ method-arg-types ]
- [ method_getImplementation ]
- } cleave 4array . ;
-
-: methods. ( class -- )
- [ method. ] each-method-in-class ;
-
: class-exists? ( string -- class ) objc_getClass >boolean ;
: define-objc-class-word ( quot name -- )
@@ -238,11 +219,8 @@ assoc-union alien>objc-types set-global
: import-objc-class ( name quot -- )
over define-objc-class-word
- '[
- _
- [ objc-class register-objc-methods ]
- [ objc-meta-class register-objc-methods ] bi
- ] try ;
+ [ objc-class register-objc-methods ]
+ [ objc-meta-class register-objc-methods ] bi ;
: root-class ( class -- root )
dup class_getSuperclass [ root-class ] [ ] ?if ;
diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor
index 7126806c3d..7dab80c22d 100644
--- a/basis/functors/functors.factor
+++ b/basis/functors/functors.factor
@@ -1,9 +1,9 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel locals.private quotations classes.tuple make
-combinators generic words interpolate namespaces sequences
-io.streams.string fry classes.mixin effects lexer parser
-classes.tuple.parser effects.parser ;
+USING: kernel quotations classes.tuple make combinators generic
+words interpolate namespaces sequences io.streams.string fry
+classes.mixin effects lexer parser classes.tuple.parser
+effects.parser locals.types locals.parser locals.rewrite.closures ;
IN: functors
: scan-param ( -- obj )
@@ -101,6 +101,6 @@ DEFER: ;FUNCTOR delimiter
CREATE
parse-locals
parse-functor-body swap pop-locals <lambda>
- lambda-rewrite first ;
+ rewrite-closures first ;
: FUNCTOR: (FUNCTOR:) define ; parsing
diff --git a/basis/help/handbook/handbook.factor b/basis/help/handbook/handbook.factor
index 2ed86a0a19..cc36e9faab 100644
--- a/basis/help/handbook/handbook.factor
+++ b/basis/help/handbook/handbook.factor
@@ -1,7 +1,7 @@
USING: help help.markup help.syntax help.definitions help.topics
namespaces words sequences classes assocs vocabs kernel arrays
-prettyprint.backend kernel.private io generic math system
-strings sbufs vectors byte-arrays quotations
+prettyprint.backend prettyprint.custom kernel.private io generic
+math system strings sbufs vectors byte-arrays quotations
io.streams.byte-array classes.builtin parser lexer
classes.predicate classes.union classes.intersection
classes.singleton classes.tuple tools.vocabs.browser math.parser
diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor
index 0442d4c227..a998e5394b 100644
--- a/basis/stack-checker/known-words/known-words.factor
+++ b/basis/stack-checker/known-words/known-words.factor
@@ -10,7 +10,7 @@ sequences sequences.private slots.private strings
strings.private system threads.private classes.tuple
classes.tuple.private vectors vectors.private words definitions
words.private assocs summary compiler.units system.private
-combinators locals locals.backend locals.private words.private
+combinators locals locals.backend locals.types words.private
quotations.private stack-checker.values
stack-checker.alien
stack-checker.state
diff --git a/basis/tools/cocoa/cocoa.factor b/basis/tools/cocoa/cocoa.factor
new file mode 100644
index 0000000000..a8cdf6f41c
--- /dev/null
+++ b/basis/tools/cocoa/cocoa.factor
@@ -0,0 +1,16 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays cocoa.messages cocoa.runtime combinators
+prettyprint ;
+IN: tools.cocoa
+
+: method. ( method -- )
+ {
+ [ method_getName sel_getName ]
+ [ method-return-type ]
+ [ method-arg-types ]
+ [ method_getImplementation ]
+ } cleave 4array . ;
+
+: methods. ( class -- )
+ [ method. ] each-method-in-class ;
diff --git a/basis/tools/cocoa/tags.txt b/basis/tools/cocoa/tags.txt
new file mode 100644
index 0000000000..6bf68304bb
--- /dev/null
+++ b/basis/tools/cocoa/tags.txt
@@ -0,0 +1 @@
+unportable
diff --git a/basis/tools/deploy/backend/backend.factor b/basis/tools/deploy/backend/backend.factor
index f33e4840eb..ee8615ac5a 100644
--- a/basis/tools/deploy/backend/backend.factor
+++ b/basis/tools/deploy/backend/backend.factor
@@ -89,7 +89,8 @@ DEFER: ?make-staging-image
[ drop ] [ make-staging-image ] if ;
: make-deploy-config ( vocab -- file )
- [ deploy-config unparse-use ] [ "deploy-config-" prepend ] bi
+ [ deploy-config unparse-use ]
+ [ "deploy-config-" prepend temp-file ] bi
[ utf8 set-file-contents ] keep ;
: deploy-command-line ( image vocab config -- flags )
diff --git a/basis/tools/deploy/deploy-tests.factor b/basis/tools/deploy/deploy-tests.factor
index 9cc48972fa..af065c9bf6 100644
--- a/basis/tools/deploy/deploy-tests.factor
+++ b/basis/tools/deploy/deploy-tests.factor
@@ -31,6 +31,10 @@ urls math.parser ;
[ t ] [ "bunny" shake-and-bake 2500000 small-enough? ] unit-test
+os macosx? [
+ [ t ] [ "webkit-demo" shake-and-bake 500000 small-enough? ] unit-test
+] when
+
: run-temp-image ( -- )
vm
"-i=" "test.image" temp-file append
diff --git a/basis/tools/deploy/macosx/macosx.factor b/basis/tools/deploy/macosx/macosx.factor
index d3464993e1..1f0e482441 100644
--- a/basis/tools/deploy/macosx/macosx.factor
+++ b/basis/tools/deploy/macosx/macosx.factor
@@ -1,10 +1,11 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-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
-qualified combinators ;
+USING: io io.files kernel namespaces make sequences system
+tools.deploy.backend tools.deploy.config
+tools.deploy.config.editor assocs hashtables prettyprint
+io.unix.backend cocoa io.encodings.utf8 io.backend
+cocoa.application cocoa.classes cocoa.plists qualified
+combinators ;
IN: tools.deploy.macosx
: bundle-dir ( -- dir )
diff --git a/basis/tools/deploy/shaker/strip-cocoa.factor b/basis/tools/deploy/shaker/strip-cocoa.factor
index d5249dc20c..773b2d0f3b 100644
--- a/basis/tools/deploy/shaker/strip-cocoa.factor
+++ b/basis/tools/deploy/shaker/strip-cocoa.factor
@@ -25,11 +25,6 @@ H{ } clone \ pool [
global [
"stop-after-last-window?" "ui" lookup set
- "ui.cocoa" vocab [
- [ "MiniFactor.nib" load-nib ]
- "cocoa-init-hook" "ui.cocoa" lookup set-global
- ] when
-
! Only keeps those methods that we actually call
sent-messages get super-sent-messages get assoc-union
objc-methods [ assoc-intersect pool-values ] change
diff --git a/basis/ui/cocoa/cocoa.factor b/basis/ui/cocoa/cocoa.factor
index 42063fbf73..b90f4d34fe 100644
--- a/basis/ui/cocoa/cocoa.factor
+++ b/basis/ui/cocoa/cocoa.factor
@@ -3,9 +3,10 @@
USING: accessors math arrays assocs cocoa cocoa.application
command-line kernel memory namespaces cocoa.messages
cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types
-cocoa.windows cocoa.classes cocoa.application sequences system
-ui ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
-ui.cocoa.views core-foundation threads math.geometry.rect fry ;
+cocoa.windows cocoa.classes cocoa.application cocoa.nibs
+sequences system ui ui.backend ui.clipboards ui.gadgets
+ui.gadgets.worlds ui.cocoa.views core-foundation threads
+math.geometry.rect fry ;
IN: ui.cocoa
TUPLE: handle view window ;
@@ -110,7 +111,9 @@ CLASS: {
SYMBOL: cocoa-init-hook
-cocoa-init-hook global [ [ install-app-delegate ] or ] change-at
+cocoa-init-hook global [
+ [ "MiniFactor.nib" load-nib install-app-delegate ] or
+] change-at
M: cocoa-ui-backend ui
"UI" assert.app [
diff --git a/basis/ui/tools/deploy/deploy.factor b/basis/ui/tools/deploy/deploy.factor
index f023b0959a..f233c9f162 100644
--- a/basis/ui/tools/deploy/deploy.factor
+++ b/basis/ui/tools/deploy/deploy.factor
@@ -1,11 +1,11 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: ui.gadgets colors kernel ui.render namespaces models
models.mapping sequences ui.gadgets.buttons ui.gadgets.packs
-ui.gadgets.labels tools.deploy.config namespaces
-ui.gadgets.editors ui.gadgets.borders ui.gestures ui.commands
-assocs ui.gadgets.tracks ui ui.tools.listener tools.deploy
-vocabs ui.tools.workspace system accessors fry ;
+ui.gadgets.labels tools.deploy.config tools.deploy.config.editor
+namespaces ui.gadgets.editors ui.gadgets.borders ui.gestures
+ui.commands assocs ui.gadgets.tracks ui ui.tools.listener
+tools.deploy vocabs ui.tools.workspace system accessors fry ;
IN: ui.tools.deploy
TUPLE: deploy-gadget < pack vocab settings ;
diff --git a/basis/unix/debugger/debugger.factor b/basis/unix/debugger/debugger.factor
new file mode 100644
index 0000000000..713c2202d4
--- /dev/null
+++ b/basis/unix/debugger/debugger.factor
@@ -0,0 +1,18 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: debugger prettyprint accessors io ;
+IN: unix.debugger
+
+M: unix-error error.
+ "Unix system call failed:" print
+ nl
+ dup message>> write " (" write errno>> pprint ")" print ;
+
+M: unix-system-call-error error.
+ "Unix system call ``" write dup word>> pprint "'' failed:" print
+ nl
+ dup message>> write " (" write dup errno>> pprint ")" print
+ nl
+ "It was called with the following arguments:" print
+ nl
+ args>> stack. ;
diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor
index d917425bf9..555f8e2c7d 100644
--- a/basis/unix/unix.factor
+++ b/basis/unix/unix.factor
@@ -1,10 +1,10 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax kernel libc
sequences continuations byte-arrays strings math namespaces
system combinators vocabs.loader qualified accessors
stack-checker macros locals generalizations unix.types
-debugger io prettyprint io.files ;
+io io.files vocabs vocabs.loader ;
IN: unix
: PROT_NONE 0 ; inline
@@ -60,26 +60,12 @@ FUNCTION: char* strerror ( int errno ) ;
ERROR: unix-error errno message ;
-M: unix-error error.
- "Unix system call failed:" print
- nl
- dup message>> write " (" write errno>> pprint ")" print ;
-
: (io-error) ( -- * ) err_no dup strerror unix-error ;
: io-error ( n -- ) 0 < [ (io-error) ] when ;
ERROR: unix-system-call-error args errno message word ;
-M: unix-system-call-error error.
- "Unix system call ``" write dup word>> pprint "'' failed:" print
- nl
- dup message>> write " (" write dup errno>> pprint ")" print
- nl
- "It was called with the following arguments:" print
- nl
- args>> stack. ;
-
MACRO:: unix-system-call ( quot -- )
[let | n [ quot infer in>> ]
word [ quot first ] |
@@ -236,3 +222,7 @@ FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ;
{ [ os bsd? ] [ "unix.bsd" require ] }
{ [ os solaris? ] [ "unix.solaris" require ] }
} cond
+
+"debugger" vocab [
+ "unix.debugger" require
+] when
diff --git a/core/source-files/source-files.factor b/core/source-files/source-files.factor
index 767c2a1f79..3ae50a9a15 100644
--- a/core/source-files/source-files.factor
+++ b/core/source-files/source-files.factor
@@ -78,7 +78,7 @@ M: pathname forget*
SYMBOL: file
-TUPLE: source-file-error file error ;
+TUPLE: source-file-error error file ;
: <source-file-error> ( msg -- error )
\ source-file-error new
From 403ae9db9e8fa95477aa40560624d5bab118fb4a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 18:48:35 -0600
Subject: [PATCH 11/46] Fix load error in unix.debugger
---
basis/unix/debugger/debugger.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/unix/debugger/debugger.factor b/basis/unix/debugger/debugger.factor
index 713c2202d4..ea32657057 100644
--- a/basis/unix/debugger/debugger.factor
+++ b/basis/unix/debugger/debugger.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: debugger prettyprint accessors io ;
+USING: debugger prettyprint accessors unix io kernel ;
IN: unix.debugger
M: unix-error error.
From ac653d5c31dac37133b5752873e2a0d0e3e2e5bc Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 18:48:49 -0600
Subject: [PATCH 12/46] Core foundation now uses UTF8 instead of UTF16, to
eliminate unnecessary dependency
---
.../core-foundation-tests.factor | 9 +++
basis/core-foundation/core-foundation.factor | 58 +++++++++++++++++--
2 files changed, 61 insertions(+), 6 deletions(-)
create mode 100644 basis/core-foundation/core-foundation-tests.factor
diff --git a/basis/core-foundation/core-foundation-tests.factor b/basis/core-foundation/core-foundation-tests.factor
new file mode 100644
index 0000000000..c1d6788d50
--- /dev/null
+++ b/basis/core-foundation/core-foundation-tests.factor
@@ -0,0 +1,9 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: core-foundation tools.test kernel ;
+IN: core-foundation
+
+[ ] [ "Hello" <CFString> CFRelease ] unit-test
+[ "Hello" ] [ "Hello" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
+[ "Hello\u003456" ] [ "Hello\u003456" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
+[ "Hello\u013456" ] [ "Hello\u013456" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
diff --git a/basis/core-foundation/core-foundation.factor b/basis/core-foundation/core-foundation.factor
index d63a66dbe7..48d7b7e483 100644
--- a/basis/core-foundation/core-foundation.factor
+++ b/basis/core-foundation/core-foundation.factor
@@ -1,7 +1,8 @@
! Copyright (C) 2006, 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings alien.syntax kernel
-math sequences io.encodings.utf16 destructors accessors combinators ;
+math sequences io.encodings.utf8 destructors accessors
+combinators byte-arrays ;
IN: core-foundation
TYPEDEF: void* CFAllocatorRef
@@ -69,12 +70,53 @@ FUNCTION: CFURLRef CFURLCreateWithString ( CFAllocatorRef allocator, CFStringRef
FUNCTION: CFURLRef CFURLCopyFileSystemPath ( CFURLRef url, int pathStyle ) ;
-FUNCTION: CFStringRef CFStringCreateWithCharacters ( CFAllocatorRef allocator, wchar_t* cStr, CFIndex numChars ) ;
+TYPEDEF: int CFStringEncoding
+: kCFStringEncodingMacRoman HEX: 0 ;
+: kCFStringEncodingWindowsLatin1 HEX: 0500 ;
+: kCFStringEncodingISOLatin1 HEX: 0201 ;
+: kCFStringEncodingNextStepLatin HEX: 0B01 ;
+: kCFStringEncodingASCII HEX: 0600 ;
+: kCFStringEncodingUnicode HEX: 0100 ;
+: kCFStringEncodingUTF8 HEX: 08000100 ;
+: kCFStringEncodingNonLossyASCII HEX: 0BFF ;
+: kCFStringEncodingUTF16 HEX: 0100 ;
+: kCFStringEncodingUTF16BE HEX: 10000100 ;
+: kCFStringEncodingUTF16LE HEX: 14000100 ;
+: kCFStringEncodingUTF32 HEX: 0c000100 ;
+: kCFStringEncodingUTF32BE HEX: 18000100 ;
+: kCFStringEncodingUTF32LE HEX: 1c000100 ;
+
+FUNCTION: CFStringRef CFStringCreateFromExternalRepresentation (
+ CFAllocatorRef alloc,
+ CFDataRef data,
+ CFStringEncoding encoding
+) ;
+
+FUNCTION: CFStringRef CFStringCreateWithBytes (
+ CFAllocatorRef alloc,
+ UInt8* bytes,
+ CFIndex numBytes,
+ CFStringEncoding encoding,
+ Boolean isExternalRepresentation
+) ;
FUNCTION: CFIndex CFStringGetLength ( CFStringRef theString ) ;
FUNCTION: void CFStringGetCharacters ( void* theString, CFIndex start, CFIndex length, void* buffer ) ;
+FUNCTION: Boolean CFStringGetCString (
+ CFStringRef theString,
+ char* buffer,
+ CFIndex bufferSize,
+ CFStringEncoding encoding
+) ;
+
+FUNCTION: CFStringRef CFStringCreateWithCString (
+ CFAllocatorRef alloc,
+ char* cStr,
+ CFStringEncoding encoding
+) ;
+
FUNCTION: CFNumberRef CFNumberCreate ( CFAllocatorRef allocator, CFNumberType theType, void* valuePtr ) ;
FUNCTION: CFDataRef CFDataCreate ( CFAllocatorRef allocator, uchar* bytes, CFIndex length ) ;
@@ -97,12 +139,16 @@ FUNCTION: CFTypeID CFGetTypeID ( CFTypeRef cf ) ;
[ [ dupd ] dip CFArraySetValueAtIndex ] 2each ;
: <CFString> ( string -- alien )
- f swap dup length CFStringCreateWithCharacters ;
+ f swap utf8 string>alien kCFStringEncodingUTF8 CFStringCreateWithCString
+ [ "CFStringCreateWithCString failed" throw ] unless* ;
: CF>string ( alien -- string )
- dup CFStringGetLength 1+ "ushort" <c-array> [
- [ 0 over CFStringGetLength ] dip CFStringGetCharacters
- ] keep utf16n alien>string ;
+ dup CFStringGetLength 4 * 1 + <byte-array> [
+ dup length
+ kCFStringEncodingUTF8
+ CFStringGetCString
+ [ "CFStringGetCString failed" throw ] unless
+ ] keep utf8 alien>string ;
: CF>string-array ( alien -- seq )
CF>array [ CF>string ] map ;
From 11c138ae95c7ffef8bfdd40beb0897723ff9b499 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 18:49:02 -0600
Subject: [PATCH 13/46] alien.strings doesn't load utf16 on Unix anymore
---
basis/alien/strings/strings.factor | 29 +++++++++-------------
basis/alien/strings/unix/unix.factor | 8 ++++++
basis/alien/strings/windows/windows.factor | 13 ++++++++++
3 files changed, 33 insertions(+), 17 deletions(-)
create mode 100644 basis/alien/strings/unix/unix.factor
create mode 100644 basis/alien/strings/windows/windows.factor
diff --git a/basis/alien/strings/strings.factor b/basis/alien/strings/strings.factor
index d482634772..e9053cd5c1 100644
--- a/basis/alien/strings/strings.factor
+++ b/basis/alien/strings/strings.factor
@@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays sequences kernel accessors math alien.accessors
alien.c-types byte-arrays words io io.encodings
-io.streams.byte-array io.streams.memory io.encodings.utf8
-io.encodings.utf16 system alien strings cpu.architecture fry ;
+io.encodings.utf8 io.streams.byte-array io.streams.memory system
+alien strings cpu.architecture fry vocabs.loader combinators ;
IN: alien.strings
GENERIC# alien>string 1 ( c-ptr encoding -- string/f )
@@ -88,27 +88,22 @@ M: string-type c-type-getter
M: string-type c-type-setter
drop [ set-alien-cell ] ;
-! Native-order UTF-16
+HOOK: alien>native-string os ( alien -- string )
-SINGLETON: utf16n
-
-: utf16n ( -- descriptor )
- little-endian? utf16le utf16be ? ; foldable
-
-M: utf16n <decoder> drop utf16n <decoder> ;
-
-M: utf16n <encoder> drop utf16n <encoder> ;
-
-: alien>native-string ( alien -- string )
- os windows? [ utf16n ] [ utf8 ] if alien>string ;
+HOOK: native-string>alien os ( string -- alien )
: dll-path ( dll -- string )
path>> alien>native-string ;
: string>symbol ( str -- alien )
- [ os wince? [ utf16n ] [ utf8 ] if string>alien ]
- over string? [ call ] [ map ] if ;
+ dup string?
+ [ native-string>alien ]
+ [ [ native-string>alien ] map ] if ;
{ "char*" utf8 } "char*" typedef
-{ "char*" utf16n } "wchar_t*" typedef
"char*" "uchar*" typedef
+
+{
+ { [ os windows? ] [ "alien.strings.windows" require ] }
+ { [ os unix? ] [ "alien.strings.unix" require ] }
+} cond
diff --git a/basis/alien/strings/unix/unix.factor b/basis/alien/strings/unix/unix.factor
new file mode 100644
index 0000000000..a7b1467344
--- /dev/null
+++ b/basis/alien/strings/unix/unix.factor
@@ -0,0 +1,8 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.strings io.encodings.utf8 system ;
+IN: alien.strings.unix
+
+M: unix alien>native-string utf8 alien>string ;
+
+M: unix native-string>alien utf8 string>alien ;
diff --git a/basis/alien/strings/windows/windows.factor b/basis/alien/strings/windows/windows.factor
new file mode 100644
index 0000000000..55c69246de
--- /dev/null
+++ b/basis/alien/strings/windows/windows.factor
@@ -0,0 +1,13 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.strings alien.c-types io.encodings.utf8
+io.encodings.utf16n system ;
+IN: alien.strings.windows
+
+M: windows alien>native-string utf16n alien>string ;
+
+M: wince native-string>alien utf16n string>alien ;
+
+M: winnt native-string>alien utf8 string>alien ;
+
+{ "char*" utf16n } "wchar_t*" typedef
From 1604e18d71640c714c376a5e68911bd6de99e2b8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 19:13:58 -0600
Subject: [PATCH 14/46] Remove ascii dependency from Mac OS X bootstrap
---
basis/cocoa/messages/messages.factor | 6 +++---
basis/cocoa/subclassing/subclassing.factor | 4 ++--
2 files changed, 5 insertions(+), 5 deletions(-)
diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor
index 5f548bdeb8..ebe98a2df1 100644
--- a/basis/cocoa/messages/messages.factor
+++ b/basis/cocoa/messages/messages.factor
@@ -3,7 +3,7 @@
USING: accessors alien alien.c-types alien.strings arrays assocs
continuations combinators compiler compiler.alien kernel math
namespaces make parser quotations sequences strings words
-cocoa.runtime io macros memoize io.encodings.ascii
+cocoa.runtime io macros memoize io.encodings.utf8
effects libc libc.private parser lexer init core-foundation fry
generalizations specialized-arrays.direct.alien ;
IN: cocoa.messages
@@ -180,7 +180,7 @@ assoc-union alien>objc-types set-global
: method-arg-type ( method i -- type )
method_copyArgumentType
- [ ascii alien>string parse-objc-type ] keep
+ [ utf8 alien>string parse-objc-type ] keep
(free) ;
: method-arg-types ( method -- args )
@@ -189,7 +189,7 @@ assoc-union alien>objc-types set-global
: method-return-type ( method -- ctype )
method_copyReturnType
- [ ascii alien>string parse-objc-type ] keep
+ [ utf8 alien>string parse-objc-type ] keep
(free) ;
: register-objc-method ( method -- )
diff --git a/basis/cocoa/subclassing/subclassing.factor b/basis/cocoa/subclassing/subclassing.factor
index b49d55a30b..be53364185 100644
--- a/basis/cocoa/subclassing/subclassing.factor
+++ b/basis/cocoa/subclassing/subclassing.factor
@@ -3,12 +3,12 @@
USING: alien alien.c-types alien.strings arrays assocs
combinators compiler hashtables kernel libc math namespaces
parser sequences words cocoa.messages cocoa.runtime locals
-compiler.units io.encodings.ascii continuations make fry ;
+compiler.units io.encodings.utf8 continuations make fry ;
IN: cocoa.subclassing
: init-method ( method -- sel imp types )
first3 swap
- [ sel_registerName ] [ execute ] [ ascii string>alien ]
+ [ sel_registerName ] [ execute ] [ utf8 string>alien ]
tri* ;
: throw-if-false ( obj what -- )
From 640b37cb70e643f6cf1fe2baa6b1b955c37927ff Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 19:14:18 -0600
Subject: [PATCH 15/46] More permissive
---
basis/compiler/tree/propagation/inlining/inlining.factor | 8 +++++---
1 file changed, 5 insertions(+), 3 deletions(-)
diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor
index fcc3b01dc0..e35eb02604 100644
--- a/basis/compiler/tree/propagation/inlining/inlining.factor
+++ b/basis/compiler/tree/propagation/inlining/inlining.factor
@@ -48,9 +48,11 @@ M: callable splicing-nodes
] [ 2drop f >>method f >>body f >>class drop f ] if ;
: inlining-standard-method ( #call word -- class/f method/f )
- [ in-d>> <reversed> ] [ [ dispatch# ] keep ] bi*
- [ swap nth value-info class>> dup ] dip
- specific-method ;
+ dup "methods" word-prop assoc-empty? [ 2drop f f ] [
+ [ in-d>> <reversed> ] [ [ dispatch# ] keep ] bi*
+ [ swap nth value-info class>> dup ] dip
+ specific-method
+ ] if ;
: inline-standard-method ( #call word -- ? )
dupd inlining-standard-method eliminate-dispatch ;
From 8c60595b26fc7353e5cb3bc6695d07c635277f0e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 19:14:38 -0600
Subject: [PATCH 16/46] Strip out default methods; ~40kb savings on hello-world
and maze demos
---
basis/tools/deploy/shaker/shaker.factor | 16 +++++++++++++++-
1 file changed, 15 insertions(+), 1 deletion(-)
diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index 01cc80e90d..3c458f0a55 100755
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -185,6 +185,19 @@ IN: tools.deploy.shaker
strip-word-names? [ dup strip-word-names ] when
2drop ;
+: strip-default-methods ( -- )
+ strip-debugger? [
+ "Stripping default methods" show
+ [
+ [ generic? ] instances
+ [ "No method" throw ] define-temp
+ dup t "default" set-word-prop
+ '[
+ [ _ "default-method" set-word-prop ] [ make-generic ] bi
+ ] each
+ ] with-compilation-unit
+ ] when ;
+
: strip-vocab-globals ( except names -- words )
[ child-vocabs [ words ] map concat ] map concat swap diff ;
@@ -370,6 +383,7 @@ SYMBOL: deploy-vocab
: strip ( -- )
init-stripper
+ strip-default-methods
strip-libc
strip-cocoa
strip-debugger
@@ -395,7 +409,7 @@ SYMBOL: deploy-vocab
deploy-vocab get require
strip
finish-deploy
- ] [ die 1 exit ] recover
+ ] [ error-continuation get call>> callstack>array die 1 exit ] recover
] bind ;
: do-deploy ( -- )
From 78fbaacb3c3fd1fdc79ebdd2f1917daa117a1f5a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 19:18:03 -0600
Subject: [PATCH 17/46] Don't include threading support with hello-world; this
reduces size by ~30kb
---
extra/hello-world/deploy.factor | 19 ++++++++++---------
1 file changed, 10 insertions(+), 9 deletions(-)
diff --git a/extra/hello-world/deploy.factor b/extra/hello-world/deploy.factor
index 64ea481b03..48c14f7cba 100755
--- a/extra/hello-world/deploy.factor
+++ b/extra/hello-world/deploy.factor
@@ -1,14 +1,15 @@
USING: tools.deploy.config ;
H{
- { deploy-unicode? f }
- { deploy-reflection 1 }
- { deploy-word-props? f }
- { deploy-math? f }
{ deploy-name "Hello world (console)" }
- { deploy-word-defs? f }
- { "stop-after-last-window?" t }
- { deploy-ui? f }
- { deploy-compiler? f }
- { deploy-io 2 }
{ deploy-c-types? f }
+ { deploy-word-props? f }
+ { deploy-ui? f }
+ { deploy-reflection 1 }
+ { deploy-compiler? f }
+ { deploy-unicode? f }
+ { deploy-io 2 }
+ { deploy-word-defs? f }
+ { deploy-threads? f }
+ { "stop-after-last-window?" t }
+ { deploy-math? f }
}
From ada08e6d0edeb2d7bc66abf5d731f7a381c9ce7f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 19:45:48 -0600
Subject: [PATCH 18/46] Removing prettyprint and debugger dependencies from io
code
---
basis/io/encodings/utf16n/utf16n.factor | 15 +++++++++++++++
basis/io/ports/ports.factor | 2 +-
basis/io/servers/connection/connection.factor | 2 +-
basis/io/sockets/secure/openssl/openssl.factor | 4 ++--
basis/io/sockets/sockets.factor | 2 +-
basis/io/streams/duplex/duplex.factor | 4 ++--
basis/io/unix/launcher/launcher.factor | 2 +-
basis/io/unix/sockets/secure/secure.factor | 2 +-
8 files changed, 24 insertions(+), 9 deletions(-)
create mode 100644 basis/io/encodings/utf16n/utf16n.factor
diff --git a/basis/io/encodings/utf16n/utf16n.factor b/basis/io/encodings/utf16n/utf16n.factor
new file mode 100644
index 0000000000..2fae7bd66a
--- /dev/null
+++ b/basis/io/encodings/utf16n/utf16n.factor
@@ -0,0 +1,15 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types io.encodings io.encodings.utf16 ;
+IN: io.encodings.utf16n
+
+! Native-order UTF-16
+
+SINGLETON: utf16n
+
+: utf16n ( -- descriptor )
+ little-endian? utf16le utf16be ? ; foldable
+
+M: utf16n <decoder> drop utf16n <decoder> ;
+
+M: utf16n <encoder> drop utf16n <encoder> ;
diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index 0432fe4a39..6eb61a24a7 100644
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: math kernel io sequences io.buffers io.timeouts generic
byte-vectors system io.encodings math.order io.backend
-continuations debugger classes byte-arrays namespaces splitting
+continuations classes byte-arrays namespaces splitting
grouping dlists assocs io.encodings.binary summary accessors
destructors combinators ;
IN: io.ports
diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor
index 2d990e6483..bc90915213 100644
--- a/basis/io/servers/connection/connection.factor
+++ b/basis/io/servers/connection/connection.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: continuations destructors kernel math math.parser
-namespaces parser sequences strings prettyprint debugger
+namespaces parser sequences strings prettyprint
quotations combinators logging calendar assocs present
fry accessors arrays io io.sockets io.encodings.ascii
io.sockets.secure io.files io.streams.duplex io.timeouts
diff --git a/basis/io/sockets/secure/openssl/openssl.factor b/basis/io/sockets/secure/openssl/openssl.factor
index ec45337fb1..60402c37ea 100644
--- a/basis/io/sockets/secure/openssl/openssl.factor
+++ b/basis/io/sockets/secure/openssl/openssl.factor
@@ -1,8 +1,8 @@
! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors byte-arrays kernel debugger sequences
+USING: accessors byte-arrays kernel sequences
namespaces math math.order combinators init alien alien.c-types
-alien.strings libc continuations destructors debugger summary
+alien.strings libc continuations destructors summary
splitting assocs random math.parser locals unicode.case openssl
openssl.libcrypto openssl.libssl io.backend io.ports io.files
io.encodings.8-bit io.timeouts io.sockets.secure ;
diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor
index fbfae333c0..597aa61138 100644
--- a/basis/io/sockets/sockets.factor
+++ b/basis/io/sockets/sockets.factor
@@ -4,7 +4,7 @@
USING: generic kernel io.backend namespaces continuations
sequences arrays io.encodings io.ports io.streams.duplex
io.encodings.ascii alien.strings io.binary accessors destructors
-classes debugger byte-arrays system combinators parser
+classes byte-arrays system combinators parser
alien.c-types math.parser splitting grouping math assocs summary
system vocabs.loader combinators present fry ;
IN: io.sockets
diff --git a/basis/io/streams/duplex/duplex.factor b/basis/io/streams/duplex/duplex.factor
index 9bf637432f..53d554e766 100644
--- a/basis/io/streams/duplex/duplex.factor
+++ b/basis/io/streams/duplex/duplex.factor
@@ -1,8 +1,8 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel continuations destructors io io.encodings
-io.encodings.private io.timeouts io.ports debugger summary
-listener accessors delegate delegate.protocols ;
+io.encodings.private io.timeouts io.ports summary
+accessors delegate delegate.protocols ;
IN: io.streams.duplex
TUPLE: duplex-stream in out ;
diff --git a/basis/io/unix/launcher/launcher.factor b/basis/io/unix/launcher/launcher.factor
index c81da60e12..0101ed613b 100644
--- a/basis/io/unix/launcher/launcher.factor
+++ b/basis/io/unix/launcher/launcher.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces math system sequences debugger
+USING: kernel namespaces math system sequences
continuations arrays assocs combinators alien.c-types strings
threads accessors environment
io io.backend io.launcher io.ports io.files
diff --git a/basis/io/unix/sockets/secure/secure.factor b/basis/io/unix/sockets/secure/secure.factor
index a096380b74..106b6569ed 100644
--- a/basis/io/unix/sockets/secure/secure.factor
+++ b/basis/io/unix/sockets/secure/secure.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors unix byte-arrays kernel debugger sequences
+USING: accessors unix byte-arrays kernel sequences
namespaces math math.order combinators init alien alien.c-types
alien.strings libc continuations destructors openssl
openssl.libcrypto openssl.libssl io io.files io.ports
From 10e3e84a5e64a4e878cd96b560c7287409d709e4 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 19:45:58 -0600
Subject: [PATCH 19/46] Remove listener dependency from delegate
---
basis/delegate/delegate.factor | 4 +---
basis/delegate/protocols/protocols.factor | 5 ++---
2 files changed, 3 insertions(+), 6 deletions(-)
diff --git a/basis/delegate/delegate.factor b/basis/delegate/delegate.factor
index e7ea370b8d..57f9b35c96 100644
--- a/basis/delegate/delegate.factor
+++ b/basis/delegate/delegate.factor
@@ -2,7 +2,7 @@
! 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 generalizations namespaces make ;
+math hashtables sets generalizations namespaces make ;
IN: delegate
: protocol-words ( protocol -- words )
@@ -100,6 +100,4 @@ M: protocol definition protocol-words show-words ;
M: protocol definer drop \ PROTOCOL: \ ; ;
-M: protocol synopsis* word-synopsis ; ! Necessary?
-
M: protocol group-words protocol-words ;
diff --git a/basis/delegate/protocols/protocols.factor b/basis/delegate/protocols/protocols.factor
index 81310c16c0..c21f33ec8e 100644
--- a/basis/delegate/protocols/protocols.factor
+++ b/basis/delegate/protocols/protocols.factor
@@ -1,8 +1,7 @@
! Copyright (C) 2007 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: delegate sequences.private sequences assocs
-prettyprint.sections io definitions kernel continuations
-listener ;
+io definitions kernel continuations ;
IN: delegate.protocols
PROTOCOL: sequence-protocol
@@ -16,7 +15,7 @@ PROTOCOL: assoc-protocol
PROTOCOL: input-stream-protocol
stream-read1 stream-read stream-read-partial stream-readln
- stream-read-until stream-read-quot ;
+ stream-read-until ;
PROTOCOL: output-stream-protocol
stream-flush stream-write1 stream-write stream-format
From 97a91579bbca148fc708ff9de773a1ebf3f98dc9 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 19:46:07 -0600
Subject: [PATCH 20/46] Fix load error
---
extra/parser-combinators/regexp/regexp.factor | 9 +++++----
1 file changed, 5 insertions(+), 4 deletions(-)
diff --git a/extra/parser-combinators/regexp/regexp.factor b/extra/parser-combinators/regexp/regexp.factor
index b13321d991..7c23dcce0b 100755
--- a/extra/parser-combinators/regexp/regexp.factor
+++ b/extra/parser-combinators/regexp/regexp.factor
@@ -1,8 +1,9 @@
USING: arrays combinators kernel lists math math.parser
-namespaces parser lexer parser-combinators parser-combinators.simple
-promises quotations sequences strings math.order
-assocs prettyprint.backend memoize unicode.case unicode.categories
-combinators.short-circuit accessors make io ;
+namespaces parser lexer parser-combinators
+parser-combinators.simple promises quotations sequences strings
+math.order assocs prettyprint.backend prettyprint.custom memoize
+unicode.case unicode.categories combinators.short-circuit
+accessors make io ;
IN: parser-combinators.regexp
<PRIVATE
From a0e7663afb07e8753149d0f2dc345eda284340bb Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 19:46:40 -0600
Subject: [PATCH 21/46] Remove eval dependency from unicode.syntax
---
basis/unicode/syntax/syntax.factor | 4 ++--
core/strings/parser/parser-tests.factor | 4 ++++
core/strings/parser/parser.factor | 12 ++++++++++++
3 files changed, 18 insertions(+), 2 deletions(-)
create mode 100644 core/strings/parser/parser-tests.factor
diff --git a/basis/unicode/syntax/syntax.factor b/basis/unicode/syntax/syntax.factor
index bf4610ab0d..b7ac022d0e 100644
--- a/basis/unicode/syntax/syntax.factor
+++ b/basis/unicode/syntax/syntax.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: unicode.data kernel math sequences parser lexer
bit-arrays namespaces make sequences.private arrays quotations
-assocs classes.predicate math.order eval ;
+assocs classes.predicate math.order strings.parser ;
IN: unicode.syntax
! Character classes (categories)
@@ -26,7 +26,7 @@ IN: unicode.syntax
categories [ swap member? ] with map >bit-array ;
: as-string ( strings -- bit-array )
- concat "\"" tuck 3append eval ;
+ concat unescape-string ;
: [category] ( categories -- quot )
[
diff --git a/core/strings/parser/parser-tests.factor b/core/strings/parser/parser-tests.factor
new file mode 100644
index 0000000000..80f649c204
--- /dev/null
+++ b/core/strings/parser/parser-tests.factor
@@ -0,0 +1,4 @@
+IN: strings.parser.tests
+USING: strings.parser tools.test ;
+
+[ "Hello\n\rworld" ] [ "Hello\\n\\rworld" unescape-string ] unit-test
diff --git a/core/strings/parser/parser.factor b/core/strings/parser/parser.factor
index cfe5d1a90a..4062e16e3d 100644
--- a/core/strings/parser/parser.factor
+++ b/core/strings/parser/parser.factor
@@ -58,3 +58,15 @@ name>char-hook global [
lexer get [
[ swap tail-slice (parse-string) ] "" make swap
] change-lexer-column ;
+
+: (unescape-string) ( str -- str' )
+ dup [ CHAR: \\ = ] find [
+ cut-slice [ % ] dip rest-slice
+ next-escape [ , ] dip
+ (unescape-string)
+ ] [
+ drop %
+ ] if ;
+
+: unescape-string ( str -- str' )
+ [ (unescape-string) ] "" make ;
From 5bfa17d9627dc49ce0e454c0b1ecf68b96ea4c43 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 20:04:13 -0600
Subject: [PATCH 22/46] Split off error. methods into sub-vocabs in a few
places
---
basis/http/client/client.factor | 16 +++++--------
basis/http/client/debugger/debugger.factor | 13 +++++++++++
basis/http/http.factor | 8 +++----
basis/peg/debugger/debugger.factor | 12 ++++++++++
basis/peg/ebnf/ebnf.factor | 11 ++++-----
basis/peg/peg.factor | 26 +++++++++-------------
basis/urls/prettyprint/prettyprint.factor | 6 +++++
basis/urls/urls.factor | 9 +++++---
8 files changed, 61 insertions(+), 40 deletions(-)
create mode 100644 basis/http/client/debugger/debugger.factor
create mode 100644 basis/peg/debugger/debugger.factor
create mode 100644 basis/urls/prettyprint/prettyprint.factor
diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor
index 9260f15a7b..119fa23567 100644
--- a/basis/http/client/client.factor
+++ b/basis/http/client/client.factor
@@ -3,14 +3,14 @@
USING: accessors assocs kernel math math.parser namespaces make
sequences io io.sockets io.streams.string io.files io.timeouts
strings splitting calendar continuations accessors vectors
-math.order hashtables byte-arrays prettyprint destructors
+math.order hashtables byte-arrays destructors
io.encodings
io.encodings.string
io.encodings.ascii
io.encodings.8-bit
io.encodings.binary
io.streams.duplex
-fry debugger summary ascii urls urls.encoding present
+fry ascii urls urls.encoding present
http http.parsers ;
IN: http.client
@@ -84,10 +84,6 @@ M: f >post-data ;
ERROR: too-many-redirects ;
-M: too-many-redirects summary
- drop
- [ "Redirection limit of " % max-redirects # " exceeded" % ] "" make ;
-
<PRIVATE
DEFER: (with-http-request)
@@ -161,10 +157,6 @@ PRIVATE>
ERROR: download-failed response ;
-M: download-failed error.
- "HTTP request failed:" print nl
- response>> . ;
-
: check-response ( response -- response )
dup code>> success? [ download-failed ] unless ;
@@ -203,3 +195,7 @@ M: download-failed error.
: http-post ( post-data url -- response data )
<post-request> http-request ;
+
+USING: vocabs vocabs.loader ;
+
+"debugger" vocab [ "http.client.debugger" require ] when
diff --git a/basis/http/client/debugger/debugger.factor b/basis/http/client/debugger/debugger.factor
new file mode 100644
index 0000000000..413ae7bd85
--- /dev/null
+++ b/basis/http/client/debugger/debugger.factor
@@ -0,0 +1,13 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel summary debugger io make math.parser
+prettyprint http.client accessors ;
+IN: http.client.debugger
+
+M: too-many-redirects summary
+ drop
+ [ "Redirection limit of " % max-redirects # " exceeded" % ] "" make ;
+
+M: download-failed error.
+ "HTTP request failed:" print nl
+ response>> . ;
diff --git a/basis/http/http.factor b/basis/http/http.factor
index d006c86462..bbb0335ae4 100644
--- a/basis/http/http.factor
+++ b/basis/http/http.factor
@@ -1,9 +1,9 @@
! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel combinators math namespaces make
-assocs sequences splitting sorting sets debugger
-strings vectors hashtables quotations arrays byte-arrays
-math.parser calendar calendar.format present urls
+USING: accessors kernel combinators math namespaces make assocs
+sequences splitting sorting sets strings vectors hashtables
+quotations arrays byte-arrays math.parser calendar
+calendar.format present urls
io io.encodings io.encodings.iana io.encodings.binary
io.encodings.8-bit
diff --git a/basis/peg/debugger/debugger.factor b/basis/peg/debugger/debugger.factor
new file mode 100644
index 0000000000..7e751b5110
--- /dev/null
+++ b/basis/peg/debugger/debugger.factor
@@ -0,0 +1,12 @@
+USING: io kernel accessors math.parser sequences prettyprint
+debugger peg ;
+IN: peg.debugger
+
+M: parse-error error.
+ "Peg parsing error at character position " write dup position>> number>string write
+ "." print "Expected " write messages>> [ " or " write ] [ write ] interleave nl ;
+
+M: parse-failed error.
+ "The " write dup word>> pprint " word could not parse the following input:" print nl
+ input>> . ;
+
diff --git a/basis/peg/ebnf/ebnf.factor b/basis/peg/ebnf/ebnf.factor
index ccae0fec93..ca97886235 100644
--- a/basis/peg/ebnf/ebnf.factor
+++ b/basis/peg/ebnf/ebnf.factor
@@ -5,7 +5,7 @@ sequences quotations vectors namespaces make math assocs
continuations peg peg.parsers unicode.categories multiline
splitting accessors effects sequences.deep peg.search
combinators.short-circuit lexer io.streams.string stack-checker
-io prettyprint combinators parser ;
+io combinators parser ;
IN: peg.ebnf
: rule ( name word -- parser )
@@ -458,16 +458,13 @@ M: ebnf-var build-locals ( code ast -- )
M: object build-locals ( code ast -- )
drop ;
+ERROR: bad-effect quot effect ;
+
: check-action-effect ( quot -- quot )
dup infer {
{ [ dup (( a -- b )) effect<= ] [ drop ] }
{ [ dup (( -- b )) effect<= ] [ drop [ drop ] prepose ] }
- [
- [
- "Bad effect: " write effect>string write
- " for quotation " write pprint
- ] with-string-writer throw
- ]
+ [ bad-effect ]
} cond ;
M: ebnf-action (transform) ( ast -- parser )
diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor
index 8a62365f53..3fc6fec8ed 100644
--- a/basis/peg/peg.factor
+++ b/basis/peg/peg.factor
@@ -1,14 +1,12 @@
! Copyright (C) 2007, 2008 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences strings fry namespaces make math assocs
-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 generalizations ;
+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 generalizations ;
IN: peg
-USE: prettyprint
-
TUPLE: parse-result remaining ast ;
TUPLE: parse-error position messages ;
TUPLE: parser peg compiled id ;
@@ -19,10 +17,6 @@ M: parser hashcode* id>> hashcode* ;
C: <parse-result> parse-result
C: <parse-error> parse-error
-M: parse-error error.
- "Peg parsing error at character position " write dup position>> number>string write
- "." print "Expected " write messages>> [ " or " write ] [ write ] interleave nl ;
-
SYMBOL: error-stack
: (merge-errors) ( a b -- c )
@@ -238,8 +232,6 @@ TUPLE: peg-head rule-id involved-set eval-set ;
nip
] if ;
-USE: prettyprint
-
: apply-rule ( r p -- ast )
! 2dup [ rule-id ] dip 2array "apply-rule: " write .
2dup recall [
@@ -624,10 +616,6 @@ PRIVATE>
ERROR: parse-failed input word ;
-M: parse-failed error.
- "The " write dup word>> pprint " word could not parse the following input:" print nl
- input>> . ;
-
: PEG:
(:)
[let | def [ ] word [ ] |
@@ -643,3 +631,9 @@ M: parse-failed error.
] with-compilation-unit
] over push-all
] ; parsing
+
+USING: vocabs vocabs.loader ;
+
+"debugger" vocab [
+ "peg.debugger" require
+] when
diff --git a/basis/urls/prettyprint/prettyprint.factor b/basis/urls/prettyprint/prettyprint.factor
new file mode 100644
index 0000000000..59fb79e8d3
--- /dev/null
+++ b/basis/urls/prettyprint/prettyprint.factor
@@ -0,0 +1,6 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel present prettyprint.custom prettyprint.backend urls ;
+IN: urls.prettyprint
+
+M: url pprint* dup present "URL\" " "\"" pprint-string ;
diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor
index 5f6d04a54f..d71ce4ef7b 100644
--- a/basis/urls/urls.factor
+++ b/basis/urls/urls.factor
@@ -4,8 +4,7 @@ USING: kernel ascii combinators combinators.short-circuit
sequences splitting fry namespaces make assocs arrays strings
io.sockets io.encodings.string io.encodings.utf8 math
math.parser accessors parser strings.parser lexer
-prettyprint.backend prettyprint.custom hashtables present
-peg.ebnf urls.encoding ;
+hashtables present peg.ebnf urls.encoding ;
IN: urls
TUPLE: url protocol username password host port path query anchor ;
@@ -182,4 +181,8 @@ PRIVATE>
! Literal syntax
: URL" lexer get skip-blank parse-string >url parsed ; parsing
-M: url pprint* dup present "URL\" " "\"" pprint-string ;
+USING: vocabs vocabs.loader ;
+
+"prettyprint" vocab [
+ "urls.prettyprint" require
+] when
From 1d57b0bc50951718190e46dbb86b65f51baa5532 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 20:06:44 -0600
Subject: [PATCH 23/46] Fix load errors
---
basis/io/encodings/utf16n/utf16n.factor | 2 +-
basis/io/streams/limited/limited.factor | 2 +-
basis/tools/deploy/deploy-tests.factor | 6 +++---
extra/multi-methods/multi-methods.factor | 7 ++++---
4 files changed, 9 insertions(+), 8 deletions(-)
diff --git a/basis/io/encodings/utf16n/utf16n.factor b/basis/io/encodings/utf16n/utf16n.factor
index 2fae7bd66a..cc6e7e2baa 100644
--- a/basis/io/encodings/utf16n/utf16n.factor
+++ b/basis/io/encodings/utf16n/utf16n.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types io.encodings io.encodings.utf16 ;
+USING: alien.c-types io.encodings io.encodings.utf16 kernel ;
IN: io.encodings.utf16n
! Native-order UTF-16
diff --git a/basis/io/streams/limited/limited.factor b/basis/io/streams/limited/limited.factor
index e89b31a884..ecc49923de 100644
--- a/basis/io/streams/limited/limited.factor
+++ b/basis/io/streams/limited/limited.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math io io.encodings destructors accessors
-sequences namespaces ;
+sequences namespaces byte-vectors ;
IN: io.streams.limited
TUPLE: limited-stream stream count limit ;
diff --git a/basis/tools/deploy/deploy-tests.factor b/basis/tools/deploy/deploy-tests.factor
index af065c9bf6..71dc746fb5 100644
--- a/basis/tools/deploy/deploy-tests.factor
+++ b/basis/tools/deploy/deploy-tests.factor
@@ -1,8 +1,8 @@
IN: tools.deploy.tests
USING: tools.test system io.files kernel tools.deploy.config
-tools.deploy.backend math sequences io.launcher arrays
-namespaces continuations layouts accessors io.encodings.ascii
-urls math.parser ;
+tools.deploy.config.editor tools.deploy.backend math sequences
+io.launcher arrays namespaces continuations layouts accessors
+io.encodings.ascii urls math.parser ;
: shake-and-bake ( vocab -- )
[ "test.image" temp-file delete-file ] ignore-errors
diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor
index 14062b15db..cfdc28bb3d 100755
--- a/extra/multi-methods/multi-methods.factor
+++ b/extra/multi-methods/multi-methods.factor
@@ -2,9 +2,10 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math sequences vectors classes classes.algebra
combinators arrays words assocs parser namespaces make
-definitions prettyprint prettyprint.backend quotations
-generalizations debugger io compiler.units kernel.private
-effects accessors hashtables sorting shuffle math.order sets ;
+definitions prettyprint prettyprint.backend prettyprint.custom
+quotations generalizations debugger io compiler.units
+kernel.private effects accessors hashtables sorting shuffle
+math.order sets ;
IN: multi-methods
! PART I: Converting hook specializers
From e8027742cf17e6dc39dc86f873da99e91928ab2d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 20:13:04 -0600
Subject: [PATCH 24/46] Fix more load errors
---
extra/bind-in/bind-in.factor | 2 +-
extra/descriptive/descriptive.factor | 4 ++--
extra/reports/noise/noise.factor | 5 +++--
3 files changed, 6 insertions(+), 5 deletions(-)
diff --git a/extra/bind-in/bind-in.factor b/extra/bind-in/bind-in.factor
index ab6ff19094..78c797df9b 100644
--- a/extra/bind-in/bind-in.factor
+++ b/extra/bind-in/bind-in.factor
@@ -1,5 +1,5 @@
-USING: kernel parser lexer locals.private ;
+USING: kernel parser lexer locals.parser locals.types ;
IN: bind-in
diff --git a/extra/descriptive/descriptive.factor b/extra/descriptive/descriptive.factor
index d02983d7fd..b1fdf2463e 100755
--- a/extra/descriptive/descriptive.factor
+++ b/extra/descriptive/descriptive.factor
@@ -1,5 +1,5 @@
-USING: words kernel sequences locals
-locals.private accessors parser namespaces continuations
+USING: words kernel sequences locals locals.parser
+locals.definitions accessors parser namespaces continuations
summary definitions generalizations arrays ;
IN: descriptive
diff --git a/extra/reports/noise/noise.factor b/extra/reports/noise/noise.factor
index 78ede32801..6a547ead24 100755
--- a/extra/reports/noise/noise.factor
+++ b/extra/reports/noise/noise.factor
@@ -2,8 +2,9 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs math kernel shuffle generalizations
words quotations arrays combinators sequences math.vectors
-io.styles prettyprint vocabs sorting io generic locals.private
-math.statistics math.order combinators.lib ;
+io.styles prettyprint vocabs sorting io generic
+math.statistics math.order combinators.lib locals.types
+locals.definitions ;
IN: reports.noise
: badness ( word -- n )
From 833d9f9c0b858790b55128abe493bcf83a1650bf Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 21:24:45 -0600
Subject: [PATCH 25/46] Fix quotation pooling
---
basis/tools/deploy/shaker/shaker.factor | 4 ++--
vm/data_gc.c | 3 ++-
vm/factor.c | 20 +-------------------
vm/quotations.c | 23 +++++++++++++++++++++++
vm/quotations.h | 1 +
5 files changed, 29 insertions(+), 22 deletions(-)
diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index 3c458f0a55..3d4944841d 100755
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -394,11 +394,11 @@ SYMBOL: deploy-vocab
deploy-vocab get vocab-main set-boot-quot*
stripped-word-props
stripped-globals strip-globals
- strip-words
compress-byte-arrays
compress-quotations
compress-strings
- compress-wrappers ;
+ compress-wrappers
+ strip-words ;
: (deploy) ( final-image vocab config -- )
#! Does the actual work of a deployment in the slave
diff --git a/vm/data_gc.c b/vm/data_gc.c
index 513a7c429c..6e15718b2d 100755
--- a/vm/data_gc.c
+++ b/vm/data_gc.c
@@ -985,7 +985,8 @@ void primitive_become(void)
}
gc();
- iterate_code_heap(relocate_code_block);
+
+ compile_all_words();
}
CELL find_all_words(void)
diff --git a/vm/factor.c b/vm/factor.c
index f198370ebe..2f78a797d4 100755
--- a/vm/factor.c
+++ b/vm/factor.c
@@ -44,25 +44,7 @@ void do_stage1_init(void)
print_string("*** Stage 2 early init... ");
fflush(stdout);
- CELL words = find_all_words();
-
- REGISTER_ROOT(words);
-
- CELL i;
- CELL length = array_capacity(untag_object(words));
- for(i = 0; i < length; i++)
- {
- F_WORD *word = untag_word(array_nth(untag_array(words),i));
- REGISTER_UNTAGGED(word);
- default_word_code(word,false);
- UNREGISTER_UNTAGGED(word);
- update_word_xt(word);
- }
-
- UNREGISTER_ROOT(words);
-
- iterate_code_heap(relocate_code_block);
-
+ compile_all_words();
userenv[STAGE2_ENV] = T;
print_string("done\n");
diff --git a/vm/quotations.c b/vm/quotations.c
index a187fecbbb..86952a32e8 100755
--- a/vm/quotations.c
+++ b/vm/quotations.c
@@ -522,3 +522,26 @@ void primitive_quotation_xt(void)
F_QUOTATION *quot = untag_quotation(dpeek());
drepl(allot_cell((CELL)quot->xt));
}
+
+void compile_all_words(void)
+{
+ CELL words = find_all_words();
+
+ REGISTER_ROOT(words);
+
+ CELL i;
+ CELL length = array_capacity(untag_object(words));
+ for(i = 0; i < length; i++)
+ {
+ F_WORD *word = untag_word(array_nth(untag_array(words),i));
+ REGISTER_UNTAGGED(word);
+ if(word->compiledp == F)
+ default_word_code(word,false);
+ UNREGISTER_UNTAGGED(word);
+ update_word_xt(word);
+ }
+
+ UNREGISTER_ROOT(words);
+
+ iterate_code_heap(relocate_code_block);
+}
diff --git a/vm/quotations.h b/vm/quotations.h
index ff84977fd9..4c2c17bbb6 100755
--- a/vm/quotations.h
+++ b/vm/quotations.h
@@ -5,3 +5,4 @@ F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset);
void primitive_array_to_quotation(void);
void primitive_quotation_xt(void);
void primitive_jit_compile(void);
+void compile_all_words(void);
From 14a54bb97a7a5182073be0d3fbe34e79d8b8fc8e Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 8 Dec 2008 21:30:10 -0600
Subject: [PATCH 26/46] trails: Un-processify trails
---
extra/trails/trails.factor | 96 ++++++++++++++++++++++++++++++++++++++
1 file changed, 96 insertions(+)
create mode 100644 extra/trails/trails.factor
diff --git a/extra/trails/trails.factor b/extra/trails/trails.factor
new file mode 100644
index 0000000000..cea5ece9f7
--- /dev/null
+++ b/extra/trails/trails.factor
@@ -0,0 +1,96 @@
+
+USING: kernel accessors locals namespaces sequences sequences.lib threads
+ math math.order math.vectors
+ calendar
+ colors opengl ui ui.gadgets ui.gestures ui.render
+ circular
+ processing.shapes ;
+
+IN: trails
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! Example 33-15 from the Processing book
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! Return the mouse location relative to the current gadget
+
+: mouse ( -- point ) hand-loc get hand-gadget get screen-loc v- ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: point-list ( n -- seq ) [ drop { 0 0 } ] map <circular> ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: percent->radius ( percent -- radius ) neg 1 + 25 * 5 max ;
+
+: dot ( pos percent -- ) percent->radius circle ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+TUPLE: <trails-gadget> < gadget paused points ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: iterate-system ( GADGET -- )
+
+ ! Add a valid point if the mouse is in the gadget
+ ! Otherwise, add an "invisible" point
+
+ hand-gadget get GADGET =
+ [ mouse GADGET points>> push-circular ]
+ [ { -10 -10 } GADGET points>> push-circular ]
+ if ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: start-trails-thread ( GADGET -- )
+ GADGET f >>paused drop
+ [
+ [
+ GADGET paused>>
+ [ f ]
+ [ GADGET iterate-system GADGET relayout-1 1 milliseconds sleep t ]
+ if
+ ]
+ loop
+ ]
+ in-thread ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+M: <trails-gadget> pref-dim* ( <trails-gadget> -- dim ) drop { 500 500 } ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+M:: <trails-gadget> draw-gadget* ( GADGET -- )
+ origin get
+ [
+ T{ rgba f 1 1 1 0.4 } \ fill-color set ! White, with some transparency
+ T{ rgba f 0 0 0 0 } \ stroke-color set ! no stroke
+
+ black gl-clear
+
+ GADGET points>> [ dot ] each-percent
+ ]
+ with-translation ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: trails-gadget ( -- <trails-gadget> )
+
+ <trails-gadget> new-gadget
+
+ 300 point-list >>points
+
+ t >>clipped?
+
+ dup start-trails-thread ;
+
+: trails-window ( -- ) [ trails-gadget "Trails" open-window ] with-ui ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+MAIN: trails-window
\ No newline at end of file
From 971a6c89beac976ad8a90e7ff87df33133413c5c Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 8 Dec 2008 21:31:41 -0600
Subject: [PATCH 27/46] move io.paths from extra to basis
---
{extra => basis}/io/paths/authors.txt | 0
{extra => basis}/io/paths/paths.factor | 2 +-
{extra => basis}/io/paths/windows/authors.txt | 0
{extra => basis}/io/paths/windows/tags.txt | 0
{extra => basis}/io/paths/windows/windows.factor | 0
5 files changed, 1 insertion(+), 1 deletion(-)
rename {extra => basis}/io/paths/authors.txt (100%)
rename {extra => basis}/io/paths/paths.factor (96%)
rename {extra => basis}/io/paths/windows/authors.txt (100%)
rename {extra => basis}/io/paths/windows/tags.txt (100%)
rename {extra => basis}/io/paths/windows/windows.factor (100%)
diff --git a/extra/io/paths/authors.txt b/basis/io/paths/authors.txt
similarity index 100%
rename from extra/io/paths/authors.txt
rename to basis/io/paths/authors.txt
diff --git a/extra/io/paths/paths.factor b/basis/io/paths/paths.factor
similarity index 96%
rename from extra/io/paths/paths.factor
rename to basis/io/paths/paths.factor
index 75d08b60f8..212ba9e396 100755
--- a/extra/io/paths/paths.factor
+++ b/basis/io/paths/paths.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays deques dlists io.files io.paths.private
+USING: accessors arrays deques dlists io.files
kernel sequences system vocabs.loader fry continuations ;
IN: io.paths
diff --git a/extra/io/paths/windows/authors.txt b/basis/io/paths/windows/authors.txt
similarity index 100%
rename from extra/io/paths/windows/authors.txt
rename to basis/io/paths/windows/authors.txt
diff --git a/extra/io/paths/windows/tags.txt b/basis/io/paths/windows/tags.txt
similarity index 100%
rename from extra/io/paths/windows/tags.txt
rename to basis/io/paths/windows/tags.txt
diff --git a/extra/io/paths/windows/windows.factor b/basis/io/paths/windows/windows.factor
similarity index 100%
rename from extra/io/paths/windows/windows.factor
rename to basis/io/paths/windows/windows.factor
From 29bd77d04061158090b50ae9215298d4b3f903a6 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 8 Dec 2008 21:32:09 -0600
Subject: [PATCH 28/46] Remove old trails
---
extra/processing/gallery/trails/trails.factor | 47 -------------------
1 file changed, 47 deletions(-)
delete mode 100644 extra/processing/gallery/trails/trails.factor
diff --git a/extra/processing/gallery/trails/trails.factor b/extra/processing/gallery/trails/trails.factor
deleted file mode 100644
index a5b2b7b02a..0000000000
--- a/extra/processing/gallery/trails/trails.factor
+++ /dev/null
@@ -1,47 +0,0 @@
-
-USING: kernel arrays sequences math math.order qualified
- sequences.lib circular processing ui newfx processing.shapes ;
-
-IN: processing.gallery.trails
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! Example 33-15 from the Processing book
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: point-list ( n -- seq ) [ drop 0 0 2array ] map <circular> ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: dot ( pos percent -- ) 1 swap - 25 * 5 max circle ;
-
-: step ( seq -- )
-
- no-stroke
- { 1 0.4 } fill
-
- 0 background
-
- mouse push-circular
- [ dot ]
- each-percent ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: go* ( -- )
-
- 500 500 size*
-
- [
- 100 point-list
- [ step ]
- curry
- draw
- ] setup
-
- run ;
-
-: go ( -- ) [ go* ] with-ui ;
-
-MAIN: go
From 101bc66b2b16d65fc16c576efafcf0e32b7f6553 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 8 Dec 2008 21:32:19 -0600
Subject: [PATCH 29/46] add a unit test to io.paths
---
basis/io/paths/paths-tests.factor | 11 +++++++++++
1 file changed, 11 insertions(+)
create mode 100644 basis/io/paths/paths-tests.factor
diff --git a/basis/io/paths/paths-tests.factor b/basis/io/paths/paths-tests.factor
new file mode 100644
index 0000000000..01763ce5c0
--- /dev/null
+++ b/basis/io/paths/paths-tests.factor
@@ -0,0 +1,11 @@
+USING: io.paths kernel tools.test io.files.unique sequences
+io.files namespaces sorting ;
+IN: io.paths.tests
+
+[ t ] [
+ [
+ 10 [ "io.paths.test" "gogogo" make-unique-file* ] replicate
+ current-directory get t [ ] find-all-files
+ ] with-unique-directory
+ [ natural-sort ] bi@ =
+] unit-test
From 154bc260c637c0c3670ad061648fc99243fdb076 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 8 Dec 2008 21:32:36 -0600
Subject: [PATCH 30/46] remove io.files.unique.backend rename
(make-unique-file) to touch-unique-file
---
basis/io/files/unique/backend/backend.factor | 5 ----
basis/io/files/unique/unique.factor | 25 +++++++++++++-------
basis/io/unix/files/unique/unique.factor | 4 ++--
basis/io/windows/files/unique/unique.factor | 8 +++----
4 files changed, 22 insertions(+), 20 deletions(-)
delete mode 100644 basis/io/files/unique/backend/backend.factor
diff --git a/basis/io/files/unique/backend/backend.factor b/basis/io/files/unique/backend/backend.factor
deleted file mode 100644
index 7b9809fa28..0000000000
--- a/basis/io/files/unique/backend/backend.factor
+++ /dev/null
@@ -1,5 +0,0 @@
-USING: io.backend ;
-IN: io.files.unique.backend
-
-HOOK: (make-unique-file) io-backend ( path -- )
-HOOK: temporary-path io-backend ( -- path )
diff --git a/basis/io/files/unique/unique.factor b/basis/io/files/unique/unique.factor
index ec89517bbc..66540fb48e 100644
--- a/basis/io/files/unique/unique.factor
+++ b/basis/io/files/unique/unique.factor
@@ -1,11 +1,13 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.bitwise math.parser
-random sequences continuations namespaces
-io.files io arrays io.files.unique.backend system
-combinators vocabs.loader fry ;
+USING: kernel math math.bitwise math.parser random sequences
+continuations namespaces io.files io arrays system
+combinators vocabs.loader fry io.backend ;
IN: io.files.unique
+HOOK: touch-unique-file io-backend ( path -- )
+HOOK: temporary-path io-backend ( -- path )
+
SYMBOL: unique-length
SYMBOL: unique-retries
@@ -26,12 +28,17 @@ SYMBOL: unique-retries
PRIVATE>
+: (make-unique-file) ( path prefix suffix -- path )
+ '[
+ _ _ _ unique-length get random-name glue append-path
+ dup touch-unique-file
+ ] unique-retries get retry ;
+
: make-unique-file ( prefix suffix -- path )
- temporary-path -rot
- [
- unique-length get random-name glue append-path
- dup (make-unique-file)
- ] 3curry unique-retries get retry ;
+ [ temporary-path ] 2dip (make-unique-file) ;
+
+: make-unique-file* ( prefix suffix -- path )
+ [ current-directory get ] 2dip (make-unique-file) ;
: with-unique-file ( prefix suffix quot: ( path -- ) -- )
[ make-unique-file ] dip [ delete-file ] bi ; inline
diff --git a/basis/io/unix/files/unique/unique.factor b/basis/io/unix/files/unique/unique.factor
index e47ac6a2e3..24dcdcb65a 100644
--- a/basis/io/unix/files/unique/unique.factor
+++ b/basis/io/unix/files/unique/unique.factor
@@ -1,13 +1,13 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel io.ports io.unix.backend math.bitwise
-unix io.files.unique.backend system ;
+unix system io.files.unique ;
IN: io.unix.files.unique
: open-unique-flags ( -- flags )
{ O_RDWR O_CREAT O_EXCL } flags ;
-M: unix (make-unique-file) ( path -- )
+M: unix touch-unique-file ( path -- )
open-unique-flags file-mode open-file close-file ;
M: unix temporary-path ( -- path ) "/tmp" ;
diff --git a/basis/io/windows/files/unique/unique.factor b/basis/io/windows/files/unique/unique.factor
index b1bf2bdc1c..ab99bf2cac 100644
--- a/basis/io/windows/files/unique/unique.factor
+++ b/basis/io/windows/files/unique/unique.factor
@@ -1,9 +1,9 @@
-USING: kernel system io.files.unique.backend
-windows.kernel32 io.windows io.windows.files io.ports windows
-destructors environment ;
+USING: kernel system windows.kernel32 io.windows
+io.windows.files io.ports windows destructors environment
+io.files.unique ;
IN: io.windows.files.unique
-M: windows (make-unique-file) ( path -- )
+M: windows touch-unique-file ( path -- )
GENERIC_WRITE CREATE_NEW 0 open-file dispose ;
M: windows temporary-path ( -- path )
From 4fccc7126d4bf478eaf76dde5025c5f8248a8526 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 21:49:26 -0600
Subject: [PATCH 31/46] Fix alien.strings docs
---
basis/alien/strings/strings-docs.factor | 4 ----
1 file changed, 4 deletions(-)
diff --git a/basis/alien/strings/strings-docs.factor b/basis/alien/strings/strings-docs.factor
index 3dc358336c..19c29e613e 100644
--- a/basis/alien/strings/strings-docs.factor
+++ b/basis/alien/strings/strings-docs.factor
@@ -31,10 +31,6 @@ HELP: string>symbol
$nl
"On Windows CE, symbols are represented as UCS2 strings, and on all other platforms they are ASCII strings." } ;
-HELP: utf16n
-{ $class-description "The encoding descriptor for UTF-16 without a byte order mark in native endian order. This is useful mostly for FFI calls which take input of strings of the type wchar_t*" }
-{ $see-also "encodings-introduction" } ;
-
ARTICLE: "c-strings" "C strings"
"C string types are arrays with shape " { $snippet "{ \"char*\" encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $snippet "\"char*\"" } " is an alias for " { $snippet "{ \"char*\" utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors."
$nl
From 08d0035ac873e91c8c4d48325d2afe72061347bf Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 8 Dec 2008 21:53:42 -0600
Subject: [PATCH 32/46] document new unique word
---
basis/io/files/unique/unique-docs.factor | 36 +++++++++++++++++++++---
1 file changed, 32 insertions(+), 4 deletions(-)
diff --git a/basis/io/files/unique/unique-docs.factor b/basis/io/files/unique/unique-docs.factor
index 825eb212f1..bfde09dc48 100644
--- a/basis/io/files/unique/unique-docs.factor
+++ b/basis/io/files/unique/unique-docs.factor
@@ -2,12 +2,40 @@ USING: help.markup help.syntax io io.ports kernel math
io.files.unique.private math.parser io.files ;
IN: io.files.unique
+HELP: temporary-path
+{ $values
+ { "path" "a pathname string" }
+}
+{ $description "A hook that returns the path of the temporary directory in a platform-specific way. Does not guarantee that path is writable by your user." } ;
+
+HELP: touch-unique-file
+{ $values
+ { "path" "a pathname string" }
+}
+{ $description "Creates a unique file in a platform-specific way. The file is guaranteed not to exist and is openable by your user." } ;
+
+HELP: unique-length
+{ $description "A symbol storing the number of random characters inserted between the prefix and suffix of a random file name." } ;
+
+HELP: unique-retries
+{ $description "The number of times to try creating a unique file in case of a name collision. The odds of a name collision are extremely low with a sufficient " { $link unique-length } "." } ;
+
+{ unique-length unique-retries } related-words
+
HELP: make-unique-file ( prefix suffix -- path )
{ $values { "prefix" "a string" } { "suffix" "a string" }
{ "path" "a pathname string" } }
{ $description "Creates a file that is guaranteed not to exist in a platform-specific temporary directory. The file name is composed of a prefix, a number of random digits and letters, and the suffix. Returns the full pathname." }
-{ $errors "Throws an error if a new unique file cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." }
-{ $see-also with-unique-file } ;
+{ $errors "Throws an error if a new unique file cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." } ;
+
+HELP: make-unique-file*
+{ $values
+ { "prefix" null } { "suffix" null }
+ { "path" "a pathname string" }
+}
+{ $description "Creates a file that is guaranteed not to exist in the directory in the " { $link current-directory } " variable. The file name is composed of a prefix, a number of random digits and letters, and the suffix. Returns the full pathname." } ;
+
+{ make-unique-file make-unique-file* with-unique-file } related-words
HELP: with-unique-file ( prefix suffix quot: ( path -- ) -- )
{ $values { "prefix" "a string" } { "suffix" "a string" }
@@ -18,8 +46,7 @@ HELP: with-unique-file ( prefix suffix quot: ( path -- ) -- )
HELP: make-unique-directory ( -- path )
{ $values { "path" "a pathname string" } }
{ $description "Creates a directory that is guaranteed not to exist in a platform-specific temporary directory and returns the full pathname." }
-{ $errors "Throws an error if the directory cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." }
-{ $see-also with-unique-directory } ;
+{ $errors "Throws an error if the directory cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." } ;
HELP: with-unique-directory ( quot -- )
{ $values { "quot" "a quotation" } }
@@ -30,6 +57,7 @@ ARTICLE: "io.files.unique" "Temporary files"
"The " { $vocab-link "io.files.unique" } " vocabulary implements cross-platform temporary file creation in a high-level and secure way." $nl
"Files:"
{ $subsection make-unique-file }
+{ $subsection make-unique-file* }
{ $subsection with-unique-file }
"Directories:"
{ $subsection make-unique-directory }
From b154b21aaa209f9387eafbf29d7d9b7299f50321 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 23:37:18 -0600
Subject: [PATCH 33/46] Add new until combinator, and a new do word which acts
like a modifier: do while, do until for loops which iterate at least once
---
basis/bit-arrays/bit-arrays.factor | 4 +-
.../combinators/combinators.factor | 2 +-
basis/io/encodings/utf16n/utf16n-docs.factor | 6 +++
basis/io/unix/launcher/launcher.factor | 5 +--
basis/tools/walker/walker.factor | 4 +-
core/bootstrap/primitives.factor | 2 +-
core/combinators/combinators-docs.factor | 2 -
core/kernel/kernel-docs.factor | 45 +++++++++++++++----
core/kernel/kernel.factor | 21 +++++----
core/math/integers/integers.factor | 2 +-
core/memory/memory.factor | 4 +-
core/slots/slots.factor | 2 +-
12 files changed, 67 insertions(+), 32 deletions(-)
create mode 100644 basis/io/encodings/utf16n/utf16n-docs.factor
diff --git a/basis/bit-arrays/bit-arrays.factor b/basis/bit-arrays/bit-arrays.factor
index d5e94f0238..d407f0b84d 100644
--- a/basis/bit-arrays/bit-arrays.factor
+++ b/basis/bit-arrays/bit-arrays.factor
@@ -73,11 +73,11 @@ M: bit-array byte-length length 7 + -3 shift ;
:: integer>bit-array ( n -- bit-array )
n zero? [ 0 <bit-array> ] [
[let | out [ n log2 1+ <bit-array> ] i! [ 0 ] n'! [ n ] |
- [ n' zero? not ] [
+ [ n' zero? ] [
n' out underlying>> i set-alien-unsigned-1
n' -8 shift n'!
i 1+ i!
- ] [ ] while
+ ] [ ] until
out
]
] if ;
diff --git a/basis/concurrency/combinators/combinators.factor b/basis/concurrency/combinators/combinators.factor
index 4608faf79b..932605fc36 100644
--- a/basis/concurrency/combinators/combinators.factor
+++ b/basis/concurrency/combinators/combinators.factor
@@ -22,7 +22,7 @@ PRIVATE>
] (parallel-each) ; inline
: parallel-filter ( seq quot -- newseq )
- over [ pusher [ each ] dip ] dip like ; inline
+ over [ pusher [ parallel-each ] dip ] dip like ; inline
<PRIVATE
diff --git a/basis/io/encodings/utf16n/utf16n-docs.factor b/basis/io/encodings/utf16n/utf16n-docs.factor
new file mode 100644
index 0000000000..9ccf4834d4
--- /dev/null
+++ b/basis/io/encodings/utf16n/utf16n-docs.factor
@@ -0,0 +1,6 @@
+USING: help.markup help.syntax ;
+IN: io.encodings.utf16n
+
+HELP: utf16n
+{ $class-description "The encoding descriptor for UTF-16 without a byte order mark in native endian order. This is useful mostly for FFI calls which take input of strings of the type wchar_t*" }
+{ $see-also "encodings-introduction" } ;
diff --git a/basis/io/unix/launcher/launcher.factor b/basis/io/unix/launcher/launcher.factor
index 0101ed613b..e80a372aef 100644
--- a/basis/io/unix/launcher/launcher.factor
+++ b/basis/io/unix/launcher/launcher.factor
@@ -36,9 +36,6 @@ USE: unix
: redirect-fd ( oldfd fd -- )
2dup = [ 2drop ] [ dup2 io-error ] if ;
-: redirect-inherit ( obj mode fd -- )
- 3drop ;
-
: redirect-file ( obj mode fd -- )
[ [ normalize-path ] dip file-mode open-file ] dip redirect-fd ;
@@ -50,7 +47,7 @@ USE: unix
: redirect ( obj mode fd -- )
{
- { [ pick not ] [ redirect-inherit ] }
+ { [ pick not ] [ 3drop ] }
{ [ pick string? ] [ redirect-file ] }
{ [ pick appender? ] [ redirect-file-append ] }
{ [ pick +closed+ eq? ] [ redirect-closed ] }
diff --git a/basis/tools/walker/walker.factor b/basis/tools/walker/walker.factor
index 953291cc59..27358b53fc 100644
--- a/basis/tools/walker/walker.factor
+++ b/basis/tools/walker/walker.factor
@@ -236,7 +236,7 @@ SYMBOL: +stopped+
: walker-loop ( -- )
+running+ set-status
- [ status +stopped+ eq? not ] [
+ [ status +stopped+ eq? ] [
[
{
! ignore these commands while the thread is
@@ -255,7 +255,7 @@ SYMBOL: +stopped+
[ walker-suspended ]
} case
] handle-synchronous
- ] [ ] while ;
+ ] [ ] until ;
: associate-thread ( walker -- )
walker-thread tset
diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index 42e1de19ee..cc05efc46e 100644
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -189,7 +189,7 @@ define-union-class
define-predicate-class
"array-capacity" "sequences.private" lookup
-[ >fixnum ] bootstrap-max-array-capacity [ fixnum-bitand ] curry append
+[ >fixnum ] bootstrap-max-array-capacity <fake-bignum> [ fixnum-bitand ] curry append
"coercer" set-word-prop
! Catch-all class for providing a default method.
diff --git a/core/combinators/combinators-docs.factor b/core/combinators/combinators-docs.factor
index 8d1d9f0d2a..a26c2fbe5d 100644
--- a/core/combinators/combinators-docs.factor
+++ b/core/combinators/combinators-docs.factor
@@ -12,8 +12,6 @@ ARTICLE: "combinators-quot" "Quotation construction utilities"
ARTICLE: "combinators" "Additional combinators"
"The " { $vocab-link "combinators" } " vocabulary provides a few useful combinators."
$nl
-"A looping combinator:"
-{ $subsection while }
"Generalization of " { $link bi } " and " { $link tri } ":"
{ $subsection cleave }
"Generalization of " { $link 2bi } " and " { $link 2tri } ":"
diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index 01ef8d480d..1404491d10 100644
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@@ -603,15 +603,15 @@ HELP: 3dip
HELP: while
{ $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } { "tail" "a quotation" } }
-{ $description "Repeatedly calls " { $snippet "pred" } ". If it yields " { $link f } ", iteration stops, otherwise " { $snippet "body" } " is called. After iteration stops, " { $snippet "tail" } " is called." }
-{ $notes "In most cases, tail recursion should be used, because it is simpler both in terms of implementation and conceptually. However in some cases this combinator expresses intent better and should be used."
-$nl
-"Strictly speaking, the " { $snippet "tail" } " is not necessary, since the following are equivalent:"
-{ $code
- "[ P ] [ Q ] [ T ] while"
- "[ P ] [ Q ] [ ] while T"
-}
-"However, depending on the stack effects of " { $snippet "pred" } " and " { $snippet "quot" } ", the " { $snippet "tail" } " quotation might need to be non-empty in order to balance out the stack effect of branches for stack effect inference." } ;
+{ $description "Calls " { $snippet "body" } " until " { $snippet "pred" } " returns " { $link f } "." } ;
+
+HELP: until
+{ $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } { "tail" "a quotation" } }
+{ $description "Calls " { $snippet "body" } " until " { $snippet "pred" } " returns " { $link t } "." } ;
+
+HELP: do
+{ $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } { "tail" "a quotation" } }
+{ $description "Executes one iteration of a " { $link while } " or " { $link until } " loop." } ;
HELP: loop
{ $values
@@ -627,6 +627,26 @@ HELP: loop
"3\n10\n6\n2\n9\n5\n1\n8\n4\n0\n7" }
} ;
+ARTICLE: "looping-combinators" "Looping combinators"
+"In most cases, loops should be written using high-level combinators (such as " { $link "sequences-combinators" } ") or tail recursion. However, sometimes, the best way to express intent is with a loop."
+{ $subsection while }
+{ $subsection until }
+"The above two combinators take a " { $snippet "tail" } " quotation. Strictly speaking, the " { $snippet "tail" } " is not necessary, since the following are equivalent:"
+{ $code
+ "[ P ] [ Q ] [ T ] while"
+ "[ P ] [ Q ] [ ] while T"
+}
+"However, depending on the stack effects of " { $snippet "pred" } " and " { $snippet "quot" } ", the " { $snippet "tail" } " quotation might need to be non-empty in order to balance out the stack effect of branches for stack effect inference."
+$nl
+"To execute one iteration of a loop, use the following word:"
+{ $subsection do }
+"This word is intended as a modifier. The normal " { $link while } " loop never executes the body if the predicate returns first on the first iteration. To ensure the body executes at least once, use " { $link do } ":"
+{ $code
+ "[ P ] [ Q ] [ T ] do while"
+}
+"A simpler looping combinator which executes a single quotation until it returns " { $link f } ":"
+{ $subsection loop } ;
+
HELP: assert
{ $values { "got" "the obtained value" } { "expect" "the expected value" } }
{ $description "Throws an " { $link assert } " error." }
@@ -899,13 +919,20 @@ ARTICLE: "dataflow" "Data and control flow"
{ $subsection "booleans" }
{ $subsection "shuffle-words" }
"A central concept in Factor is that of a " { $emphasis "combinator" } ", which is a word taking code as input."
+$nl
+"Data flow combinators:"
{ $subsection "slip-keep-combinators" }
{ $subsection "cleave-combinators" }
{ $subsection "spread-combinators" }
{ $subsection "apply-combinators" }
+"Control flow combinators:"
{ $subsection "conditionals" }
+{ $subsection "looping-combinators" }
+"Additional combinators:"
{ $subsection "compositional-combinators" }
{ $subsection "combinators" }
+"More combinators are defined for working on data structures, such as " { $link "sequences-combinators" } " and " { $link "assocs-combinators" } "."
+$nl
"Advanced topics:"
{ $subsection "assertions" }
{ $subsection "implementing-combinators" }
diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor
index 564600d322..d4df6fa407 100644
--- a/core/kernel/kernel.factor
+++ b/core/kernel/kernel.factor
@@ -129,14 +129,6 @@ DEFER: if
: 2bi@ ( w x y z quot -- )
dup 2bi* ; inline
-: loop ( pred: ( -- ? ) -- )
- dup slip swap [ loop ] [ drop ] if ; inline recursive
-
-: while ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- )
- [ dup slip ] 2dip roll
- [ [ tuck 2slip ] dip while ]
- [ 2nip call ] if ; inline recursive
-
! Object protocol
GENERIC: hashcode* ( depth obj -- code )
@@ -202,6 +194,19 @@ GENERIC: boa ( ... class -- tuple )
: most ( x y quot -- z )
[ 2dup ] dip call [ drop ] [ nip ] if ; inline
+! Loops
+: loop ( pred: ( -- ? ) -- )
+ dup slip swap [ loop ] [ drop ] if ; inline recursive
+
+: do ( pred body tail -- pred body tail )
+ over 3dip ; inline
+
+: while ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- )
+ [ pick 3dip [ do while ] 3curry ] keep if ; inline recursive
+
+: until ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- )
+ [ [ not ] compose ] 2dip while ; inline
+
! Error handling -- defined early so that other files can
! throw errors before continuations are loaded
: throw ( error -- * ) 5 getenv [ die ] or 1 (throw) ;
diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor
index b229ea175d..6ed945216e 100644
--- a/core/math/integers/integers.factor
+++ b/core/math/integers/integers.factor
@@ -41,7 +41,7 @@ M: fixnum bitnot fixnum-bitnot ;
M: fixnum bit? neg shift 1 bitand 0 > ;
: fixnum-log2 ( x -- n )
- 0 swap [ dup 1 eq? not ] [ [ 1+ ] [ 2/ ] bi* ] [ ] while drop ;
+ 0 swap [ dup 1 eq? ] [ [ 1+ ] [ 2/ ] bi* ] [ ] until drop ;
M: fixnum (log2) fixnum-log2 ;
diff --git a/core/memory/memory.factor b/core/memory/memory.factor
index 42527371f2..b67f7c94e8 100644
--- a/core/memory/memory.factor
+++ b/core/memory/memory.factor
@@ -4,7 +4,9 @@ USING: kernel continuations sequences vectors arrays system math ;
IN: memory
: (each-object) ( quot: ( obj -- ) -- )
- [ next-object dup ] swap [ drop ] while ; inline
+ next-object dup [
+ swap [ call ] keep (each-object)
+ ] [ 2drop ] if ; inline recursive
: each-object ( quot -- )
begin-scan [ (each-object) ] [ end-scan ] [ ] cleanup ; inline
diff --git a/core/slots/slots.factor b/core/slots/slots.factor
index 187db02c5c..438e604e78 100644
--- a/core/slots/slots.factor
+++ b/core/slots/slots.factor
@@ -199,7 +199,7 @@ M: array make-slot
swap
peel-off-name
peel-off-class
- [ dup empty? not ] [ peel-off-attributes ] [ ] while drop
+ [ dup empty? ] [ peel-off-attributes ] [ ] until drop
check-initial-value ;
M: slot-spec make-slot
From 7c1c97470f32b9efb26adbbd3501ce288a853b6a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Dec 2008 23:52:46 -0600
Subject: [PATCH 34/46] tuple-class-unchanged? was bogusly returning f during
bootstrap for classes without a superclass
---
core/classes/tuple/tuple.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index 9d748d665d..d9464399a9 100644
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -252,7 +252,7 @@ M: tuple-class update-class
: tuple-class-unchanged? ( class superclass slots -- ? )
[ over ] dip
- [ [ superclass ] dip = ]
+ [ [ superclass ] [ bootstrap-word ] bi* = ]
[ [ "slots" word-prop ] dip = ] 2bi* and ;
: valid-superclass? ( class -- ? )
From 8a1ba29743a5050b512c7aa26df84e0c3f5a9edc Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 9 Dec 2008 00:58:34 -0600
Subject: [PATCH 35/46] default values for file-systems slots
---
basis/tools/files/files.factor | 11 ++++++-----
1 file changed, 6 insertions(+), 5 deletions(-)
diff --git a/basis/tools/files/files.factor b/basis/tools/files/files.factor
index db49dcbf61..a8ce9c9554 100755
--- a/basis/tools/files/files.factor
+++ b/basis/tools/files/files.factor
@@ -44,12 +44,13 @@ percent-used percent-free ;
{ device-name [ device-name>> ] }
{ mount-point [ mount-point>> ] }
{ type [ type>> ] }
- { available-space [ available-space>> ] }
- { free-space [ free-space>> ] }
- { used-space [ used-space>> ] }
- { total-space [ total-space>> ] }
+ { available-space [ available-space>> [ 0 ] unless* ] }
+ { free-space [ free-space>> [ 0 ] unless* ] }
+ { used-space [ used-space>> [ 0 ] unless* ] }
+ { total-space [ total-space>> [ 0 ] unless* ] }
{ percent-used [
- [ used-space>> ] [ total-space>> ] bi dup 0 =
+ [ used-space>> ] [ total-space>> ] bi
+ [ [ 0 ] unless* ] bi@ dup 0 =
[ 2drop 0 ] [ / percent ] if
] }
} case ;
From db92c905691a0dfb48436555444b5bae6cc77c44 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 9 Dec 2008 01:04:15 -0600
Subject: [PATCH 36/46] Eliminate some usages of locals in
compiler.tree.dead-code
---
.../tree/dead-code/recursive/recursive.factor | 27 +++++++++----------
1 file changed, 12 insertions(+), 15 deletions(-)
diff --git a/basis/compiler/tree/dead-code/recursive/recursive.factor b/basis/compiler/tree/dead-code/recursive/recursive.factor
index 02dc42f058..71830d07e7 100644
--- a/basis/compiler/tree/dead-code/recursive/recursive.factor
+++ b/basis/compiler/tree/dead-code/recursive/recursive.factor
@@ -22,14 +22,11 @@ M: #call-recursive compute-live-values*
[ out-d>> ] [ label>> return>> in-d>> ] bi look-at-mapping ;
:: drop-dead-inputs ( inputs outputs -- #shuffle )
- [let* | live-inputs [ inputs filter-live ]
- new-live-inputs [ outputs inputs filter-corresponding make-values ] |
- live-inputs
- new-live-inputs
- outputs
- inputs
- drop-values
- ] ;
+ inputs filter-live
+ outputs inputs filter-corresponding make-values
+ outputs
+ inputs
+ drop-values ;
M: #enter-recursive remove-dead-code*
[ filter-live ] change-out-d ;
@@ -79,12 +76,12 @@ M: #call-recursive remove-dead-code*
bi
] ;
-M:: #recursive remove-dead-code* ( node -- nodes )
- [let* | drop-inputs [ node drop-recursive-inputs ]
- drop-outputs [ node drop-recursive-outputs ] |
- node [ (remove-dead-code) ] change-child drop
- node label>> [ filter-live ] change-enter-out drop
- { drop-inputs node drop-outputs }
- ] ;
+M: #recursive remove-dead-code* ( node -- nodes )
+ [ drop-recursive-inputs ]
+ [
+ [ (remove-dead-code) ] change-child
+ dup label>> [ filter-live ] change-enter-out drop
+ ]
+ [ drop-recursive-outputs ] tri 3array ;
M: #return-recursive remove-dead-code* ;
From 6286f9637926fb03fda33427b3c8cd268e262116 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 9 Dec 2008 01:04:22 -0600
Subject: [PATCH 37/46] :> now works
---
basis/locals/errors/errors.factor | 9 ++++++
basis/locals/locals-docs.factor | 29 +++++++++++++++++++
basis/locals/locals-tests.factor | 10 +++++++
basis/locals/locals.factor | 9 ++++--
basis/locals/parser/parser.factor | 19 +++++++-----
.../rewrite/point-free/point-free.factor | 7 ++---
6 files changed, 69 insertions(+), 14 deletions(-)
diff --git a/basis/locals/errors/errors.factor b/basis/locals/errors/errors.factor
index 9f9c2beecc..95c8357939 100644
--- a/basis/locals/errors/errors.factor
+++ b/basis/locals/errors/errors.factor
@@ -24,8 +24,17 @@ ERROR: local-word-in-literal-error ;
M: local-word-in-literal-error summary
drop "Local words not permitted inside literals" ;
+ERROR: :>-outside-lambda-error ;
+
+M: :>-outside-lambda-error summary
+ drop ":> cannot be used outside of lambda expressions" ;
+
ERROR: bad-lambda-rewrite output ;
M: bad-lambda-rewrite summary
drop "You have found a bug in locals. Please report." ;
+ERROR: bad-local args obj ;
+
+M: bad-local summary
+ drop "You have bound a bug in locals. Please report." ;
diff --git a/basis/locals/locals-docs.factor b/basis/locals/locals-docs.factor
index 89314aadc5..e9e1bfa16a 100644
--- a/basis/locals/locals-docs.factor
+++ b/basis/locals/locals-docs.factor
@@ -63,6 +63,33 @@ HELP: [wlet
}
} ;
+HELP: :>
+{ $syntax ":> binding" }
+{ $description "Introduces a new binding, lexically scoped to the enclosing quotation or definition." }
+{ $notes
+ "Lambda and let forms are really just syntax sugar for " { $link POSTPONE: :> } "."
+ $nl
+ "Lambdas desugar as follows:"
+ { $code
+ "[| a b | a b + b / ]"
+ "[ :> b :> a a b + b / ]"
+ }
+ "Let forms desugar as follows:"
+ { $code
+ "[|let | x [ 10 random ] | { x x } ]"
+ "10 random :> x { x x }"
+ }
+}
+{ $examples
+ { $code
+ "USING: locals math kernel ;"
+ "IN: scratchpad"
+ ":: quadratic ( a b c -- x y )"
+ " b sq 4 a c * * - sqrt :> disc"
+ " b neg disc [ + ] [ - ] 2bi [ 2 a * / ] bi@ ;"
+ }
+} ;
+
HELP: ::
{ $syntax ":: word ( bindings... -- outputs... ) body... ;" }
{ $description "Defines a word with named inputs; it reads stack values into bindings from left to right, then executes the body with those bindings in lexical scope." }
@@ -209,6 +236,8 @@ $nl
{ $subsection POSTPONE: [wlet }
"Lambda abstractions:"
{ $subsection POSTPONE: [| }
+"Lightweight binding form:"
+{ $subsection POSTPONE: :> }
"Additional topics:"
{ $subsection "locals-literals" }
{ $subsection "locals-mutable" }
diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor
index f13c1d57fa..b5c201a5d9 100644
--- a/basis/locals/locals-tests.factor
+++ b/basis/locals/locals-tests.factor
@@ -441,6 +441,16 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
[ "USE: locals [| | [wlet | a [ 0 ] | { a } ] ]" eval ] must-fail
+[ "USE: locals [| | { :> a } ]" eval ] must-fail
+
+[ "USE: locals 3 :> a" eval ] must-fail
+
+[ 3 ] [ 3 [| | :> a a ] call ] unit-test
+
+[ 3 ] [ 3 [| | :> a! a ] call ] unit-test
+
+[ 3 ] [ 2 [| | :> a! a 1+ a! a ] call ] unit-test
+
:: wlet-&&-test ( a -- ? )
[wlet | is-integer? [ a integer? ]
is-even? [ a even? ]
diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor
index 2060222472..f745f6243f 100644
--- a/basis/locals/locals.factor
+++ b/basis/locals/locals.factor
@@ -1,10 +1,13 @@
! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
! See http://factorcode.org/license.txt for BSD license.
-USING: lexer locals.parser locals.types macros memoize parser
-sequences vocabs vocabs.loader words kernel ;
+USING: lexer macros memoize parser sequences vocabs
+vocabs.loader words kernel namespaces locals.parser locals.types
+locals.errors ;
IN: locals
-: :> scan <local> <def> parsed ; parsing
+: :>
+ scan locals get [ :>-outside-lambda-error ] unless*
+ [ make-local ] bind <def> parsed ; parsing
: [| parse-lambda parsed-lambda ; parsing
diff --git a/basis/locals/parser/parser.factor b/basis/locals/parser/parser.factor
index 5b2e7c3eeb..e6ab6c003c 100644
--- a/basis/locals/parser/parser.factor
+++ b/basis/locals/parser/parser.factor
@@ -20,6 +20,8 @@ IN: locals.parser
[ <local-word> [ dup name>> set ] [ ] [ ] tri ] dip
"local-word-def" set-word-prop ;
+SYMBOL: locals
+
: push-locals ( assoc -- )
use get push ;
@@ -29,11 +31,16 @@ IN: locals.parser
SYMBOL: in-lambda?
: (parse-lambda) ( assoc end -- quot )
- t in-lambda? [ parse-until ] with-variable
- >quotation swap pop-locals ;
+ [
+ in-lambda? on
+ over locals set
+ over push-locals
+ parse-until >quotation
+ swap pop-locals
+ ] with-scope ;
: parse-lambda ( -- lambda )
- "|" parse-tokens make-locals dup push-locals
+ "|" parse-tokens make-locals
\ ] (parse-lambda) <lambda> ;
: parse-binding ( end -- pair/f )
@@ -52,15 +59,14 @@ SYMBOL: in-lambda?
: parse-bindings ( end -- bindings vars )
[
[ (parse-bindings) ] H{ } make-assoc
- dup push-locals
] { } make swap ;
: parse-bindings* ( end -- words assoc )
[
[
namespace push-locals
-
(parse-bindings)
+ namespace pop-locals
] { } make-assoc
] { } make swap ;
@@ -73,13 +79,12 @@ SYMBOL: in-lambda?
: parse-wbindings ( end -- bindings vars )
[
[ (parse-wbindings) ] H{ } make-assoc
- dup push-locals
] { } make swap ;
: parse-locals ( -- vars assoc )
"(" expect ")" parse-effect
word [ over "declared-effect" set-word-prop ] when*
- in>> [ dup pair? [ first ] when ] map make-locals dup push-locals ;
+ in>> [ dup pair? [ first ] when ] map make-locals ;
: parse-locals-definition ( word -- word quot )
parse-locals \ ; (parse-lambda) <lambda>
diff --git a/basis/locals/rewrite/point-free/point-free.factor b/basis/locals/rewrite/point-free/point-free.factor
index 1741bf044f..bd322bfff3 100644
--- a/basis/locals/rewrite/point-free/point-free.factor
+++ b/basis/locals/rewrite/point-free/point-free.factor
@@ -1,14 +1,13 @@
! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays fry kernel locals.backend locals.types
-math quotations sequences words combinators make ;
+USING: accessors arrays fry kernel math quotations sequences
+words combinators make locals.backend locals.types
+locals.errors ;
IN: locals.rewrite.point-free
! Step 3: rewrite locals usage within a single quotation into
! retain stack manipulation
-ERROR: bad-local args obj ;
-
: local-index ( args obj -- n )
2dup '[ unquote _ eq? ] find drop
dup [ 2nip ] [ drop bad-local ] if ;
From 3ed7a56a7f1c8df0e940cd795945614289ad4aae Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 9 Dec 2008 01:42:02 -0600
Subject: [PATCH 38/46] Fix functors for locals changes
---
basis/functors/functors.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor
index 7dab80c22d..2029c0cf25 100644
--- a/basis/functors/functors.factor
+++ b/basis/functors/functors.factor
@@ -99,7 +99,7 @@ DEFER: ;FUNCTOR delimiter
: (FUNCTOR:) ( -- word def )
CREATE
- parse-locals
+ parse-locals dup push-locals
parse-functor-body swap pop-locals <lambda>
rewrite-closures first ;
From 645c9ac1296eb32ae413bef87e760f062c033170 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 9 Dec 2008 02:21:03 -0600
Subject: [PATCH 39/46] Fix load errors related to utf16n being moved to
io.encodings.utf16n
---
basis/tools/deploy/unix/unix.factor | 4 ++--
basis/tools/deploy/windows/windows.factor | 5 +++--
basis/windows/shell32/shell32.factor | 2 +-
basis/windows/windows.factor | 3 ++-
4 files changed, 8 insertions(+), 6 deletions(-)
diff --git a/basis/tools/deploy/unix/unix.factor b/basis/tools/deploy/unix/unix.factor
index 5e1d0be7fb..bd49155e84 100644
--- a/basis/tools/deploy/unix/unix.factor
+++ b/basis/tools/deploy/unix/unix.factor
@@ -1,8 +1,8 @@
! Copyright (C) 2008 James Cash
! See http://factorcode.org/license.txt for BSD license.
USING: io io.files io.backend kernel namespaces make sequences
-system tools.deploy.backend tools.deploy.config assocs
-hashtables prettyprint ;
+system tools.deploy.backend tools.deploy.config
+tools.deploy.config.editor assocs hashtables prettyprint ;
IN: tools.deploy.unix
: create-app-dir ( vocab bundle-name -- vm )
diff --git a/basis/tools/deploy/windows/windows.factor b/basis/tools/deploy/windows/windows.factor
index ec1259c777..6188e78b0e 100755
--- a/basis/tools/deploy/windows/windows.factor
+++ b/basis/tools/deploy/windows/windows.factor
@@ -1,8 +1,9 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io io.files kernel namespaces sequences system
-tools.deploy.backend tools.deploy.config assocs hashtables
-prettyprint combinators windows.shell32 windows.user32 ;
+tools.deploy.backend tools.deploy.config
+tools.deploy.config.editor assocs hashtables prettyprint
+combinators windows.shell32 windows.user32 ;
IN: tools.deploy.windows
: copy-dll ( bundle-name -- )
diff --git a/basis/windows/shell32/shell32.factor b/basis/windows/shell32/shell32.factor
index b071bee72a..eae796ac08 100644
--- a/basis/windows/shell32/shell32.factor
+++ b/basis/windows/shell32/shell32.factor
@@ -1,6 +1,6 @@
USING: alien alien.c-types alien.strings alien.syntax combinators
kernel windows windows.user32 windows.ole32
-windows.com windows.com.syntax io.files ;
+windows.com windows.com.syntax io.files io.encodings.utf16n ;
IN: windows.shell32
: CSIDL_DESKTOP HEX: 00 ; inline
diff --git a/basis/windows/windows.factor b/basis/windows/windows.factor
index 2fc1dbf122..d2250d6f7e 100644
--- a/basis/windows/windows.factor
+++ b/basis/windows/windows.factor
@@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.syntax alien.c-types alien.strings arrays
combinators kernel math namespaces parser prettyprint sequences
-windows.errors windows.types windows.kernel32 words ;
+windows.errors windows.types windows.kernel32 words
+io.encodings.utf16n ;
IN: windows
: lo-word ( wparam -- lo ) <short> *short ; inline
From 05e4626c4991c3fc263f152c3dbfc9c35c386353 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 9 Dec 2008 03:22:09 -0600
Subject: [PATCH 40/46] Clean up
---
basis/cpu/x86/assembler/assembler.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/cpu/x86/assembler/assembler.factor b/basis/cpu/x86/assembler/assembler.factor
index 2bea887295..3a98d47416 100644
--- a/basis/cpu/x86/assembler/assembler.factor
+++ b/basis/cpu/x86/assembler/assembler.factor
@@ -346,7 +346,7 @@ M: label JUMPcc (JUMPcc) label-fixup ;
: LEAVE ( -- ) HEX: c9 , ;
: RET ( n -- )
- dup zero? [ drop HEX: c3 , ] [ HEX: C2 , 2, ] if ;
+ dup zero? [ drop HEX: c3 , ] [ HEX: c2 , 2, ] if ;
! Arithmetic
From 1e1640abb3923176474caf73a3f836c4c539f6c8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 9 Dec 2008 03:22:38 -0600
Subject: [PATCH 41/46] Load fixes
---
basis/alien/strings/strings-tests.factor | 2 +-
basis/environment/winnt/winnt.factor | 2 +-
basis/io/encodings/utf16/utf16-tests.factor | 6 ------
basis/io/encodings/utf16n/utf16n-tests.factor | 8 ++++++++
basis/io/windows/files/files.factor | 8 ++++----
basis/io/windows/nt/files/files.factor | 12 ++++++------
basis/io/windows/nt/monitors/monitors.factor | 4 ++--
basis/ui/windows/windows.factor | 3 ++-
basis/windows/winsock/winsock.factor | 2 +-
basis/x11/xim/xim.factor | 2 +-
10 files changed, 26 insertions(+), 23 deletions(-)
create mode 100644 basis/io/encodings/utf16n/utf16n-tests.factor
diff --git a/basis/alien/strings/strings-tests.factor b/basis/alien/strings/strings-tests.factor
index c1a509041e..263453ba1c 100644
--- a/basis/alien/strings/strings-tests.factor
+++ b/basis/alien/strings/strings-tests.factor
@@ -1,6 +1,6 @@
USING: alien.strings tools.test kernel libc
io.encodings.8-bit io.encodings.utf8 io.encodings.utf16
-io.encodings.ascii alien io.encodings.string ;
+io.encodings.utf16n io.encodings.ascii alien io.encodings.string ;
IN: alien.strings.tests
[ "\u0000ff" ]
diff --git a/basis/environment/winnt/winnt.factor b/basis/environment/winnt/winnt.factor
index 33cf6a698b..2ad3393aec 100644
--- a/basis/environment/winnt/winnt.factor
+++ b/basis/environment/winnt/winnt.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.strings fry io.encodings.utf16 kernel
+USING: alien.strings fry io.encodings.utf16n kernel
splitting windows windows.kernel32 system environment
alien.c-types sequences windows.errors io.streams.memory
io.encodings io ;
diff --git a/basis/io/encodings/utf16/utf16-tests.factor b/basis/io/encodings/utf16/utf16-tests.factor
index fd251c76db..bde92a260d 100644
--- a/basis/io/encodings/utf16/utf16-tests.factor
+++ b/basis/io/encodings/utf16/utf16-tests.factor
@@ -23,9 +23,3 @@ IN: io.encodings.utf16.tests
[ { CHAR: x } ] [ { HEX: fe HEX: ff 0 CHAR: x } utf16 decode >array ] unit-test
[ { HEX: ff HEX: fe 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16 encode >array ] unit-test
-
-: correct-endian
- code>> little-endian? [ utf16le = ] [ utf16be = ] if ;
-
-[ t ] [ B{ } utf16n <byte-reader> correct-endian ] unit-test
-[ t ] [ utf16n <byte-writer> correct-endian ] unit-test
diff --git a/basis/io/encodings/utf16n/utf16n-tests.factor b/basis/io/encodings/utf16n/utf16n-tests.factor
new file mode 100644
index 0000000000..d39f2470dd
--- /dev/null
+++ b/basis/io/encodings/utf16n/utf16n-tests.factor
@@ -0,0 +1,8 @@
+USING: accessors alien.c-type kernel io.streams.byte-array tools.test ;
+IN: io.encodings.utf16n
+
+: correct-endian
+ code>> little-endian? [ utf16le = ] [ utf16be = ] if ;
+
+[ t ] [ B{ } utf16n <byte-reader> correct-endian ] unit-test
+[ t ] [ utf16n <byte-writer> correct-endian ] unit-test
diff --git a/basis/io/windows/files/files.factor b/basis/io/windows/files/files.factor
index 83954e045b..894ddc83c6 100755
--- a/basis/io/windows/files/files.factor
+++ b/basis/io/windows/files/files.factor
@@ -1,10 +1,10 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types io.binary io.backend io.files io.buffers
-io.windows kernel math splitting fry alien.strings
-windows windows.kernel32 windows.time calendar combinators
-math.functions sequences namespaces make words symbols system
-io.ports destructors accessors math.bitwise continuations
+io.encodings.utf16n io.ports io.windows kernel math splitting
+fry alien.strings windows windows.kernel32 windows.time calendar
+combinators math.functions sequences namespaces make words
+symbols system destructors accessors math.bitwise continuations
windows.errors arrays byte-arrays ;
IN: io.windows.files
diff --git a/basis/io/windows/nt/files/files.factor b/basis/io/windows/nt/files/files.factor
index 9f25eb5eb1..e54f032873 100644
--- a/basis/io/windows/nt/files/files.factor
+++ b/basis/io/windows/nt/files/files.factor
@@ -1,10 +1,10 @@
USING: continuations destructors io.buffers io.files io.backend
-io.timeouts io.ports io.windows io.windows.files
-io.windows.nt.backend windows windows.kernel32
-kernel libc math threads system environment
-alien.c-types alien.arrays alien.strings sequences combinators
-combinators.short-circuit ascii splitting alien strings
-assocs namespaces make io.files.private accessors tr ;
+io.timeouts io.ports io.files.private io.windows
+io.windows.files io.windows.nt.backend io.encodings.ut16n
+windows windows.kernel32 kernel libc math threads system
+environment alien.c-types alien.arrays alien.strings sequences
+combinators combinators.short-circuit ascii splitting alien
+strings assocs namespaces make accessors tr ;
IN: io.windows.nt.files
M: winnt cwd
diff --git a/basis/io/windows/nt/monitors/monitors.factor b/basis/io/windows/nt/monitors/monitors.factor
index 30345c8c69..a2b7c4fa2d 100755
--- a/basis/io/windows/nt/monitors/monitors.factor
+++ b/basis/io/windows/nt/monitors/monitors.factor
@@ -5,8 +5,8 @@ kernel math assocs namespaces make continuations sequences
hashtables sorting arrays combinators math.bitwise strings
system accessors threads splitting io.backend io.windows
io.windows.nt.backend io.windows.nt.files io.monitors io.ports
-io.buffers io.files io.timeouts io.encodings.string io
-windows windows.kernel32 windows.types ;
+io.buffers io.files io.timeouts io.encodings.string
+io.encodings.utf16n io windows windows.kernel32 windows.types ;
IN: io.windows.nt.monitors
: open-directory ( path -- handle )
diff --git a/basis/ui/windows/windows.factor b/basis/ui/windows/windows.factor
index 1481287e95..0510e21f17 100755
--- a/basis/ui/windows/windows.factor
+++ b/basis/ui/windows/windows.factor
@@ -9,7 +9,8 @@ windows.user32 windows.opengl32 windows.messages windows.types
windows.nt windows threads libc combinators
combinators.short-circuit continuations command-line shuffle
opengl ui.render ascii math.bitwise locals symbols accessors
-math.geometry.rect math.order ascii calendar ;
+math.geometry.rect math.order ascii calendar
+io.encodings.utf16n ;
IN: ui.windows
SINGLETON: windows-ui-backend
diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor
index 4ca07ce850..5d450897e2 100644
--- a/basis/windows/winsock/winsock.factor
+++ b/basis/windows/winsock/winsock.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings alien.syntax arrays
byte-arrays kernel math sequences windows.types windows.kernel32
-windows.errors windows math.bitwise alias ;
+windows.errors windows math.bitwise alias io.encodings.utf16n ;
IN: windows.winsock
USE: libc
diff --git a/basis/x11/xim/xim.factor b/basis/x11/xim/xim.factor
index 71b0b5f133..862ec3355a 100644
--- a/basis/x11/xim/xim.factor
+++ b/basis/x11/xim/xim.factor
@@ -3,7 +3,7 @@
USING: alien alien.c-types alien.strings arrays byte-arrays
hashtables io io.encodings.string kernel math namespaces
sequences strings continuations x11.xlib specialized-arrays.uint
-accessors ;
+accessors io.encodings.utf16n ;
IN: x11.xim
SYMBOL: xim
From 474b718337163a1d0a376d210d6538c748bb6a8c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 9 Dec 2008 04:20:20 -0600
Subject: [PATCH 42/46] Add ncleave combinator to generalizations
---
basis/generalizations/generalizations-docs.factor | 15 ++++++++++++++-
basis/generalizations/generalizations.factor | 4 ++++
2 files changed, 18 insertions(+), 1 deletion(-)
diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor
index 2380f5614d..3979e0518a 100644
--- a/basis/generalizations/generalizations-docs.factor
+++ b/basis/generalizations/generalizations-docs.factor
@@ -1,5 +1,5 @@
USING: help.syntax help.markup kernel sequences quotations
-math arrays ;
+math arrays combinators ;
IN: generalizations
HELP: nsequence
@@ -234,6 +234,18 @@ HELP: napply
}
} ;
+HELP: ncleave
+{ $values { "quots" "a sequence of quotations" } { "n" integer } }
+{ $description "A generalization of " { $link cleave } " and " { $link 2cleave } " that can work for any quotation arity."
+}
+{ $examples
+ "Some core words expressed in terms of " { $link ncleave } ":"
+ { $table
+ { { $link cleave } { $snippet "1 ncleave" } }
+ { { $link 2cleave } { $snippet "2 ncleave" } }
+ }
+} ;
+
HELP: mnswap
{ $values { "m" integer } { "n" integer } }
{ $description "Swaps the top " { $snippet "m" } " stack elements with the " { $snippet "n" } " elements directly underneath." }
@@ -269,6 +281,7 @@ $nl
{ $subsection nslip }
{ $subsection nkeep }
{ $subsection napply }
+{ $subsection ncleave }
"Generalized quotation construction:"
{ $subsection ncurry }
{ $subsection nwith } ;
diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor
index 3c24d20c8a..ae7437b346 100644
--- a/basis/generalizations/generalizations.factor
+++ b/basis/generalizations/generalizations.factor
@@ -69,6 +69,10 @@ MACRO: ncurry ( n -- )
MACRO: nwith ( n -- )
[ with ] n*quot ;
+MACRO: ncleave ( quots n -- )
+ [ '[ _ '[ _ _ nkeep ] ] map [ ] join ] [ '[ _ ndrop ] ] bi
+ compose ;
+
MACRO: napply ( n -- )
2 [a,b]
[ [ 1- ] [ ] bi '[ _ ntuck _ nslip ] ]
From 10e1c6b512dfcddbcb96c718c2d93ff6296eed86 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 9 Dec 2008 04:21:50 -0600
Subject: [PATCH 43/46] Fix monads unit tests
---
extra/monads/monads-tests.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/monads/monads-tests.factor b/extra/monads/monads-tests.factor
index d0014b5abe..44234bc4bc 100644
--- a/extra/monads/monads-tests.factor
+++ b/extra/monads/monads-tests.factor
@@ -1,4 +1,4 @@
-USING: tools.test monads math kernel sequences lists promises ;
+USING: tools.test math kernel sequences lists promises monads ;
IN: monads.tests
[ 5 ] [ 1 identity-monad return [ 4 + ] fmap run-identity ] unit-test
From 9ab4d53213d4d131b15772cb6eb0ab1579c61d12 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 9 Dec 2008 04:22:24 -0600
Subject: [PATCH 44/46] Fix io.encodings.utf16n unit tests
---
basis/io/encodings/utf16n/utf16n-tests.factor | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/basis/io/encodings/utf16n/utf16n-tests.factor b/basis/io/encodings/utf16n/utf16n-tests.factor
index d39f2470dd..5e7d1af8f5 100644
--- a/basis/io/encodings/utf16n/utf16n-tests.factor
+++ b/basis/io/encodings/utf16n/utf16n-tests.factor
@@ -1,4 +1,5 @@
-USING: accessors alien.c-type kernel io.streams.byte-array tools.test ;
+USING: accessors alien.c-types kernel
+io.encodings.utf16 io.streams.byte-array tools.test ;
IN: io.encodings.utf16n
: correct-endian
From ccab34e7c4a51cf7649bbcb31e503b6f840a607b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 9 Dec 2008 04:50:33 -0600
Subject: [PATCH 45/46] Fix restart behavior with circular vocabs, and add a
test for this
---
core/vocabs/loader/loader-tests.factor | 8 ++++++++
core/vocabs/loader/loader.factor | 1 +
core/vocabs/loader/test/j/j.factor | 2 ++
core/vocabs/loader/test/j/tags.txt | 1 +
core/vocabs/loader/test/k/k.factor | 2 ++
core/vocabs/loader/test/k/tags.txt | 1 +
6 files changed, 15 insertions(+)
create mode 100644 core/vocabs/loader/test/j/j.factor
create mode 100644 core/vocabs/loader/test/j/tags.txt
create mode 100644 core/vocabs/loader/test/k/k.factor
create mode 100644 core/vocabs/loader/test/k/tags.txt
diff --git a/core/vocabs/loader/loader-tests.factor b/core/vocabs/loader/loader-tests.factor
index e5bd74a981..533bea76fc 100644
--- a/core/vocabs/loader/loader-tests.factor
+++ b/core/vocabs/loader/loader-tests.factor
@@ -171,3 +171,11 @@ forget-junk
] with-compilation-unit
[ ] [ "vocabs.loader.test.h" require ] unit-test
+
+
+[
+ "vocabs.loader.test.j" forget-vocab
+ "vocabs.loader.test.k" forget-vocab
+] with-compilation-unit
+
+[ ] [ [ "vocabs.loader.test.j" require ] [ drop :1 ] recover ] unit-test
diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor
index 6fb0d08811..97fbfe8a07 100644
--- a/core/vocabs/loader/loader.factor
+++ b/core/vocabs/loader/loader.factor
@@ -65,6 +65,7 @@ ERROR: circular-dependency name ;
[
+parsing+ >>source-loaded?
dup vocab-source-path [ parse-file ] [ [ ] ] if*
+ [ +parsing+ >>source-loaded? ] dip
[ % ] [ assert-depth ] if-bootstrapping
+done+ >>source-loaded? drop
] [ ] [ f >>source-loaded? ] cleanup ;
diff --git a/core/vocabs/loader/test/j/j.factor b/core/vocabs/loader/test/j/j.factor
new file mode 100644
index 0000000000..6d545483a3
--- /dev/null
+++ b/core/vocabs/loader/test/j/j.factor
@@ -0,0 +1,2 @@
+IN: vocabs.loader.test.j
+"vocabs.loader.test.k" require
diff --git a/core/vocabs/loader/test/j/tags.txt b/core/vocabs/loader/test/j/tags.txt
new file mode 100644
index 0000000000..6bf68304bb
--- /dev/null
+++ b/core/vocabs/loader/test/j/tags.txt
@@ -0,0 +1 @@
+unportable
diff --git a/core/vocabs/loader/test/k/k.factor b/core/vocabs/loader/test/k/k.factor
new file mode 100644
index 0000000000..603b48b374
--- /dev/null
+++ b/core/vocabs/loader/test/k/k.factor
@@ -0,0 +1,2 @@
+IN: vocabs.loader.test.k
+USE: vocabs.loader.test.j
diff --git a/core/vocabs/loader/test/k/tags.txt b/core/vocabs/loader/test/k/tags.txt
new file mode 100644
index 0000000000..6bf68304bb
--- /dev/null
+++ b/core/vocabs/loader/test/k/tags.txt
@@ -0,0 +1 @@
+unportable
From 43fe6c56a220078d4a6b4d6bdadf67afd2d62aba Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 9 Dec 2008 06:02:39 -0600
Subject: [PATCH 46/46] Windows fixes
---
basis/unix/debugger/tags.txt | 1 +
extra/game-input/backend/dinput/dinput.factor | 13 +++++++------
2 files changed, 8 insertions(+), 6 deletions(-)
create mode 100644 basis/unix/debugger/tags.txt
diff --git a/basis/unix/debugger/tags.txt b/basis/unix/debugger/tags.txt
new file mode 100644
index 0000000000..6bf68304bb
--- /dev/null
+++ b/basis/unix/debugger/tags.txt
@@ -0,0 +1 @@
+unportable
diff --git a/extra/game-input/backend/dinput/dinput.factor b/extra/game-input/backend/dinput/dinput.factor
index 116faf60cd..b66a722258 100755
--- a/extra/game-input/backend/dinput/dinput.factor
+++ b/extra/game-input/backend/dinput/dinput.factor
@@ -1,10 +1,11 @@
-USING: windows.dinput windows.dinput.constants parser
-symbols alien.c-types windows.ole32 namespaces assocs kernel
-arrays vectors windows.kernel32 windows.com windows.dinput
-shuffle windows.user32 windows.messages sequences combinators
+USING: windows.dinput windows.dinput.constants parser symbols
+alien.c-types windows.ole32 namespaces assocs kernel arrays
+vectors windows.kernel32 windows.com windows.dinput shuffle
+windows.user32 windows.messages sequences combinators
math.geometry.rect ui.windows accessors math windows alien
-alien.strings io.encodings.utf16 continuations byte-arrays
-locals game-input.backend.dinput.keys-array ;
+alien.strings io.encodings.utf16 io.encodings.utf16n
+continuations byte-arrays locals
+game-input.backend.dinput.keys-array ;
<< "game-input" (use+) >>
IN: game-input.backend.dinput