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

handle I/O on closed ports gracefully

cvs
Slava Pestov 2005-09-19 03:22:58 +00:00
parent a97c50abd0
commit 6b3c4eccfb
19 changed files with 353 additions and 340 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
TODO.FACTOR.txt
View File

@ -1,5 +1,6 @@
- quot>interp needs to go
- nodes: lazily create history, class/literal map hashes - nodes: lazily create history, class/literal map hashes
- delete no longer infers
- write tests for callcc and catch inference
+ ui: + ui:

2
library/bootstrap/boot-stage2.factor
View File

@ -8,7 +8,7 @@ sequences sequences-internals words ;
: pull-in ( ? list -- ) : pull-in ( ? list -- )
swap [ swap [
[ [
dup print run-resource dup print [ dup run-resource ] try drop
] each ] each
] [ ] [
drop drop

4
library/cli.factor
View File

@ -1,14 +1,14 @@
! Copyright (C) 2003, 2004 Slava Pestov. ! Copyright (C) 2003, 2004 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license. ! See http://factor.sf.net/license.txt for BSD license.
IN: command-line IN: command-line
USING: io kernel kernel-internals lists namespaces parser USING: errors io kernel kernel-internals lists namespaces parser
sequences strings ; sequences strings ;
! This file is run as the last stage of boot.factor; it relies ! This file is run as the last stage of boot.factor; it relies
! on all other words already being defined. ! on all other words already being defined.
: ?run-file ( file -- ) : ?run-file ( file -- )
dup exists? [ run-file ] [ drop ] ifte ; dup exists? [ [ dup run-file ] try drop ] [ drop ] ifte ;
: run-user-init ( -- ) : run-user-init ( -- )
#! Run user init file if it exists #! Run user init file if it exists

8
library/collections/sequences-epilogue.factor
View File

@ -109,14 +109,6 @@ M: object peek ( sequence -- element )
#! Get value at end of sequence and remove it. #! Get value at end of sequence and remove it.
dup peek swap pop* ; dup peek swap pop* ;
: adjoin ( elt seq -- )
2dup member? [ 2drop ] [ push ] ifte ;
: prune ( seq -- seq )
[
dup length <vector> swap [ over adjoin ] each
] keep like ; flushable
: join ( seq glue -- seq ) : join ( seq glue -- seq )
#! The new sequence is of the same type as glue. #! The new sequence is of the same type as glue.
swap dup empty? [ swap dup empty? [

38
library/continuations.factor
View File

@ -3,30 +3,39 @@
IN: kernel IN: kernel
USING: arrays errors lists namespaces sequences words vectors ; USING: arrays errors lists namespaces sequences words vectors ;
TUPLE: interp data call name catch ; TUPLE: continuation data c call name catch ;
: c-stack ( -- c-stack )
#! In the interpreter, this is a no-op. The compiler has an
#! an intrinsic for this word.
f ;
: set-c-stack ( c-stack -- )
[ "not supported" throw ] when ;
: continuation ( -- interp ) : continuation ( -- interp )
#! The continuation is reified from after the *caller* of #! The continuation is reified from after the *caller* of
#! this word returns. #! this word returns.
datastack callstack dup pop* dup pop* datastack c-stack callstack dup pop* dup pop*
namestack catchstack <interp> ; namestack catchstack <continuation> ; inline
: >interp< ( interp -- data call name catch ) : >continuation< ( continuation -- data c call name catch )
[ interp-data ] keep [ continuation-data ] keep
[ interp-call ] keep [ continuation-c ] keep
[ interp-name ] keep [ continuation-call ] keep
interp-catch ; [ continuation-name ] keep
continuation-catch ; inline
: continue ( continuation -- ) : continue ( continuation -- )
#! Restore a continuation. #! Restore a continuation.
>interp< >continuation< set-catchstack set-namestack set-callstack
set-catchstack set-namestack set-callstack set-datastack ; >r set-datastack r> set-c-stack ;
: continue-with ( object continuation -- object ) : continue-with ( object continuation -- object )
#! Restore a continuation, and place the object in the #! Restore a continuation, and place the object in the
#! restored data stack. #! restored data stack.
>interp< set-catchstack set-namestack >continuation< set-catchstack set-namestack set-callstack
>r swap >r set-datastack r> r> set-callstack ; >r swap >r set-datastack r> r> set-c-stack ;
: (callcc) ( terminator balance -- | quot: continuation -- ) : (callcc) ( terminator balance -- | quot: continuation -- )
#! Direct calls to this word will not compile correctly; #! Direct calls to this word will not compile correctly;
@ -36,9 +45,8 @@ TUPLE: interp data call name catch ;
#! The balance branch is never called, but it is there to #! The balance branch is never called, but it is there to
#! give the callcc form a stack effect. #! give the callcc form a stack effect.
>r >r >r >r
continuation dup interp-call dup pop* pop* continuation dup continuation-call dup pop* pop*
t r> r> ifte ; t r> r> ifte ; inline
inline
: callcc0 ( quot -- | quot: continuation -- ) : callcc0 ( quot -- | quot: continuation -- )
#! Call a quotation with the current continuation, which may #! Call a quotation with the current continuation, which may

6
library/errors.factor
View File

@ -5,7 +5,7 @@ DEFER: callcc1
DEFER: continue-with DEFER: continue-with
IN: errors IN: errors
USING: kernel-internals lists ; USING: kernel-internals lists sequences ;
! This is a very lightweight exception handling system. ! This is a very lightweight exception handling system.
@ -20,13 +20,13 @@ TUPLE: no-method object generic ;
: c> ( catch -- ) catchstack uncons set-catchstack ; : c> ( catch -- ) catchstack uncons set-catchstack ;
: (catch) ( try -- exception/f ) : (catch) ( try -- exception/f )
[ >c call f c> drop f ] callcc1 nip ; [ >c call f c> drop f ] callcc1 nip ; inline
: catch ( try catch -- ) : catch ( try catch -- )
#! Call the try quotation. If an error occurs restore the #! Call the try quotation. If an error occurs restore the
#! datastack, push the error, and call the catch block. #! datastack, push the error, and call the catch block.
#! If no error occurs, push f and call the catch block. #! If no error occurs, push f and call the catch block.
>r (catch) r> call ; >r (catch) r> call ; inline
: rethrow ( error -- ) : rethrow ( error -- )
#! Use rethrow when passing an error on from a catch block. #! Use rethrow when passing an error on from a catch block.

9
library/generic/generic.factor
View File

@ -39,14 +39,15 @@ SYMBOL: builtins
#! Outputs a sequence of classes whose union is this class. #! Outputs a sequence of classes whose union is this class.
[ (flatten) ] make-hash ; [ (flatten) ] make-hash ;
DEFER: types
: (types) ( class -- ) : (types) ( class -- )
#! Only valid for a flattened class. #! Only valid for a flattened class.
dup superclass [ types % ] [ "type" word-prop , ] ?ifte ; flatten [
car dup superclass
[ (types) ] [ "type" word-prop dup set ] ?ifte
] hash-each ;
: types ( class -- types ) : types ( class -- types )
[ flatten hash-keys [ (types) ] each ] { } make prune ; [ (types) ] make-hash hash-keys ;
DEFER: class< DEFER: class<

2
library/httpd/cont-responder.factor
View File

@ -139,7 +139,7 @@ DEFER: show
] show-final ; ] show-final ;
: >callable ( quot|interp|f -- interp ) : >callable ( quot|interp|f -- interp )
dup interp? [ dup continuation? [
[ continue-with ] cons [ continue-with ] cons
] when ; ] when ;

14
library/inference/known-words.factor
View File

@ -510,3 +510,17 @@ prettyprint ;
\ array>vector [ [ array ] [ vector ] ] "infer-effect" set-word-prop \ array>vector [ [ array ] [ vector ] ] "infer-effect" set-word-prop
\ array>vector t "flushable" set-word-prop \ array>vector t "flushable" set-word-prop
\ datastack [ [ ] [ vector ] ] "infer-effect" set-word-prop
\ set-datastack [ [ vector ] [ ] ] "infer-effect" set-word-prop
\ callstack [ [ ] [ vector ] ] "infer-effect" set-word-prop
\ set-callstack [ [ vector ] [ ] ] "infer-effect" set-word-prop
\ c-stack [
"c-stack cannot be compiled (yet)" throw
] "infer" set-word-prop
\ set-c-stack [
"set-c-stack cannot be compiled (yet)" throw
] "infer" set-word-prop

17
library/sdl/sdl-keyboard.factor
View File

@ -13,22 +13,17 @@ sequences ;
: SDL_EnableKeyRepeat ( delay interval -- ) : SDL_EnableKeyRepeat ( delay interval -- )
"int" "sdl" "SDL_EnableKeyRepeat" [ "int" "int" ] alien-invoke ; "int" "sdl" "SDL_EnableKeyRepeat" [ "int" "int" ] alien-invoke ;
: modifiers, ( mod -- ) : modifier ( mod -- str )
modifiers get [ [ modifiers [ uncons rot bitand 0 > ?, ] each-with ] [ ] make ;
uncons pick bitand 0 = [ drop ] [ , ] ifte
] each
drop ;
: keysym, ( sym -- ) : keysym ( sym -- str )
#! Return the original keysym number if its unknown. #! Return the original keysym number if its unknown.
[ keysyms get hash dup ] keep ? , ; [ keysyms hash dup ] keep ? ;
: keyboard-event>binding ( event -- binding ) : keyboard-event>binding ( event -- binding )
#! Turn a key event into a binding, which is a list where #! Turn a key event into a binding, which is a list where
#! all elements but the last one are modifier names looked #! all elements but the last one are modifier names looked
#! up the modifiers alist, and the last element is a keysym #! up the modifiers alist, and the last element is a keysym
#! look up in the keysyms hash. #! look up in the keysyms hash.
[ dup keyboard-event-mod modifier
dup keyboard-event-mod modifiers, swap keyboard-event-sym keysym add ;
keyboard-event-sym keysym,
] [ ] make prune ;

515
library/sdl/sdl-keysym.factor
View File

@ -5,267 +5,256 @@ IN: sdl USING: namespaces ;
! Here we smash left/right control/shift/alt for convinience. ! Here we smash left/right control/shift/alt for convinience.
! Later, something better needs to be done. ! Later, something better needs to be done.
SYMBOL: modifiers : modifiers
{
[[ "SHIFT" HEX: 0003 ]]
[[ "CTRL" HEX: 00c0 ]]
[[ "ALT" HEX: 0300 ]]
[[ "META" HEX: 0c00 ]]
} ;
[ : keysyms
[[ "SHIFT" HEX: 0001 ]] {{
[[ "SHIFT" HEX: 0002 ]] ! The keyboard syms have been cleverly chosen to map to ASCII
[[ "CTRL" HEX: 0040 ]] [[ 0 "UNKNOWN" ]]
[[ "CTRL" HEX: 0080 ]] [[ 8 "BACKSPACE" ]]
[[ "ALT" HEX: 0100 ]] [[ 9 "TAB" ]]
[[ "ALT" HEX: 0200 ]] [[ 12 "CLEAR" ]]
[[ "META" HEX: 0400 ]] [[ 13 "RETURN" ]]
[[ "META" HEX: 0800 ]] [[ 19 "PAUSE" ]]
! We ignore these two modifiers since they're mighty useless [[ 27 "ESCAPE" ]]
! [[ "NUM" HEX: 1000 ]] [[ 32 "SPACE" ]]
! [[ "CAPS" HEX: 2000 ]] [[ 33 "EXCLAIM" ]]
[[ "MODE" HEX: 4000 ]] [[ 34 "QUOTEDBL" ]]
] modifiers set [[ 35 "HASH" ]]
[[ 36 "DOLLAR" ]]
SYMBOL: keysyms [[ 38 "AMPERSAND" ]]
[[ 39 "QUOTE" ]]
{{ [[ 40 "LEFTPAREN" ]]
! The keyboard syms have been cleverly chosen to map to ASCII [[ 41 "RIGHTPAREN" ]]
[[ 0 "UNKNOWN" ]] [[ 42 "ASTERISK" ]]
! [[ 0 "FIRST" ]] [[ 43 "PLUS" ]]
[[ 8 "BACKSPACE" ]] [[ 44 "COMMA" ]]
[[ 9 "TAB" ]] [[ 45 "MINUS" ]]
[[ 12 "CLEAR" ]] [[ 46 "PERIOD" ]]
[[ 13 "RETURN" ]] [[ 47 "SLASH" ]]
[[ 19 "PAUSE" ]] [[ 48 0 ]]
[[ 27 "ESCAPE" ]] [[ 49 1 ]]
[[ 32 "SPACE" ]] [[ 50 2 ]]
[[ 33 "EXCLAIM" ]] [[ 51 3 ]]
[[ 34 "QUOTEDBL" ]] [[ 52 4 ]]
[[ 35 "HASH" ]] [[ 53 5 ]]
[[ 36 "DOLLAR" ]] [[ 54 6 ]]
[[ 38 "AMPERSAND" ]] [[ 55 7 ]]
[[ 39 "QUOTE" ]] [[ 56 8 ]]
[[ 40 "LEFTPAREN" ]] [[ 57 9 ]]
[[ 41 "RIGHTPAREN" ]] [[ 58 "COLON" ]]
[[ 42 "ASTERISK" ]] [[ 59 "SEMICOLON" ]]
[[ 43 "PLUS" ]] [[ 60 "LESS" ]]
[[ 44 "COMMA" ]] [[ 61 "EQUALS" ]]
[[ 45 "MINUS" ]] [[ 62 "GREATER" ]]
[[ 46 "PERIOD" ]] [[ 63 "QUESTION" ]]
[[ 47 "SLASH" ]] [[ 64 "AT" ]]
[[ 48 0 ]] ! Skip uppercase letters
[[ 49 1 ]] [[ 91 "LEFTBRACKET" ]]
[[ 50 2 ]] [[ 92 "BACKSLASH" ]]
[[ 51 3 ]] [[ 93 "RIGHTBRACKET" ]]
[[ 52 4 ]] [[ 94 "CARET" ]]
[[ 53 5 ]] [[ 95 "UNDERSCORE" ]]
[[ 54 6 ]] [[ 96 "BACKQUOTE" ]]
[[ 55 7 ]] [[ 97 "a" ]]
[[ 56 8 ]] [[ 98 "b" ]]
[[ 57 9 ]] [[ 99 "c" ]]
[[ 58 "COLON" ]] [[ 100 "d" ]]
[[ 59 "SEMICOLON" ]] [[ 101 "e" ]]
[[ 60 "LESS" ]] [[ 102 "f" ]]
[[ 61 "EQUALS" ]] [[ 103 "g" ]]
[[ 62 "GREATER" ]] [[ 104 "h" ]]
[[ 63 "QUESTION" ]] [[ 105 "i" ]]
[[ 64 "AT" ]] [[ 106 "j" ]]
! Skip uppercase letters [[ 107 "k" ]]
[[ 91 "LEFTBRACKET" ]] [[ 108 "l" ]]
[[ 92 "BACKSLASH" ]] [[ 109 "m" ]]
[[ 93 "RIGHTBRACKET" ]] [[ 110 "n" ]]
[[ 94 "CARET" ]] [[ 111 "o" ]]
[[ 95 "UNDERSCORE" ]] [[ 112 "p" ]]
[[ 96 "BACKQUOTE" ]] [[ 113 "q" ]]
[[ 97 "a" ]] [[ 114 "r" ]]
[[ 98 "b" ]] [[ 115 "s" ]]
[[ 99 "c" ]] [[ 116 "t" ]]
[[ 100 "d" ]] [[ 117 "u" ]]
[[ 101 "e" ]] [[ 118 "v" ]]
[[ 102 "f" ]] [[ 119 "w" ]]
[[ 103 "g" ]] [[ 120 "x" ]]
[[ 104 "h" ]] [[ 121 "y" ]]
[[ 105 "i" ]] [[ 122 "z" ]]
[[ 106 "j" ]] [[ 127 "DELETE" ]]
[[ 107 "k" ]] ! End of ASCII mapped keysyms
[[ 108 "l" ]] ! International keyboard syms
[[ 109 "m" ]] [[ 160 "WORLD_0" ]] ! 0xA0
[[ 110 "n" ]] [[ 161 "WORLD_1" ]]
[[ 111 "o" ]] [[ 162 "WORLD_2" ]]
[[ 112 "p" ]] [[ 163 "WORLD_3" ]]
[[ 113 "q" ]] [[ 164 "WORLD_4" ]]
[[ 114 "r" ]] [[ 165 "WORLD_5" ]]
[[ 115 "s" ]] [[ 166 "WORLD_6" ]]
[[ 116 "t" ]] [[ 167 "WORLD_7" ]]
[[ 117 "u" ]] [[ 168 "WORLD_8" ]]
[[ 118 "v" ]] [[ 169 "WORLD_9" ]]
[[ 119 "w" ]] [[ 170 "WORLD_10" ]]
[[ 120 "x" ]] [[ 171 "WORLD_11" ]]
[[ 121 "y" ]] [[ 172 "WORLD_12" ]]
[[ 122 "z" ]] [[ 173 "WORLD_13" ]]
[[ 127 "DELETE" ]] [[ 174 "WORLD_14" ]]
! End of ASCII mapped keysyms [[ 175 "WORLD_15" ]]
! International keyboard syms [[ 176 "WORLD_16" ]]
[[ 160 "WORLD_0" ]] ! 0xA0 [[ 177 "WORLD_17" ]]
[[ 161 "WORLD_1" ]] [[ 178 "WORLD_18" ]]
[[ 162 "WORLD_2" ]] [[ 179 "WORLD_19" ]]
[[ 163 "WORLD_3" ]] [[ 180 "WORLD_20" ]]
[[ 164 "WORLD_4" ]] [[ 181 "WORLD_21" ]]
[[ 165 "WORLD_5" ]] [[ 182 "WORLD_22" ]]
[[ 166 "WORLD_6" ]] [[ 183 "WORLD_23" ]]
[[ 167 "WORLD_7" ]] [[ 184 "WORLD_24" ]]
[[ 168 "WORLD_8" ]] [[ 185 "WORLD_25" ]]
[[ 169 "WORLD_9" ]] [[ 186 "WORLD_26" ]]
[[ 170 "WORLD_10" ]] [[ 187 "WORLD_27" ]]
[[ 171 "WORLD_11" ]] [[ 188 "WORLD_28" ]]
[[ 172 "WORLD_12" ]] [[ 189 "WORLD_29" ]]
[[ 173 "WORLD_13" ]] [[ 190 "WORLD_30" ]]
[[ 174 "WORLD_14" ]] [[ 191 "WORLD_31" ]]
[[ 175 "WORLD_15" ]] [[ 192 "WORLD_32" ]]
[[ 176 "WORLD_16" ]] [[ 193 "WORLD_33" ]]
[[ 177 "WORLD_17" ]] [[ 194 "WORLD_34" ]]
[[ 178 "WORLD_18" ]] [[ 195 "WORLD_35" ]]
[[ 179 "WORLD_19" ]] [[ 196 "WORLD_36" ]]
[[ 180 "WORLD_20" ]] [[ 197 "WORLD_37" ]]
[[ 181 "WORLD_21" ]] [[ 198 "WORLD_38" ]]
[[ 182 "WORLD_22" ]] [[ 199 "WORLD_39" ]]
[[ 183 "WORLD_23" ]] [[ 200 "WORLD_40" ]]
[[ 184 "WORLD_24" ]] [[ 201 "WORLD_41" ]]
[[ 185 "WORLD_25" ]] [[ 202 "WORLD_42" ]]
[[ 186 "WORLD_26" ]] [[ 203 "WORLD_43" ]]
[[ 187 "WORLD_27" ]] [[ 204 "WORLD_44" ]]
[[ 188 "WORLD_28" ]] [[ 205 "WORLD_45" ]]
[[ 189 "WORLD_29" ]] [[ 206 "WORLD_46" ]]
[[ 190 "WORLD_30" ]] [[ 207 "WORLD_47" ]]
[[ 191 "WORLD_31" ]] [[ 208 "WORLD_48" ]]
[[ 192 "WORLD_32" ]] [[ 209 "WORLD_49" ]]
[[ 193 "WORLD_33" ]] [[ 210 "WORLD_50" ]]
[[ 194 "WORLD_34" ]] [[ 211 "WORLD_51" ]]
[[ 195 "WORLD_35" ]] [[ 212 "WORLD_52" ]]
[[ 196 "WORLD_36" ]] [[ 213 "WORLD_53" ]]
[[ 197 "WORLD_37" ]] [[ 214 "WORLD_54" ]]
[[ 198 "WORLD_38" ]] [[ 215 "WORLD_55" ]]
[[ 199 "WORLD_39" ]] [[ 216 "WORLD_56" ]]
[[ 200 "WORLD_40" ]] [[ 217 "WORLD_57" ]]
[[ 201 "WORLD_41" ]] [[ 218 "WORLD_58" ]]
[[ 202 "WORLD_42" ]] [[ 219 "WORLD_59" ]]
[[ 203 "WORLD_43" ]] [[ 220 "WORLD_60" ]]
[[ 204 "WORLD_44" ]] [[ 221 "WORLD_61" ]]
[[ 205 "WORLD_45" ]] [[ 222 "WORLD_62" ]]
[[ 206 "WORLD_46" ]] [[ 223 "WORLD_63" ]]
[[ 207 "WORLD_47" ]] [[ 224 "WORLD_64" ]]
[[ 208 "WORLD_48" ]] [[ 225 "WORLD_65" ]]
[[ 209 "WORLD_49" ]] [[ 226 "WORLD_66" ]]
[[ 210 "WORLD_50" ]] [[ 227 "WORLD_67" ]]
[[ 211 "WORLD_51" ]] [[ 228 "WORLD_68" ]]
[[ 212 "WORLD_52" ]] [[ 229 "WORLD_69" ]]
[[ 213 "WORLD_53" ]] [[ 230 "WORLD_70" ]]
[[ 214 "WORLD_54" ]] [[ 231 "WORLD_71" ]]
[[ 215 "WORLD_55" ]] [[ 232 "WORLD_72" ]]
[[ 216 "WORLD_56" ]] [[ 233 "WORLD_73" ]]
[[ 217 "WORLD_57" ]] [[ 234 "WORLD_74" ]]
[[ 218 "WORLD_58" ]] [[ 235 "WORLD_75" ]]
[[ 219 "WORLD_59" ]] [[ 236 "WORLD_76" ]]
[[ 220 "WORLD_60" ]] [[ 237 "WORLD_77" ]]
[[ 221 "WORLD_61" ]] [[ 238 "WORLD_78" ]]
[[ 222 "WORLD_62" ]] [[ 239 "WORLD_79" ]]
[[ 223 "WORLD_63" ]] [[ 240 "WORLD_80" ]]
[[ 224 "WORLD_64" ]] [[ 241 "WORLD_81" ]]
[[ 225 "WORLD_65" ]] [[ 242 "WORLD_82" ]]
[[ 226 "WORLD_66" ]] [[ 243 "WORLD_83" ]]
[[ 227 "WORLD_67" ]] [[ 244 "WORLD_84" ]]
[[ 228 "WORLD_68" ]] [[ 245 "WORLD_85" ]]
[[ 229 "WORLD_69" ]] [[ 246 "WORLD_86" ]]
[[ 230 "WORLD_70" ]] [[ 247 "WORLD_87" ]]
[[ 231 "WORLD_71" ]] [[ 248 "WORLD_88" ]]
[[ 232 "WORLD_72" ]] [[ 249 "WORLD_89" ]]
[[ 233 "WORLD_73" ]] [[ 250 "WORLD_90" ]]
[[ 234 "WORLD_74" ]] [[ 251 "WORLD_91" ]]
[[ 235 "WORLD_75" ]] [[ 252 "WORLD_92" ]]
[[ 236 "WORLD_76" ]] [[ 253 "WORLD_93" ]]
[[ 237 "WORLD_77" ]] [[ 254 "WORLD_94" ]]
[[ 238 "WORLD_78" ]] [[ 255 "WORLD_95" ]] ! 0xFF
[[ 239 "WORLD_79" ]] ! Numeric keypad
[[ 240 "WORLD_80" ]] [[ 256 "KP0" ]]
[[ 241 "WORLD_81" ]] [[ 257 "KP1" ]]
[[ 242 "WORLD_82" ]] [[ 258 "KP2" ]]
[[ 243 "WORLD_83" ]] [[ 259 "KP3" ]]
[[ 244 "WORLD_84" ]] [[ 260 "KP4" ]]
[[ 245 "WORLD_85" ]] [[ 261 "KP5" ]]
[[ 246 "WORLD_86" ]] [[ 262 "KP6" ]]
[[ 247 "WORLD_87" ]] [[ 263 "KP7" ]]
[[ 248 "WORLD_88" ]] [[ 264 "KP8" ]]
[[ 249 "WORLD_89" ]] [[ 265 "KP9" ]]
[[ 250 "WORLD_90" ]] [[ 266 "KP_PERIOD" ]]
[[ 251 "WORLD_91" ]] [[ 267 "KP_DIVIDE" ]]
[[ 252 "WORLD_92" ]] [[ 268 "KP_MULTIPLY" ]]
[[ 253 "WORLD_93" ]] [[ 269 "KP_MINUS" ]]
[[ 254 "WORLD_94" ]] [[ 270 "KP_PLUS" ]]
[[ 255 "WORLD_95" ]] ! 0xFF [[ 271 "KP_ENTER" ]]
! Numeric keypad [[ 272 "KP_EQUALS" ]]
[[ 256 "KP0" ]] ! Arrows + Home/End pad
[[ 257 "KP1" ]] [[ 273 "UP" ]]
[[ 258 "KP2" ]] [[ 274 "DOWN" ]]
[[ 259 "KP3" ]] [[ 275 "RIGHT" ]]
[[ 260 "KP4" ]] [[ 276 "LEFT" ]]
[[ 261 "KP5" ]] [[ 277 "INSERT" ]]
[[ 262 "KP6" ]] [[ 278 "HOME" ]]
[[ 263 "KP7" ]] [[ 279 "END" ]]
[[ 264 "KP8" ]] [[ 280 "PAGEUP" ]]
[[ 265 "KP9" ]] [[ 281 "PAGEDOWN" ]]
[[ 266 "KP_PERIOD" ]] ! Function keys
[[ 267 "KP_DIVIDE" ]] [[ 282 "F1" ]]
[[ 268 "KP_MULTIPLY" ]] [[ 283 "F2" ]]
[[ 269 "KP_MINUS" ]] [[ 284 "F3" ]]
[[ 270 "KP_PLUS" ]] [[ 285 "F4" ]]
[[ 271 "KP_ENTER" ]] [[ 286 "F5" ]]
[[ 272 "KP_EQUALS" ]] [[ 287 "F6" ]]
! Arrows + Home/End pad [[ 288 "F7" ]]
[[ 273 "UP" ]] [[ 289 "F8" ]]
[[ 274 "DOWN" ]] [[ 290 "F9" ]]
[[ 275 "RIGHT" ]] [[ 291 "F10" ]]
[[ 276 "LEFT" ]] [[ 292 "F11" ]]
[[ 277 "INSERT" ]] [[ 293 "F12" ]]
[[ 278 "HOME" ]] [[ 294 "F13" ]]
[[ 279 "END" ]] [[ 295 "F14" ]]
[[ 280 "PAGEUP" ]] [[ 296 "F15" ]]
[[ 281 "PAGEDOWN" ]] ! Key state modifier keys
! Function keys [[ 300 "NUMLOCK" ]]
[[ 282 "F1" ]] [[ 301 "CAPSLOCK" ]]
[[ 283 "F2" ]] [[ 302 "SCROLLOCK" ]]
[[ 284 "F3" ]] [[ 303 "RSHIFT" ]]
[[ 285 "F4" ]] [[ 304 "LSHIFT" ]]
[[ 286 "F5" ]] [[ 305 "RCTRL" ]]
[[ 287 "F6" ]] [[ 306 "LCTRL" ]]
[[ 288 "F7" ]] [[ 307 "RALT" ]]
[[ 289 "F8" ]] [[ 308 "LALT" ]]
[[ 290 "F9" ]] [[ 309 "RMETA" ]]
[[ 291 "F10" ]] [[ 310 "LMETA" ]]
[[ 292 "F11" ]] [[ 311 "LSUPER" ]] ! Left "Windows" key
[[ 293 "F12" ]] [[ 312 "RSUPER" ]] ! Right "Windows" key
[[ 294 "F13" ]] [[ 313 "MODE" ]] ! "Alt Gr" key
[[ 295 "F14" ]] [[ 314 "COMPOSE" ]] ! Multi-key compose key
[[ 296 "F15" ]] ! Miscellaneous function keys
! Key state modifier keys [[ 315 "HELP" ]]
[[ 300 "NUMLOCK" ]] [[ 316 "PRINT" ]]
[[ 301 "CAPSLOCK" ]] [[ 317 "SYSREQ" ]]
[[ 302 "SCROLLOCK" ]] [[ 318 "BREAK" ]]
[[ 303 "RSHIFT" ]] [[ 319 "MENU" ]]
[[ 304 "LSHIFT" ]] [[ 320 "POWER" ]] ! Power Macintosh power key
[[ 305 "RCTRL" ]] [[ 321 "EURO" ]] ! Some european keyboards
[[ 306 "LCTRL" ]] [[ 322 "UNDO" ]] ! Atari keyboard has Undo
[[ 307 "RALT" ]] ! Add any other keys here
[[ 308 "LALT" ]] }} ;
[[ 309 "RMETA" ]]
[[ 310 "LMETA" ]]
[[ 311 "LSUPER" ]] ! Left "Windows" key
[[ 312 "RSUPER" ]] ! Right "Windows" key
[[ 313 "MODE" ]] ! "Alt Gr" key
[[ 314 "COMPOSE" ]] ! Multi-key compose key
! Miscellaneous function keys
[[ 315 "HELP" ]]
[[ 316 "PRINT" ]]
[[ 317 "SYSREQ" ]]
[[ 318 "BREAK" ]]
[[ 319 "MENU" ]]
[[ 320 "POWER" ]] ! Power Macintosh power key
[[ 321 "EURO" ]] ! Some european keyboards
[[ 322 "UNDO" ]] ! Atari keyboard has Undo
! Add any other keys here
}} keysyms set

2
library/test/collections/sequences.factor
View File

@ -64,8 +64,6 @@ unit-test
[ @{ @{ 1 4 }@ @{ 2 5 }@ @{ 3 6 }@ }@ ] [ @{ @{ 1 4 }@ @{ 2 5 }@ @{ 3 6 }@ }@ ]
[ @{ @{ 1 2 3 }@ @{ 4 5 6 }@ }@ flip ] unit-test [ @{ @{ 1 2 3 }@ @{ 4 5 6 }@ }@ flip ] unit-test
[ [ "a" 43 [ ] ] ] [ [ "a" 43 43 43 [ ] 43 "a" [ ] ] prune ] unit-test
[ f ] [ [ { } { } "Hello" ] all-equal? ] unit-test [ f ] [ [ { } { } "Hello" ] all-equal? ] unit-test
[ f ] [ [ { 2 } { } { } ] all-equal? ] unit-test [ f ] [ [ { 2 } { } { } ] all-equal? ] unit-test
[ t ] [ [ ] all-equal? ] unit-test [ t ] [ [ ] all-equal? ] unit-test

10
library/test/continuations.factor
View File

@ -31,14 +31,6 @@ USE: test
: multishot-test ( -- stack ) : multishot-test ( -- stack )
[ [
dup "cc" set 5 swap continue-with dup "cc" set 5 swap continue-with
] callcc1 "cc" get interp-data ; ] callcc1 "cc" get continuation-data ;
[ 5 { } ] [ multishot-test ] unit-test [ 5 { } ] [ multishot-test ] unit-test
[ ] [
[
global [ "x" set ] bind
[ global [ "x" get ] bind continue ] quot>interp
continue
] callcc0 global [ "x" off ] bind
] unit-test

1
library/test/inference.factor
View File

@ -223,7 +223,6 @@ DEFER: agent
[ @{ 1 1 }@ ] [ [ reverse ] infer ] unit-test [ @{ 1 1 }@ ] [ [ reverse ] infer ] unit-test
[ @{ 2 1 }@ ] [ [ member? ] infer ] unit-test [ @{ 2 1 }@ ] [ [ member? ] infer ] unit-test
[ @{ 2 1 }@ ] [ [ remove ] infer ] unit-test [ @{ 2 1 }@ ] [ [ remove ] infer ] unit-test
[ @{ 1 1 }@ ] [ [ prune ] infer ] unit-test
: bad-code "1234" car ; : bad-code "1234" car ;

8
library/tools/interpreter.factor
View File

@ -45,15 +45,17 @@ SYMBOL: meta-executing
meta-cf get [ meta-cf [ uncons ] change ] [ up next ] ifte ; meta-cf get [ meta-cf [ uncons ] change ] [ up next ] ifte ;
: meta-interp ( -- interp ) : meta-interp ( -- interp )
meta-d get meta-r get meta-n get meta-c get <interp> ; meta-d get f meta-r get meta-n get meta-c get
<continuation> ;
: set-meta-interp ( interp -- ) : set-meta-interp ( interp -- )
>interp< meta-c set meta-n set meta-r set meta-d set ; >continuation<
meta-c set meta-n set meta-r set drop meta-d set ;
: host-word ( word -- ) : host-word ( word -- )
[ [
\ call push-r continuation [ \ call push-r continuation [
continuation over interp-data push continue continuation over continuation-data push continue
] cons cons push-r meta-interp continue ] cons cons push-r meta-interp continue
] call set-meta-interp pop-d 2drop ; ] call set-meta-interp pop-d 2drop ;

2
library/ui/hand.factor
View File

@ -25,7 +25,7 @@ C: hand ( world -- hand )
dup hand-gadget over set-hand-clicked dup hand-gadget over set-hand-clicked
dup screen-loc over set-hand-click-loc dup screen-loc over set-hand-click-loc
dup hand-gadget over relative over set-hand-click-rel dup hand-gadget over relative over set-hand-click-rel
hand-buttons adjoin ; hand-buttons push ;
: button\ ( n hand -- ) : button\ ( n hand -- )
hand-buttons delete ; hand-buttons delete ;

43
library/unix/io.factor
View File

@ -2,8 +2,8 @@
! See http://factor.sf.net/license.txt for BSD license. ! See http://factor.sf.net/license.txt for BSD license.
IN: io-internals IN: io-internals
USING: alien arrays compiler-backend errors generic hashtables USING: alien arrays compiler-backend errors generic hashtables
io kernel kernel-internals lists math parser sequences io kernel kernel-internals lists math parser sequences strings
strings threads unix-internals vectors ; threads unix-internals vectors words ;
! We want namespaces::bind to shadow the bind system call from ! We want namespaces::bind to shadow the bind system call from
! unix-internals ! unix-internals
@ -49,7 +49,19 @@ SYMBOL: write-tasks
: init-handle ( fd -- ) F_SETFL O_NONBLOCK fcntl io-error ; : init-handle ( fd -- ) F_SETFL O_NONBLOCK fcntl io-error ;
! Common delegate of native stream readers and writers ! Common delegate of native stream readers and writers
TUPLE: port handle buffer error timeout cutoff output? sbuf eof? ; SYMBOL: input
SYMBOL: output
SYMBOL: closed
TUPLE: port handle error timeout cutoff type sbuf eof? ;
: check-port ( port expected -- )
>r port-type r> 2dup eq? [
[
"Cannot perform " % word-name %
" on " % word-name % " port" %
] "" make throw
] unless 2drop ;
: make-buffer ( n -- buffer/f ) : make-buffer ( n -- buffer/f )
dup 0 > [ <buffer> ] [ drop f ] ifte ; dup 0 > [ <buffer> ] [ drop f ] ifte ;
@ -150,7 +162,7 @@ GENERIC: task-container ( task -- vector )
! Readers ! Readers
: <reader> ( fd -- stream ) : <reader> ( fd -- stream )
buffered-port <line-reader> ; buffered-port input over set-port-type <line-reader> ;
: open-read ( path -- fd ) : open-read ( path -- fd )
O_RDONLY file-mode open dup io-error ; O_RDONLY file-mode open dup io-error ;
@ -212,10 +224,12 @@ M: read-task task-container drop read-tasks get ;
] unless 2drop ; ] unless 2drop ;
M: port stream-read ( count stream -- string ) M: port stream-read ( count stream -- string )
dup input check-port
[ wait-to-read ] keep dup port-eof? [ wait-to-read ] keep dup port-eof?
[ drop f ] [ port-sbuf >string ] ifte ; [ drop f ] [ port-sbuf >string ] ifte ;
M: port stream-read1 ( stream -- char/f ) M: port stream-read1 ( stream -- char/f )
dup input check-port
1 over wait-to-read dup port-eof? 1 over wait-to-read dup port-eof?
[ drop f ] [ port-sbuf first ] ifte ; [ drop f ] [ port-sbuf first ] ifte ;
@ -226,7 +240,7 @@ M: port stream-read1 ( stream -- char/f )
dup io-error ; dup io-error ;
: <writer> ( fd -- writer ) : <writer> ( fd -- writer )
buffered-port t over set-port-output? ; buffered-port output over set-port-type ;
: write-step ( port -- ) : write-step ( port -- )
dup >port< dup buffer@ swap buffer-length write dup 0 >= [ dup >port< dup buffer@ swap buffer-length write dup 0 >= [
@ -272,25 +286,30 @@ M: write-task task-container drop write-tasks get ;
] ifte* ; ] ifte* ;
M: port stream-flush ( stream -- ) M: port stream-flush ( stream -- )
dup port-output? [ dup output check-port
[ swap <write-task> add-write-io-task stop ] callcc0 [ swap <write-task> add-write-io-task stop ] callcc0 drop ;
] when drop ;
M: port stream-finish ( stream -- ) drop ; M: port stream-finish ( stream -- ) output check-port ;
: wait-to-write ( len port -- ) : wait-to-write ( len port -- )
tuck can-write? [ dup stream-flush ] unless pending-error ; tuck can-write? [ dup stream-flush ] unless pending-error ;
M: port stream-write1 ( char writer -- ) M: port stream-write1 ( char writer -- )
dup output check-port
1 over wait-to-write ch>buffer ; 1 over wait-to-write ch>buffer ;
M: port stream-format ( string style writer -- ) M: port stream-format ( string style writer -- )
dup output check-port
nip over length over wait-to-write >buffer ; nip over length over wait-to-write >buffer ;
M: port stream-close ( stream -- ) M: port stream-close ( stream -- )
dup stream-flush dup port-type closed eq? [
dup port-handle close dup port-type output eq? [ dup stream-flush ] when
delegate [ buffer-free ] when* ; dup port-handle close
dup delegate [ buffer-free ] when*
f over set-delegate
closed over set-port-type
] unless drop ;
! Make a duplex stream for reading/writing a pair of fds ! Make a duplex stream for reading/writing a pair of fds

3
library/unix/sockets.factor
View File

@ -67,7 +67,8 @@ TUPLE: server client ;
C: server ( port -- server ) C: server ( port -- server )
#! Starts listening for TCP connections on localhost:port. #! Starts listening for TCP connections on localhost:port.
[ >r server-socket 0 <port> r> set-delegate ] keep ; [ >r server-socket 0 <port> r> set-delegate ] keep
server over set-port-type ;
IN: io-internals IN: io-internals
USE: unix-internals USE: unix-internals

6
library/words.factor
View File

@ -24,9 +24,11 @@ M: word set-word-xt ( xt w -- ) 7 set-integer-slot ;
#! Outputs a list of words that this word directly calls. #! Outputs a list of words that this word directly calls.
[ [
dup word-def [ dup word-def [
dup word? [ 2dup eq? [ dup , ] unless ] when 2drop dup word?
[ 2dup eq? [ dup dup set ] unless ] when
2drop
] tree-each-with ] tree-each-with
] { } make prune ; ] make-hash hash-keys ;
! The cross-referencer keeps track of word dependencies, so that ! The cross-referencer keeps track of word dependencies, so that
! words can be recompiled when redefined. ! words can be recompiled when redefined.