More cons cell removals

slava 2006-05-15 05:01:47 +00:00
parent fbfad83957
commit f3ce2a15ed
95 changed files with 173 additions and 324 deletions

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
IN: image
USING: errors generic hashtables io kernel kernel-internals
lists math memory namespaces parser prettyprint sequences
math memory namespaces parser prettyprint sequences
vectors words ;
"Bootstrap stage 1..." print flush
@ -56,6 +56,8 @@ vectors words ;
"/library/collections/queues.factor"
"/library/collections/graphs.factor"
"/library/quotations.factor"
"/library/math/random.factor"
"/library/math/constants.factor"
"/library/math/pow.factor"

View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: compiler generic help io io-internals kernel
kernel-internals lists math memory namespaces optimizer parser
kernel-internals math memory namespaces optimizer parser
sequences sequences-internals words ;
"Cross-referencing..." print flush

View File

@ -1,7 +1,7 @@
! Copyright (C) 2003, 2004 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
! Copyright (C) 2003, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: kernel
USING: errors hashtables io kernel-internals lists namespaces
USING: errors hashtables io kernel-internals namespaces
parser sequences strings ;
: run-user-init ( -- )
@ -11,11 +11,7 @@ parser sequences strings ;
[ try-run-file ] [ drop ] if
] when ;
: set-path ( value seq -- )
uncons swap over [ nest [ set-path ] bind ] [ nip set ] if ;
: cli-var-param ( name value -- )
swap ":" split >list set-path ;
: cli-var-param ( name value -- ) swap set-global ;
: cli-bool-param ( name -- ) "no-" ?head not cli-var-param ;

View File

@ -1,7 +1,11 @@
USING: kernel sequences objc cocoa objc-NSObject objc-NSApplication objc-NSWindow objc-NSMenu objc-NSMenuItem objc-FactorCallback gadgets gadgets-layouts gadgets-listener words compiler strings lists ;
USING: kernel sequences objc cocoa objc-NSObject
objc-NSApplication objc-NSWindow objc-NSMenu objc-NSMenuItem
objc-FactorCallback gadgets gadgets-layouts gadgets-listener
words compiler strings ;
! for words used by menu bar actions (copied from launchpad.factor)
USING: gadgets gadgets-browser gadgets-listener help inspector io kernel memory namespaces sequences gadgets-launchpad ;
USING: gadgets gadgets-browser gadgets-listener help inspector
io kernel memory namespaces sequences gadgets-launchpad ;
IN: cocoa
@ -13,7 +17,7 @@ GENERIC: to-target-and-action ( selector-string-or-quotation -- target action )
M: string to-target-and-action sel_registerName f swap ;
M: f to-target-and-action f ;
M: list to-target-and-action \ drop swons <FactorCallback> "perform:" sel_registerName ;
M: quotation to-target-and-action \ drop add* <FactorCallback> "perform:" sel_registerName ;
: <NSMenu> NSMenu [alloc] swap <NSString> [initWithTitle:] [autorelease] ;

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
IN: objc
USING: alien arrays compiler hashtables kernel kernel-internals
libc lists math namespaces sequences strings words ;
libc math namespaces sequences strings words ;
: init-method ( method alien -- )
>r first3 r>

View File

@ -7,7 +7,7 @@ DEFER: FactorUIWindowDelegate
USING: alien arrays cocoa errors freetype gadgets
gadgets-launchpad gadgets-layouts gadgets-listener gadgets-panes
hashtables kernel lists math namespaces objc objc-NSApplication
hashtables kernel math namespaces objc objc-NSApplication
objc-NSEvent objc-NSObject objc-NSOpenGLContext
objc-NSOpenGLView objc-NSView objc-NSWindow sequences threads ;
@ -70,8 +70,7 @@ H{ } clone views set-global
[ ] [ [charactersIgnoringModifiers] CF>string ] ?if ;
: event>gesture ( event -- gesture )
dup [modifierFlags] modifiers modifier swap key-code
add >list ;
dup [modifierFlags] modifiers modifier swap key-code add ;
: send-key-event ( view event -- )
>r view world-focus r> dup event>gesture pick handle-gesture

View File

@ -1,7 +1,7 @@
! Copyright (C) 2006 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
IN: objc
USING: alien arrays errors hashtables kernel lists math
USING: alien arrays errors hashtables kernel math
namespaces parser sequences strings words ;
TUPLE: selector name object ;

View File

@ -17,9 +17,6 @@ PREDICATE: general-list list ( list -- ? )
: uncons ( [[ car cdr ]] -- car cdr ) dup car swap cdr ; inline
: swons ( cdr car -- [[ car cdr ]] ) swap cons ; inline
: unit ( a -- [ a ] ) f cons ; inline
: 2car ( cons cons -- car car ) [ car ] 2apply ; inline
: 2cdr ( cons cons -- car car ) [ cdr ] 2apply ; inline
@ -40,7 +37,7 @@ M: general-list each ( list quot -- | quot: elt -- )
: (list-map) ( list quot -- list )
over [
over cdr over >r >r >r car r> call
r> r> rot >r (list-map) r> swons
r> r> rot >r (list-map) r> swap cons
] [
drop
] if ; inline
@ -71,16 +68,11 @@ M: cons = ( obj cons -- ? )
{ [ t ] [ 2dup 2car = >r 2cdr = r> and ] }
} cond ;
: curry ( obj quot -- quot ) >r literalize r> cons ;
: make-dip ( quot n -- quot )
dup \ >r <array> -rot \ r> <array> append3 >list ;
: (>list) ( n i seq -- list )
pick pick <= [
3drop [ ]
] [
2dup nth >r >r 1+ r> (>list) r> swons
2dup nth >r >r 1+ r> (>list) r> swap cons
] if ;
M: object >list ( seq -- list ) dup length 0 rot (>list) ;

View File

@ -6,7 +6,7 @@ USING: vectors ;
: namestack* ( -- ns ) 3 getenv { vector } declare ; inline
IN: namespaces
USING: arrays hashtables kernel kernel-internals lists math
USING: arrays hashtables kernel kernel-internals math
sequences strings words ;
: namestack ( -- ns ) namestack* clone ; inline
@ -57,11 +57,6 @@ SYMBOL: building
: # ( n -- ) number>string % ;
IN: lists
: alist>quot ( default alist -- quot )
[ [ first2 swap % , , \ if , ] [ ] make ] each ;
IN: sequences
: prune ( seq -- seq )

View File

@ -85,7 +85,6 @@ M: object map ( seq quot -- seq )
[ length ] 2apply max ; flushable
: 2each ( seq seq quot -- )
#! Don't use with lists.
-rot 2dup min-length [ (2each) ] repeat 3drop ; inline
: 2reduce ( seq seq identity quot -- value | quot: e x y -- z )

View File

@ -1,11 +1,9 @@
! Copyright (C) 2005 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: sequences
USING: arrays kernel lists math sequences-internals strings
USING: arrays kernel math sequences-internals strings
vectors ;
! Note that the sequence union does not include lists, or user
! defined tuples that respond to the sequence protocol.
UNION: sequence array string sbuf vector ;
: sequence= ( seq seq -- ? )

View File

@ -1,7 +1,7 @@
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: sequences
USING: generic kernel kernel-internals lists math namespaces
USING: generic kernel kernel-internals math namespaces
strings vectors ;
: head-slice ( n seq -- slice ) 0 -rot <slice> ; flushable

View File

@ -1,7 +1,7 @@
! Copyright (C) 2003, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: strings
USING: generic kernel kernel-internals lists math sequences
USING: generic kernel kernel-internals math sequences
sequences-internals ;
M: string hashcode

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
IN: alien
USING: compiler errors generic hashtables inference inspector
kernel lists namespaces sequences strings words ;
kernel namespaces sequences strings words ;
TUPLE: alien-callback return parameters quot xt ;
C: alien-callback make-node ;
@ -18,7 +18,7 @@ M: alien-callback-error summary ( error -- )
: callback-bottom ( node -- )
alien-callback-xt [ word-xt <alien> ] curry infer-quot ;
\ alien-callback [ [ string object general-list ] [ alien ] ]
\ alien-callback [ [ string object quotation ] [ alien ] ]
"infer-effect" set-word-prop
\ alien-callback [

View File

@ -3,7 +3,7 @@
IN: alien
USING: arrays assembler compiler compiler
errors generic hashtables inference inspector
io kernel kernel-internals lists math namespaces parser
io kernel kernel-internals math namespaces parser
prettyprint sequences strings words ;
TUPLE: alien-invoke library function return parameters ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: alien
USING: arrays hashtables io kernel lists math namespaces parser
USING: arrays hashtables io kernel math namespaces parser
sequences ;
: <alien> ( address -- alien ) f <displaced-alien> ; inline

View File

@ -2,7 +2,7 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: alien
USING: arrays compiler errors generic
hashtables kernel kernel-internals libc lists math namespaces
hashtables kernel kernel-internals libc math namespaces
parser sequences strings words ;
: <c-type> ( -- type )

View File

@ -2,7 +2,7 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: alien
USING: assembler compiler errors generic
hashtables kernel kernel-internals lists math namespaces parser
hashtables kernel kernel-internals math namespaces parser
sequences strings words ;
! Some code for interfacing with C structures.

View File

@ -1,7 +1,7 @@
! Copyright (C) 2005 Alex Chapman.
! See http://factorcode.org/license.txt for BSD license.
IN: !syntax
USING: alien compiler kernel lists math namespaces parser
USING: alien compiler kernel math namespaces parser
sequences syntax words ;
: DLL" skip-blank parse-string dlopen parsed ; parsing

View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: compiler
USING: errors hashtables inference io kernel lists math
USING: errors hashtables inference io kernel math
namespaces optimizer prettyprint sequences test words ;
: (compile) ( word -- )

View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: assembler
USING: alien generic hashtables kernel kernel-internals lists
USING: alien generic hashtables kernel kernel-internals
math memory namespaces ;
: compiled-base 18 getenv ; inline

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
IN: compiler
USING: arrays assembler errors generic hashtables inference
kernel kernel-internals lists math namespaces queues sequences
kernel kernel-internals math namespaces queues sequences
words ;
GENERIC: stack-reserve*
@ -130,7 +130,7 @@ M: #if generate-node ( node -- next )
! #call
: [with-template] ( quot template -- quot )
2array >list [ with-template ] append ;
2array >quotation [ with-template ] append ;
: define-intrinsic ( word quot template -- | quot: -- )
[with-template] "intrinsic" set-word-prop ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: inference
USING: arrays generic hashtables interpreter kernel lists math
USING: arrays generic hashtables interpreter kernel math
namespaces parser sequences words ;
! The dataflow IR is the first of the two intermediate

View File

@ -2,7 +2,7 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: inference
USING: arrays errors generic inspector interpreter io kernel
lists math namespaces parser prettyprint sequences strings
math namespaces parser prettyprint sequences strings
vectors words ;
! This variable takes a boolean value.
@ -88,7 +88,7 @@ M: wrapper apply-object wrapped apply-literal ;
GENERIC: infer-quot
M: general-list infer-quot ( quot -- )
M: quotation infer-quot ( quot -- )
#! Recursive calls to this word are made for nested
#! quotations.
[ terminated? get [ drop f ] [ apply-object t ] if ] all? drop ;

View File

@ -33,7 +33,7 @@ sequences strings vectors words prettyprint ;
\ eq? t "foldable" set-word-prop
! Primitive combinators
\ call [ [ general-list ] [ ] ] "infer-effect" set-word-prop
\ call [ [ quotation ] [ ] ] "infer-effect" set-word-prop
\ call [ pop-literal infer-quot-value ] "infer" set-word-prop
@ -43,7 +43,7 @@ sequences strings vectors words prettyprint ;
pop-literal unit infer-quot-value
] "infer" set-word-prop
\ if [ [ object general-list general-list ] [ ] ] "infer-effect" set-word-prop
\ if [ [ object quotation quotation ] [ ] ] "infer-effect" set-word-prop
\ if [
2 #drop node, pop-d pop-d swap 2array
@ -345,13 +345,13 @@ sequences strings vectors words prettyprint ;
\ getenv [ [ fixnum ] [ object ] ] "infer-effect" set-word-prop
\ setenv [ [ object fixnum ] [ ] ] "infer-effect" set-word-prop
\ stat [ [ string ] [ general-list ] ] "infer-effect" set-word-prop
\ (directory) [ [ string ] [ general-list ] ] "infer-effect" set-word-prop
\ stat [ [ string ] [ array ] ] "infer-effect" set-word-prop
\ (directory) [ [ string ] [ array ] ] "infer-effect" set-word-prop
\ gc [ [ fixnum ] [ ] ] "infer-effect" set-word-prop
\ gc-time [ [ string ] [ ] ] "infer-effect" set-word-prop
\ save-image [ [ string ] [ ] ] "infer-effect" set-word-prop
\ exit [ [ integer ] [ ] ] "infer-effect" set-word-prop
\ room [ [ ] [ integer integer integer integer general-list ] ] "infer-effect" set-word-prop
\ room [ [ ] [ integer integer integer integer array ] ] "infer-effect" set-word-prop
\ os-env [ [ string ] [ object ] ] "infer-effect" set-word-prop
\ millis [ [ ] [ integer ] ] "infer-effect" set-word-prop

View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: optimizer
USING: arrays errors generic hashtables inference kernel lists
USING: arrays errors generic hashtables inference kernel
math math-internals sequences words ;
! A system for associating dataflow optimizers with words.

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
IN: optimizer
USING: arrays generic hashtables inference kernel
kernel-internals lists math namespaces prettyprint sequences
kernel-internals math namespaces prettyprint sequences
words ;
! Some utilities for splicing in dataflow IR subtrees
@ -119,8 +119,8 @@ words ;
: inline-literals ( node literals -- node )
#! Make #shuffle -> #push -> #return -> successor
over drop-inputs [
>r >list [ literalize ] map dataflow [ subst-node ] keep
r> set-node-successor
>r >quotation [ literalize ] map dataflow
[ subst-node ] keep r> set-node-successor
] keep ;
: optimize-predicate ( #call -- node )

View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: optimizer
USING: generic hashtables inference io kernel lists math
USING: generic hashtables inference io kernel math
namespaces sequences test vectors ;
SYMBOL: optimizer-changed

View File

@ -1,6 +1,6 @@
IN: optimizer
USING: generic hashtables inference io kernel kernel-internals
lists math namespaces prettyprint sequences styles vectors words ;
math namespaces prettyprint sequences styles vectors words ;
! A simple tool for turning dataflow IR into quotations, for
! debugging purposes.

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
IN: compiler
USING: alien arrays assembler inference kernel
kernel-internals lists math memory namespaces words ;
kernel-internals math memory namespaces words ;
GENERIC: push-return-reg ( reg-class -- )
GENERIC: pop-return-reg ( reg-class -- )

View File

@ -1,7 +1,7 @@
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
USING: arrays compiler errors generic kernel kernel-internals
lists math namespaces parser sequences words ;
math namespaces parser sequences words ;
IN: assembler
! A postfix assembler for x86 and AMD64.

View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien arrays assembler generic kernel kernel-internals
lists math math-internals memory namespaces sequences words ;
math math-internals memory namespaces sequences words ;
IN: compiler
M: float-regs (%peek) ( vreg loc reg-class -- )

View File

@ -1,6 +1,6 @@
! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien arrays assembler kernel kernel-internals lists math
USING: alien arrays assembler kernel kernel-internals math
math-internals namespaces sequences words ;
IN: compiler

View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: errors
USING: kernel kernel-internals lists sequences ;
USING: kernel kernel-internals sequences ;
TUPLE: no-method object generic ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: generic
USING: arrays errors hashtables kernel kernel-internals lists
USING: arrays errors hashtables kernel kernel-internals
namespaces parser sequences strings words vectors math
math-internals ;

View File

@ -2,7 +2,7 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: generic
USING: arrays errors generic hashtables kernel kernel-internals
lists math namespaces sequences words ;
math namespaces sequences words ;
! Math combination for generic dyadic upgrading arithmetic.

View File

@ -2,7 +2,7 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: generic
USING: arrays kernel kernel-internals lists math namespaces
USING: arrays kernel kernel-internals math namespaces
parser sequences strings words ;
: define-typecheck ( class generic def -- )

View File

@ -1,5 +1,5 @@
IN: generic
USING: arrays errors hashtables kernel kernel-internals lists
USING: arrays errors hashtables kernel kernel-internals
math namespaces sequences vectors words ;
: picker ( dispatch# -- quot )

View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: generic
USING: arrays errors hashtables kernel kernel-internals lists
USING: arrays errors hashtables kernel kernel-internals
math namespaces parser sequences sequences-internals strings
vectors words ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: help
USING: arrays generic graphs hashtables io kernel lists
USING: arrays generic graphs hashtables io kernel
namespaces sequences strings words ;
: all-articles ( -- seq )

View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: help
USING: arrays generic hashtables io kernel lists namespaces
USING: arrays generic hashtables io kernel namespaces
parser prettyprint sequences strings styles vectors words ;
: uncons* dup first swap 1 swap tail ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2003, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: io
USING: kernel lists math sequences strings ;
USING: kernel math sequences strings ;
: be> ( seq -- x ) 0 [ >r 8 shift r> bitor ] reduce ;
: le> ( seq -- x ) <reversed> be> ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: io
USING: hashtables kernel lists math memory namespaces sequences
USING: hashtables kernel math memory namespaces sequences
strings styles ;
! Words for accessing filesystem meta-data.

View File

@ -23,7 +23,7 @@ M: object clone ;
: set-boot ( quot -- ) 8 setenv ;
: num-types ( -- n ) 19 ; inline
: num-types ( -- n ) 20 ; inline
: ? ( cond t f -- t/f ) rot [ drop ] [ nip ] if ; inline

18
library/quotations.factor Normal file
View File

@ -0,0 +1,18 @@
! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: kernel
USING: arrays lists namespaces sequences ;
UNION: quotation general-list ;
: >quotation >list ;
: make-dip ( quot n -- quot )
dup \ >r <array> -rot \ r> <array> append3 >quotation ;
: unit ( a -- [ a ] ) 1array >quotation ;
: curry ( obj quot -- quot ) >r unit r> append ;
: alist>quot ( default alist -- quot )
[ [ first2 swap % , , \ if , ] [ ] make ] each ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: parser
USING: errors generic io kernel lists math namespaces sequences
USING: errors generic io kernel math namespaces sequences
words ;
: file-vocabs ( -- )
@ -12,7 +12,7 @@ words ;
: parse-lines ( lines -- quot )
[
dup length [ ] [ 1+ line-number set (parse) ] 2reduce
>list
>quotation
] with-parser ;
: parse ( str -- code ) <string-reader> lines parse-lines ;

View File

@ -1,11 +1,10 @@
! Copyright (C) 2004, 2006 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
! See http://factorcode.org/license.txt for BSD license.
! Bootstrapping trick; see doc/bootstrap.txt.
IN: !syntax
USING: alien arrays errors generic hashtables kernel lists math
namespaces parser sequences strings syntax vectors
words ;
USING: alien arrays errors generic hashtables kernel math
namespaces parser sequences strings syntax vectors words ;
: (
CHAR: ) column [
@ -28,10 +27,8 @@ SYMBOL: t
: " parse-string parsed ; parsing
: SBUF" skip-blank parse-string >sbuf parsed ; parsing
: [ f ; parsing
: ] >list parsed ; parsing
: [[ f ; parsing
: ]] first2 parsed parsed ; parsing
: ; >list swap call ; parsing
: ] >quotation parsed ; parsing
: ; >quotation swap call ; parsing
: } swap call parsed ; parsing
: { [ >array ] [ ] ; parsing
: V{ [ >vector ] [ ] ; parsing

View File

@ -51,15 +51,6 @@ HELP: ] ""
{ $description "Marks the end of a literal list." }
{ $see-also POSTPONE: [ } ;
HELP: [[ "car cdr ]]"
{ $description "Parses two components making up a cons cell." }
{ $notes "The lists parsed with " { $link POSTPONE: [ } " and " { $link POSTPONE: ] } " are just a special case of " { $link POSTPONE: [[ } " and " { $link POSTPONE: ]] } ". The following two lines are equivalent:" { $code "[ 1 2 3 ]\n[[ 1 [[ 2 [[ 3 f ]] ]] ]]" } }
{ $see-also POSTPONE: ]] } ;
HELP: ]] ""
{ $description "Marks the end of a literal cons cell." }
{ $see-also POSTPONE: [[ } ;
HELP: } ""
{ $description "Marks the end of an array, vector, hashtable, complex number, tuple, or wrapper." }
{ $see-also POSTPONE: { POSTPONE: V{ POSTPONE: H{ POSTPONE: C{ POSTPONE: T{ POSTPONE: W{ } ;

View File

@ -118,12 +118,12 @@ SYMBOL: string-mode
global [
{
"scratchpad" "syntax" "arrays" "compiler" "errors"
"generic" "hashtables" "help" "inference" "inspector"
"io" "jedit" "kernel" "listener" "lists" "math" "memory"
"namespaces" "parser" "prettyprint" "queues" "sequences"
"shells" "strings" "styles" "test" "threads" "vectors"
"walker" "words"
"scratchpad" "syntax" "alien" "arrays" "compiler"
"errors" "generic" "hashtables" "help" "inference"
"inspector" "io" "jedit" "kernel" "listener" "math"
"memory" "namespaces" "optimizer" "parser" "prettyprint"
"queues" "sequences" "shells" "strings" "styles" "test"
"threads" "vectors" "walker" "words"
} set-use
"scratchpad" set-in
] bind

View File

@ -1,5 +1,5 @@
! Copyright (C) 2003, 2006 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
! See http://factorcode.org/license.txt for BSD license.
IN: prettyprint
USING: alien arrays generic hashtables io kernel lists math
namespaces parser sequences strings styles vectors words ;
@ -254,11 +254,8 @@ M: dll pprint* ( obj -- str ) dll-path "DLL\" " pprint-string ;
M: complex pprint* ( num -- )
>rect 2array \ C{ \ } pprint-sequence ;
M: cons pprint* ( list -- )
[
dup list? [ \ [ \ ] ] [ uncons 2array \ [[ \ ]] ] if
pprint-sequence
] check-recursion ;
M: quotation pprint* ( list -- )
[ \ [ \ ] pprint-sequence ] check-recursion ;
M: array pprint* ( vector -- )
[ \ { \ } pprint-sequence ] check-recursion ;
@ -328,11 +325,11 @@ M: wrapper pprint* ( wrapper -- )
: define-close t "pprint-close" set-word-prop ;
{
POSTPONE: [ POSTPONE: [[
POSTPONE: [
POSTPONE: { POSTPONE: V{ POSTPONE: H{
POSTPONE: W{
} [ define-open ] each
{
POSTPONE: ] POSTPONE: } POSTPONE: ]]
POSTPONE: ] POSTPONE: }
} [ define-close ] each

View File

@ -1,7 +1,7 @@
! Copyright (C) 2003, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: prettyprint
USING: arrays generic hashtables io kernel lists math namespaces
USING: arrays generic hashtables io kernel math namespaces
sequences strings styles words ;
: declaration. ( word prop -- )

View File

@ -1,10 +1,9 @@
IN: temporary
USING: arrays compiler kernel kernel-internals lists math
USING: arrays compiler kernel kernel-internals math
sequences strings test vectors sequences-internals ;
: <range> ( from to -- seq ) dup <slice> ; inline
: list-iter 100 [ 0 100000 <range> >list [ ] map drop ] times ; compiled
: vector-iter 100 [ 0 100000 <range> >vector [ ] map drop ] times ; compiled
: array-iter 100 [ 0 100000 <range> >array [ ] map drop ] times ; compiled
: string-iter 100 [ 0 100000 <range> >string [ ] map drop ] times ; compiled
@ -12,7 +11,6 @@ sequences strings test vectors sequences-internals ;
: reverse-iter 100 [ 0 100000 <range> >vector <reversed> [ ] map drop ] times ; compiled
: dot-iter 100 [ 0 100000 <range> dup v. drop ] times ; compiled
[ ] [ list-iter ] unit-test
[ ] [ vector-iter ] unit-test
[ ] [ array-iter ] unit-test
[ ] [ string-iter ] unit-test

View File

@ -1,5 +1,4 @@
IN: temporary
USE: lists
USE: prettyprint
USE: test
USE: words

View File

@ -1,6 +1,5 @@
IN: temporary
USE: kernel
USE: lists
USE: math
USE: namespaces
USE: test
@ -26,13 +25,12 @@ unit-test
unit-test
[ f ]
[ [[ 1 [[ 2 3 ]] ]] hashtable? ]
[ { 1 { 2 3 } } hashtable? ]
unit-test
! Test some hashcodes.
[ t ] [ [ 1 2 3 ] hashcode [ 1 2 3 ] hashcode = ] unit-test
[ t ] [ [[ f t ]] hashcode [[ f t ]] hashcode = ] unit-test
[ t ] [ [ 1 [ 2 3 ] 4 ] hashcode [ 1 [ 2 3 ] 4 ] hashcode = ] unit-test
[ t ] [ 12 hashcode 12 hashcode = ] unit-test

View File

@ -1,5 +1,5 @@
IN: temporary
USING: arrays kernel lists math namespaces sequences
USING: arrays kernel math namespaces sequences
sequences-internals strings test vectors ;
[ V{ 1 2 3 4 } ] [ 1 5 dup <slice> >vector ] unit-test

View File

@ -6,7 +6,6 @@ USE: namespaces
USE: strings
USE: test
USE: sequences
USE: lists
USE: vectors
[ ] [ 10 [ [ -1000000 <sbuf> ] catch drop ] times ] unit-test

View File

@ -1,5 +1,5 @@
IN: temporary
USING: errors kernel kernel-internals lists math namespaces
USING: arrays errors kernel kernel-internals math namespaces
sequences sequences-internals strings test vectors ;
[ ] [ 10 [ [ -1000000 <vector> ] catch drop ] times ] unit-test
@ -26,7 +26,7 @@ sequences sequences-internals strings test vectors ;
[ t ] [
100 [ drop 100 random-int ] map >vector
dup >list >vector =
dup >array >vector =
] unit-test
[ f ] [ V{ } V{ 1 2 3 } = ] unit-test
@ -34,10 +34,10 @@ sequences sequences-internals strings test vectors ;
[ f ] [ [ 1 2 ] V{ 1 2 3 } = ] unit-test
[ f ] [ V{ 1 2 } [ 1 2 3 ] = ] unit-test
[ [ 1 4 9 16 ] ]
[ { 1 4 9 16 } ]
[
[ 1 2 3 4 ]
>vector [ dup * ] map >list
>vector [ dup * ] map >array
] unit-test
[ t ] [ V{ } hashcode V{ } hashcode = ] unit-test
@ -91,5 +91,5 @@ sequences sequences-internals strings test vectors ;
[ 4 ] [ 5 V{ 1 2 3 4 5 } index ] unit-test
[ t ] [
100 >list dup >vector <reversed> >list >r reverse r> =
100 >array dup >vector <reversed> >array >r reverse r> =
] unit-test

View File

@ -1,19 +1,19 @@
IN: temporary
USING: arrays compiler kernel kernel-internals lists math
USING: arrays compiler kernel kernel-internals math
math-internals sequences strings test words ;
! Make sure that intrinsic ops compile to correct code.
[ 1 ] [ [[ 1 2 ]] [ 0 slot ] compile-1 ] unit-test
[ 1 ] [ [ [[ 1 2 ]] 0 slot ] compile-1 ] unit-test
[ 3 ] [ 3 1 2 cons [ [ 0 set-slot ] keep ] compile-1 car ] unit-test
[ 3 ] [ 3 1 2 [ cons [ 0 set-slot ] keep ] compile-1 car ] unit-test
[ 3 ] [ [ 3 1 2 cons [ 0 set-slot ] keep ] compile-1 car ] unit-test
[ 3 ] [ 3 1 2 cons [ [ 1 set-slot ] keep ] compile-1 cdr ] unit-test
[ 3 ] [ 3 1 2 [ cons [ 1 set-slot ] keep ] compile-1 cdr ] unit-test
[ 3 ] [ [ 3 1 2 cons [ 1 set-slot ] keep ] compile-1 cdr ] unit-test
[ 1 ] [ { 1 2 } [ 2 slot ] compile-1 ] unit-test
[ 1 ] [ [ { 1 2 } 2 slot ] compile-1 ] unit-test
[ 3 ] [ 3 1 2 2array [ [ 2 set-slot ] keep ] compile-1 first ] unit-test
[ 3 ] [ 3 1 2 [ 2array [ 2 set-slot ] keep ] compile-1 first ] unit-test
[ 3 ] [ [ 3 1 2 2array [ 2 set-slot ] keep ] compile-1 first ] unit-test
[ 3 ] [ 3 1 2 2array [ [ 3 set-slot ] keep ] compile-1 second ] unit-test
[ 3 ] [ 3 1 2 [ 2array [ 3 set-slot ] keep ] compile-1 second ] unit-test
[ 3 ] [ [ 3 1 2 2array [ 3 set-slot ] keep ] compile-1 second ] unit-test
! Write barrier hits on the wrong value were causing segfaults
[ -3 ] [ -3 1 2 [ cons [ 1 set-slot ] keep ] compile-1 cdr ] unit-test
[ -3 ] [ -3 1 2 [ 2array [ 3 set-slot ] keep ] compile-1 second ] unit-test
[ CHAR: b ] [ 1 "abc" [ char-slot ] compile-1 ] unit-test
[ CHAR: b ] [ 1 [ "abc" char-slot ] compile-1 ] unit-test

View File

@ -1,5 +1,5 @@
USING: arrays assembler compiler generic
hashtables inference kernel kernel-internals lists math
hashtables inference kernel kernel-internals math
optimizer prettyprint sequences strings test vectors words
sequences-internals ;
IN: temporary
@ -107,7 +107,7 @@ USE: optimizer
[ string ] [
\ string
[ integer string array reversed sbuf
slice vector general-list ]
slice vector quotation ]
[ class-compare ] sort min-class
] unit-test
@ -142,42 +142,33 @@ M: cons xyz xyz ;
! Test predicate inlining
: pred-test-1
dup cons? [
dup general-list? [ "general-list" ] [ "nope" ] if
] [
"not a cons"
] if ; compiled
[ [[ 1 2 ]] "general-list" ] [ [[ 1 2 ]] pred-test-1 ] unit-test
: pred-test-2
dup fixnum? [
dup integer? [ "integer" ] [ "nope" ] if
] [
"not a fixnum"
] if ; compiled
[ 1 "integer" ] [ 1 pred-test-2 ] unit-test
[ 1 "integer" ] [ 1 pred-test-1 ] unit-test
TUPLE: pred-test ;
: pred-test-3
: pred-test-2
dup tuple? [
dup pred-test? [ "pred-test" ] [ "nope" ] if
] [
"not a tuple"
] if ; compiled
[ T{ pred-test } "pred-test" ] [ T{ pred-test } pred-test-3 ] unit-test
[ T{ pred-test } "pred-test" ] [ T{ pred-test } pred-test-2 ] unit-test
: pred-test-4
: pred-test-3
dup pred-test? [
dup tuple? [ "pred-test" ] [ "nope" ] if
] [
"not a tuple"
] if ; compiled
[ T{ pred-test } "pred-test" ] [ T{ pred-test } pred-test-4 ] unit-test
[ T{ pred-test } "pred-test" ] [ T{ pred-test } pred-test-3 ] unit-test
! : inline-test
! "nom" = ; compiled

View File

@ -1,9 +1,9 @@
IN: temporary
USING: sequences ;
USE: errors
USE: kernel
USE: namespaces
USE: test
USE: lists
USE: parser
USE: io
USE: memory
@ -26,8 +26,6 @@ USE: memory
[ [ "2 car" ] parse ] catch print-error
[ car ] [ [ 5 car ] catch no-method-generic ] unit-test
[ f throw ] unit-test-fails
! See how well callstack overflow is handled

View File

@ -1,15 +1,13 @@
USING: hashtables namespaces generic test kernel math words
lists vectors alien sequences prettyprint io parser strings ;
USING: alien arrays generic hashtables io kernel math namespaces
parser prettyprint sequences strings test vectors words ;
IN: temporary
GENERIC: class-of
M: fixnum class-of drop "fixnum" ;
M: word class-of drop "word" ;
M: cons class-of drop "cons" ;
[ "fixnum" ] [ 5 class-of ] unit-test
[ "cons" ] [ [ 1 2 3 ] class-of ] unit-test
[ "word" ] [ \ class-of class-of ] unit-test
[ 3.4 class-of ] unit-test-fails
@ -33,16 +31,6 @@ M: f bool>str drop "false" ;
[ t ] [ t bool>str str>bool ] unit-test
[ f ] [ f bool>str str>bool ] unit-test
PREDICATE: cons nonempty-list list? ;
GENERIC: funny-length
M: cons funny-length drop 0 ;
M: nonempty-list funny-length length ;
[ 0 ] [ [[ 1 [[ 2 3 ]] ]] funny-length ] unit-test
[ 3 ] [ [ 1 2 3 ] funny-length ] unit-test
[ "hello" funny-length ] unit-test-fails
! Testing method sorting
GENERIC: sorting-test
M: fixnum sorting-test drop "fixnum" ;
@ -51,7 +39,7 @@ M: object sorting-test drop "object" ;
[ "object" ] [ f sorting-test ] unit-test
! Testing unions
UNION: funnies cons ratio complex ;
UNION: funnies ratio complex ;
GENERIC: funny
M: funnies funny drop 2 ;
@ -67,8 +55,6 @@ M: very-funny gooey sq ;
[ 1/4 ] [ 1/2 gooey ] unit-test
[ cons ] [ [ 1 2 ] class ] unit-test
: class<tests
[ object ] [ object object class-and ] unit-test
[ fixnum ] [ fixnum object class-and ] unit-test
@ -86,16 +72,10 @@ M: very-funny gooey sq ;
[ t ] [ \ integer \ object class< ] unit-test
[ f ] [ \ integer \ null class< ] unit-test
[ t ] [ \ null \ object class< ] unit-test
[ t ] [ \ list \ general-list class< ] unit-test
[ t ] [ \ list \ object class< ] unit-test
[ t ] [ \ null \ list class< ] unit-test
[ t ] [ \ generic \ compound class< ] unit-test
[ f ] [ \ compound \ generic class< ] unit-test
[ f ] [ \ cons \ list class< ] unit-test
[ f ] [ \ list \ cons class< ] unit-test
[ f ] [ \ reversed \ slice class< ] unit-test
[ f ] [ \ slice \ reversed class< ] unit-test ;
@ -152,12 +132,6 @@ GENERIC: stack-underflow
M: object stack-underflow 2drop ;
M: word stack-underflow 2drop ;
GENERIC: testing
M: cons testing 2 ;
M: f testing 3 ;
M: sequence testing 4 ;
[ [ 1 2 ] 2 ] [ [ 1 2 ] testing ] unit-test
GENERIC: union-containment
M: integer union-containment drop 1 ;
M: number union-containment drop 2 ;
@ -179,17 +153,11 @@ M: object complex-combination nip ;
TUPLE: shit ;
M: shit complex-combination cons ;
[ [[ T{ shit f } 5 ]] ] [ T{ shit f } 5 complex-combination ] unit-test
M: shit complex-combination 2array ;
[ { T{ shit f } 5 } ] [ T{ shit f } 5 complex-combination ] unit-test
[ t ] [ \ complex-combination generic? >boolean ] unit-test
! TUPLE: delegating-small-generic ;
! G: small-delegation [ over ] [ type ] ;
! M: shit small-delegation cons ;
!
! [ [[ T{ shit f } 5 ]] ] [ T{ delegating-small-generic T{ shit f } } 5 small-delegation ] unit-test
GENERIC: big-generic-test
M: fixnum big-generic-test "fixnum" ;
M: bignum big-generic-test "bignum" ;

View File

@ -1,5 +1,5 @@
IN: temporary
USING: arrays errors generic inference kernel lists math
USING: arrays errors generic inference kernel math
math-internals namespaces parser sequences test vectors ;
[ f ] [ f [ [ ] map-nodes ] with-node-iterator ] unit-test
@ -70,7 +70,7 @@ math-internals namespaces parser sequences test vectors ;
[ { 1 1 } ] [ [ simple-recursion-2 ] infer ] unit-test
: bad-recursion-2
dup [ uncons bad-recursion-2 ] [ ] if ;
dup [ dup first swap second bad-recursion-2 ] [ ] if ;
[ [ bad-recursion-2 ] infer ] unit-test-fails
@ -82,20 +82,20 @@ math-internals namespaces parser sequences test vectors ;
[ { 1 1 } ] [ [ funny-recursion ] infer ] unit-test
! Simple combinators
[ { 1 2 } ] [ [ [ car ] keep cdr ] infer ] unit-test
[ { 1 2 } ] [ [ [ first ] keep second ] infer ] unit-test
! Mutual recursion
DEFER: foe
: fie ( element obj -- ? )
dup cons? [ foe ] [ eq? ] if ;
dup array? [ foe ] [ eq? ] if ;
: foe ( element tree -- ? )
dup [
2dup car fie [
2dup first fie [
nip
] [
cdr dup cons? [
second dup array? [
foe
] [
fie
@ -132,7 +132,7 @@ SYMBOL: sym-test
: terminator-branch
dup [
car
length
] [
not-a-number
] if ;
@ -217,10 +217,7 @@ M: ratio xyz
[ t ] [ [ [ xyz ] infer ] catch inference-error? ] unit-test
[ { 2 1 } ] [ [ swons ] infer ] unit-test
[ { 1 2 } ] [ [ uncons ] infer ] unit-test
[ { 1 1 } ] [ [ unit ] infer ] unit-test
[ { 1 1 } ] [ [ list? ] infer ] unit-test
[ { 1 0 } ] [ [ >n ] infer ] unit-test
[ { 0 1 } ] [ [ n> ] infer ] unit-test
@ -256,10 +253,6 @@ M: ratio xyz
[ { 2 1 } ] [ [ member? ] infer ] unit-test
[ { 2 1 } ] [ [ remove ] infer ] unit-test
: bad-code "1234" car ;
[ { 0 1 } ] [ [ bad-code ] infer ] unit-test
[ 1234 infer ] unit-test-fails
! This form should not have a stack effect

View File

@ -3,7 +3,6 @@ USE: namespaces
USE: test
USE: kernel
USE: hashtables
USE: lists
[
[ f ] [ "-no-user-init" cli-arg ] unit-test

View File

@ -39,10 +39,6 @@ IN: temporary
[ 2 2 fixnum+ ] test-interpreter
] unit-test
[ V{ "Hey" "there" } ] [
[ [[ "Hey" "there" ]] uncons ] test-interpreter
] unit-test
[ V{ t } ] [
[ "XYZ" "XYZ" = ] test-interpreter
] unit-test

View File

@ -1,33 +0,0 @@
IN: temporary
USE: lists
USE: test
USE: sequences
[ f ] [ f car ] unit-test
[ f ] [ f cdr ] unit-test
[ 5 car ] unit-test-fails
[ "Hello world" cdr ] unit-test-fails
[ f ] [ f cons? ] unit-test
[ f ] [ t cons? ] unit-test
[ t ] [ [[ t f ]] cons? ] unit-test
[ [[ 1 2 ]] ] [ 1 2 cons ] unit-test
[ [ 1 ] ] [ 1 f cons ] unit-test
[ [[ 1 2 ]] ] [ 2 1 swons ] unit-test
[ [ 1 ] ] [ f 1 swons ] unit-test
[ [ [ [ ] ] ] ] [ [ ] unit unit ] unit-test
[ 1 ] [ [[ 1 2 ]] car ] unit-test
[ 2 ] [ [[ 1 2 ]] cdr ] unit-test
[ 1 2 ] [ [[ 1 2 ]] uncons ] unit-test
[ 1 [ 2 ] ] [ [ 1 2 ] uncons ] unit-test
[ 1 3 ] [ [[ 1 2 ]] [[ 3 4 ]] 2car ] unit-test
[ 2 4 ] [ [[ 1 2 ]] [[ 3 4 ]] 2cdr ] unit-test
[ f ] [ f peek ] unit-test

View File

@ -1,17 +0,0 @@
IN: temporary
USING: kernel lists sequences test ;
[ 3 ] [ [ 3 ] peek ] unit-test
[ 3 ] [ [ 1 2 3 ] peek ] unit-test
[ 3 ] [ [[ 1 [[ 2 [[ 3 4 ]] ]] ]] peek ] unit-test
[ 0 ] [ [ ] length ] unit-test
[ 3 ] [ [ 1 2 3 ] length ] unit-test
[ t ] [ f list? ] unit-test
[ f ] [ t list? ] unit-test
[ t ] [ [ 1 2 ] list? ] unit-test
[ f ] [ [[ 1 2 ]] list? ] unit-test
[ [ ] ] [ 0 >list ] unit-test
[ [ 0 1 2 3 ] ] [ 4 >list ] unit-test

View File

@ -1,17 +0,0 @@
IN: temporary
USE: lists
USE: namespaces
USE: test
USE: sequences
: cons@ [ cons ] change ;
[ [ 1 ] ] [ 1 f "x" set "x" cons@ "x" get ] unit-test
[ [[ 1 2 ]] ] [ 1 2 "x" set "x" cons@ "x" get ] unit-test
[ [ 1 2 ] ] [ 1 [ 2 ] "x" set "x" cons@ "x" get ] unit-test
[ [ 5 4 3 1 ] ] [
[ 5 4 3 2 1 ] "x" set
2 "x" [ remove ] change
"x" get
] unit-test

View File

@ -2,7 +2,6 @@ IN: temporary
USE: kernel
USE: math
USE: test
USE: lists
USE: sequences
[ -2 ] [ 1 bitnot ] unit-test

View File

@ -1,7 +1,6 @@
IN: temporary
USE: parser
USE: test
USE: lists
USE: kernel
USE: generic
USE: words
@ -60,12 +59,6 @@ unit-test
[ "\\u123" parse ] unit-test-fails
! Test improper lists
[ 2 ] [ "[[ 1 2 ]]" parse car cdr ] unit-test
[ "hello" ] [ "[[ 1 \"hello\" ]]" parse car cdr ] unit-test
[ C{ 1 2 } ] [ "[[ 1 C{ 1 2 } ]]" parse car cdr ] unit-test
! Test EOL comments in multiline strings.
[ [ "Hello" ] ] [ "#! This calls until-eol.\n\"Hello\"" parse ] unit-test

View File

@ -1,4 +1,4 @@
USING: alien io kernel lists math prettyprint sequences
USING: alien io kernel math prettyprint sequences
test words inference namespaces vectors ;
IN: temporary

View File

@ -1,7 +1,7 @@
! Copyright (C) 2003, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: test
USING: arrays errors hashtables inspector io kernel lists math
USING: arrays errors hashtables inspector io kernel math
memory namespaces parser prettyprint sequences strings words
vectors ;
@ -68,8 +68,6 @@ SYMBOL: failures
: tests
{
"lists/cons" "lists/lists"
"lists/namespaces"
"combinators"
"continuations" "errors"
"collections/hashtables" "collections/sbuf"

View File

@ -1,5 +1,5 @@
IN: temporary
USING: arrays generic hashtables kernel lists math namespaces
USING: arrays generic hashtables kernel math namespaces
sequences test words ;
[ 4 ] [
@ -29,7 +29,7 @@ DEFER: plist-test
] unit-test
[
[ t ] [ \ car "car" "lists" lookup = ] unit-test
[ t ] [ \ array? "array?" "arrays" lookup = ] unit-test
"test-scope" "scratchpad" create drop
] with-scope
@ -73,7 +73,7 @@ FORGET: forgotten
FORGET: another-forgotten
: another-forgotten ;
[ t ] [ \ car interned? ] unit-test
[ t ] [ \ + interned? ] unit-test
! I forgot remove-crossref calls!
: fee ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: words
USING: inspector io kernel lists math namespaces prettyprint
USING: inspector io kernel math namespaces prettyprint
sequences strings walker ;
: annotate ( word quot -- | quot: word def -- def )

View File

@ -2,7 +2,7 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: inspector
USING: arrays generic hashtables help io kernel kernel-internals
lists math prettyprint sequences strings vectors words ;
math prettyprint sequences strings vectors words ;
GENERIC: summary ( object -- string )
@ -45,7 +45,7 @@ M: sequence summary
" elements" append3
] if ;
M: list sheet 1array ;
M: quotation sheet 1array ;
M: vector sheet 1array ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: jedit
USING: arrays errors io kernel listener lists math namespaces
USING: arrays errors io kernel listener math namespaces
parser prettyprint sequences strings words ;
! Some words to send requests to a running jEdit instance to

View File

@ -1,7 +1,7 @@
! Copyright (C) 2003, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: listener
USING: errors hashtables io kernel lists math memory namespaces
USING: errors hashtables io kernel math memory namespaces
parser sequences strings styles vectors words ;
SYMBOL: listener-prompt
@ -28,7 +28,7 @@ SYMBOL: error-hook
] if ;
: read-multiline ( -- quot ? )
[ f depth (read-multiline) >r >list r> ] with-parser ;
[ f depth (read-multiline) >r >quotation r> ] with-parser ;
: listen-try
[

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
IN: memory
USING: arrays errors generic hashtables io kernel
kernel-internals lists math namespaces parser prettyprint
kernel-internals math namespaces parser prettyprint
sequences strings vectors words ;
: full-gc ( -- ) generations 1 - gc ;

View File

@ -2,7 +2,7 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: walker
USING: errors hashtables inspector interpreter io kernel
listener lists math namespaces prettyprint sequences strings
listener math namespaces prettyprint sequences strings
vectors words ;
: &s ( -- ) meta-d get stack. ;

View File

@ -3,7 +3,7 @@
IN: gadgets-browser
USING: arrays gadgets gadgets-buttons gadgets-labels
gadgets-layouts gadgets-panes gadgets-scrolling gadgets-theme
generic hashtables help inspector kernel lists math namespaces
generic hashtables help inspector kernel math namespaces
prettyprint sequences words ;
SYMBOL: components

View File

@ -2,8 +2,7 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: gadgets-buttons
USING: gadgets gadgets-borders gadgets-layouts gadgets-theme
generic io kernel lists math namespaces sequences sequences
styles threads ;
generic io kernel math namespaces sequences styles threads ;
TUPLE: button rollover? pressed? quot ;

View File

@ -2,8 +2,8 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: gadgets-editors
USING: arrays freetype gadgets gadgets-labels gadgets-layouts
gadgets-scrolling gadgets-theme generic kernel
lists math namespaces sequences strings styles threads ;
gadgets-scrolling gadgets-theme generic kernel math namespaces
sequences strings styles threads ;
! A blinking caret
TUPLE: caret ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: gadgets-layouts
USING: arrays gadgets generic kernel lists math namespaces
USING: arrays gadgets generic kernel math namespaces
sequences ;
! A frame arranges gadgets in a 3x3 grid, where the center

View File

@ -1,7 +1,7 @@
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: gadgets
USING: arrays generic hashtables kernel lists math
USING: arrays generic hashtables kernel math
namespaces sequences styles ;
SYMBOL: origin

View File

@ -30,7 +30,7 @@ namespaces queues sequences threads ;
: user-input ( str gadget -- )
[ dupd user-input* ] each-parent 2drop ;
! Mouse gestures are lists where the first element is one of:
! Mouse gestures are arrays where the first element is one of:
SYMBOL: motion
SYMBOL: drag
SYMBOL: button-up

View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: gadgets
USING: gadgets-layouts generic hashtables kernel lists math
USING: gadgets-layouts generic hashtables kernel math
namespaces sequences vectors ;
GENERIC: add-notify* ( gadget -- )

View File

@ -1,6 +1,6 @@
! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: errors gadgets generic hashtables kernel lists math
USING: errors gadgets generic hashtables kernel math
namespaces queues sequences ;
IN: gadgets-layouts

View File

@ -4,7 +4,7 @@ IN: gadgets-listener
USING: arrays gadgets gadgets-editors gadgets-labels
gadgets-layouts gadgets-panes gadgets-scrolling
gadgets-splitters gadgets-theme generic hashtables io jedit
kernel listener lists math namespaces parser prettyprint
kernel listener math namespaces parser prettyprint
sequences styles threads words ;
TUPLE: listener-gadget pane stack ;

View File

@ -3,7 +3,7 @@
IN: gadgets-outliner
USING: arrays gadgets gadgets-borders gadgets-buttons
gadgets-labels gadgets-layouts gadgets-panes gadgets-theme
generic io kernel lists math opengl sequences styles ;
generic io kernel math opengl sequences styles ;
! Vertical line.
TUPLE: guide color ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien arrays freetype gadgets-layouts generic hashtables
io kernel lists math namespaces opengl sequences strings
io kernel math namespaces opengl sequences strings
styles vectors ;
IN: gadgets

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
IN: gadgets-scrolling
USING: arrays gadgets gadgets-buttons gadgets-layouts
gadgets-theme generic kernel lists math namespaces sequences
gadgets-theme generic kernel math namespaces sequences
styles threads vectors ;
! An elevator has a thumb that may be moved up and down.

View File

@ -2,7 +2,7 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: gadgets-splitters
USING: arrays gadgets gadgets-layouts gadgets-theme generic
kernel lists math namespaces sequences styles ;
kernel math namespaces sequences styles ;
TUPLE: divider splitter ;

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
IN: io-internals
USING: alien arrays errors generic hashtables io kernel
kernel-internals lists math parser queues sequences strings
kernel-internals math parser queues sequences strings
threads unix-internals vectors words ;
! We want namespaces::bind to shadow the bind system call from

View File

@ -1,5 +1,5 @@
USING: alien arrays errors freetype gadgets gadgets-launchpad gadgets-layouts
gadgets-listener hashtables io kernel lists math namespaces prettyprint
gadgets-listener hashtables io kernel \ math namespaces prettyprint
sequences strings vectors words win32-api-messages win32-api ;
USING: inspector threads memory ;
IN: win32
@ -98,7 +98,7 @@ TUPLE: gadget-window world hWnd hDC hRC ;
: keystroke>gesture ( n -- list )
dup wm-keydown-codes hash* [ nip ] [ drop ch>string ] if
key-modifiers [ push ] keep >list ;
key-modifiers [ push ] keep ;
SYMBOL: lParam
SYMBOL: wParam

View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: words
USING: errors graphs hashtables kernel kernel-internals lists
USING: errors graphs hashtables kernel kernel-internals
math namespaces sequences strings vectors ;
M: word <=> [ word-name ] 2apply <=> ;

View File

@ -3,7 +3,7 @@
IN: x11
USING: arrays errors freetype gadgets gadgets-launchpad
gadgets-layouts gadgets-listener hashtables kernel
kernel-internals lists math namespaces opengl sequences
kernel-internals math namespaces opengl sequences
strings x11 ;
! In the X11 backend, world-handle is a pair { window context }.
@ -77,7 +77,7 @@ M: world motion-event ( event world -- )
: event>gesture ( event -- gesture )
dup XKeyEvent-state modifiers modifier
swap key-code [ add >list ] [ drop f ] if* ;
swap key-code [ add ] [ drop f ] if* ;
M: world key-down-event ( event world -- )
world-focus over event>gesture [