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

basis/alien/c-types/c-types.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: byte-arrays arrays assocs kernel kernel.private libc math
 namespaces make parser sequences strings words assocs splitting
@@ -275,7 +275,7 @@ M: long-long-type box-return ( type -- )
 : if-void ( type true false -- )
     pick "void" = [ drop nip call ] [ nip call ] if ; inline
 
-: primitive-types
+CONSTANT: primitive-types
     {
         "char" "uchar"
         "short" "ushort"
@@ -284,7 +284,7 @@ M: long-long-type box-return ( type -- )
         "longlong" "ulonglong"
         "float" "double"
         "void*" "bool"
-    } ;
+    }
 
 [
     <c-type>

basis/alien/fortran/fortran.factor

@@ -170,8 +170,8 @@ M: character-type (fortran-type>c-type)
 
 : (parse-fortran-type) ( fortran-type-string -- type )
     parse-out swap parse-dims swap parse-size swap
-    dup >lower fortran>c-types at*
+    >lower fortran>c-types ?at
-    [ nip new-fortran-type ] [ drop misc-type boa ] if ;
+    [ new-fortran-type ] [ misc-type boa ] if ;
 
 : parse-fortran-type ( fortran-type-string/f -- type/f )
     dup [ (parse-fortran-type) ] when ;

basis/bootstrap/image/download/download.factor

@@ -4,7 +4,7 @@ USING: http.client checksums checksums.md5 splitting assocs
 kernel io.files bootstrap.image sequences io urls ;
 IN: bootstrap.image.download
 
-: url URL" http://factorcode.org/images/latest/" ;
+CONSTANT: url URL" http://factorcode.org/images/latest/"
 
 : download-checksums ( -- alist )
     url "checksums.txt" >url derive-url http-get nip

basis/bootstrap/image/image.factor

@@ -77,20 +77,20 @@ SYMBOL: objects
 
 ! Constants
 
-: image-magic HEX: 0f0e0d0c ; inline
+CONSTANT: image-magic HEX: 0f0e0d0c
-: image-version 4 ; inline
+CONSTANT: image-version 4
 
-: data-base 1024 ; inline
+CONSTANT: data-base 1024
 
-: userenv-size 70 ; inline
+CONSTANT: userenv-size 70
 
-: header-size 10 ; inline
+CONSTANT: header-size 10
 
-: data-heap-size-offset 3 ; inline
+CONSTANT: data-heap-size-offset 3
-: t-offset              6 ; inline
+CONSTANT: t-offset              6
-: 0-offset              7 ; inline
+CONSTANT: 0-offset              7
-: 1-offset              8 ; inline
+CONSTANT: 1-offset              8
-: -1-offset             9 ; inline
+CONSTANT: -1-offset             9
 
 SYMBOL: sub-primitives
 

basis/cairo/ffi/ffi.factor

@@ -72,9 +72,9 @@ C-ENUM:
     CAIRO_STATUS_INVALID_STRIDE ;
 
 TYPEDEF: int cairo_content_t
-: CAIRO_CONTENT_COLOR		HEX: 1000 ;
+CONSTANT: CAIRO_CONTENT_COLOR HEX: 1000
-: CAIRO_CONTENT_ALPHA		HEX: 2000 ;
+CONSTANT: CAIRO_CONTENT_ALPHA HEX: 2000
-: CAIRO_CONTENT_COLOR_ALPHA	HEX: 3000 ;
+CONSTANT: CAIRO_CONTENT_COLOR_ALPHA HEX: 3000
 
 TYPEDEF: void* cairo_write_func_t
 : cairo-write-func ( quot -- callback )

basis/calendar/calendar.factor

@@ -61,7 +61,7 @@ PRIVATE>
 : month-abbreviation ( n -- string )
     check-month 1- month-abbreviations nth ;
 
-: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } ; inline
+CONSTANT: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 }
 
 : day-names ( -- array )
     {

basis/checksums/adler-32/adler-32.factor

@@ -6,7 +6,7 @@ IN: checksums.adler-32
 
 SINGLETON: adler-32
 
-: adler-32-modulus 65521 ; inline
+CONSTANT: adler-32-modulus 65521
 
 M: adler-32 checksum-bytes ( bytes checksum -- value )
     drop

basis/checksums/openssl/openssl-docs.factor

@@ -1,5 +1,5 @@
 IN: checksums.openssl
-USING: help.syntax help.markup ;
+USING: checksums help.syntax help.markup ;
 
 HELP: openssl-checksum
 { $class-description "The class of checksum algorithms implemented by OpenSSL. The exact set of algorithms supported depends on how the OpenSSL library was compiled; " { $snippet "md5" } " and " { $snippet "sha1" } " should be universally available." } ;
@@ -9,9 +9,11 @@ HELP: <openssl-checksum>
 { $description "Creates a new OpenSSL checksum object." } ;
 
 HELP: openssl-md5
+{ $values { "value" checksum } }
 { $description "The OpenSSL MD5 message digest implementation." } ;
 
 HELP: openssl-sha1
+{ $values { "value" checksum } }
 { $description "The OpenSSL SHA1 message digest implementation." } ;
 
 HELP: unknown-digest

basis/checksums/openssl/openssl.factor

@@ -9,9 +9,9 @@ ERROR: unknown-digest name ;
 
 TUPLE: openssl-checksum name ;
 
-: openssl-md5 T{ openssl-checksum f "md5" } ;
+CONSTANT: openssl-md5 T{ openssl-checksum f "md5" }
 
-: openssl-sha1 T{ openssl-checksum f "sha1" } ;
+CONSTANT: openssl-sha1 T{ openssl-checksum f "sha1" }
 
 INSTANCE: openssl-checksum stream-checksum
 

basis/checksums/sha2/sha2.factor

@@ -9,14 +9,14 @@ IN: checksums.sha2
 
 SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
 
-: a 0 ; inline
+CONSTANT: a 0
-: b 1 ; inline
+CONSTANT: b 1
-: c 2 ; inline
+CONSTANT: c 2
-: d 3 ; inline
+CONSTANT: d 3
-: e 4 ; inline
+CONSTANT: e 4
-: f 5 ; inline
+CONSTANT: f 5
-: g 6 ; inline
+CONSTANT: g 6
-: h 7 ; inline
+CONSTANT: h 7
 
 : initial-H-256 ( -- seq )
     {

basis/cocoa/application/application.factor

@@ -19,9 +19,9 @@ IN: cocoa.application
         ] curry assoc-each
     ] keep ;
 
-: NSApplicationDelegateReplySuccess 0 ;
+CONSTANT: NSApplicationDelegateReplySuccess 0
-: NSApplicationDelegateReplyCancel  1 ;
+CONSTANT: NSApplicationDelegateReplyCancel  1
-: NSApplicationDelegateReplyFailure 2 ;
+CONSTANT: NSApplicationDelegateReplyFailure 2
 
 : with-autorelease-pool ( quot -- )
     NSAutoreleasePool -> new slip -> release ; inline

basis/cocoa/dialogs/dialogs.factor

@@ -18,8 +18,8 @@ IN: cocoa.dialogs
     dup 0 -> setCanChooseDirectories:
     dup 0 -> setAllowsMultipleSelection: ;
 
-: NSOKButton 1 ;
+CONSTANT: NSOKButton 1
-: NSCancelButton 0 ;
+CONSTANT: NSCancelButton 0
 
 : open-panel ( -- paths )
     <NSOpenPanel>

basis/cocoa/enumeration/enumeration.factor

@@ -5,7 +5,7 @@ sequences vectors fry libc destructors
 specialized-arrays.direct.alien ;
 IN: cocoa.enumeration
 
-: NS-EACH-BUFFER-SIZE 16 ; inline
+CONSTANT: NS-EACH-BUFFER-SIZE 16
 
 : with-enumeration-buffers ( quot -- )
     [

basis/cocoa/messages/messages.factor

@@ -1,11 +1,11 @@
-! Copyright (C) 2006, 2008 Slava Pestov.
+! Copyright (C) 2006, 2009 Slava Pestov.
 ! 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
+continuations combinators compiler compiler.alien stack-checker kernel
-namespaces make parser quotations sequences strings words
+math namespaces make parser quotations sequences strings words
-cocoa.runtime io macros memoize io.encodings.utf8
+cocoa.runtime io macros memoize io.encodings.utf8 effects libc
-effects libc libc.private parser lexer init core-foundation fry
+libc.private parser lexer init core-foundation fry generalizations
-generalizations specialized-arrays.direct.alien call ;
+specialized-arrays.direct.alien call ;
 IN: cocoa.messages
 
 : make-sender ( method function -- quot )
@@ -14,7 +14,7 @@ IN: cocoa.messages
 : sender-stub ( method function -- word )
     [ "( sender-stub )" f <word> dup ] 2dip
     over first large-struct? [ "_stret" append ] when
-    make-sender define ;
+    make-sender dup infer define-declared ;
 
 SYMBOL: message-senders
 SYMBOL: super-message-senders

basis/cocoa/pasteboard/pasteboard.factor

@@ -5,7 +5,7 @@ cocoa.classes cocoa.application sequences cocoa core-foundation
 core-foundation.strings core-foundation.arrays ;
 IN: cocoa.pasteboard
 
-: NSStringPboardType "NSStringPboardType" ;
+CONSTANT: NSStringPboardType "NSStringPboardType"
 
 : pasteboard-string? ( pasteboard -- ? )
     NSStringPboardType swap -> types CF>string-array member? ;

basis/cocoa/runtime/runtime.factor

@@ -21,15 +21,15 @@ C-STRUCT: objc-super
     { "id" "receiver" }
     { "Class" "class" } ;
 
-: CLS_CLASS        HEX: 1   ;
+CONSTANT: CLS_CLASS        HEX: 1
-: CLS_META         HEX: 2   ;
+CONSTANT: CLS_META         HEX: 2
-: CLS_INITIALIZED  HEX: 4   ;
+CONSTANT: CLS_INITIALIZED  HEX: 4
-: CLS_POSING       HEX: 8   ;
+CONSTANT: CLS_POSING       HEX: 8
-: CLS_MAPPED       HEX: 10  ;
+CONSTANT: CLS_MAPPED       HEX: 10
-: CLS_FLUSH_CACHE  HEX: 20  ;
+CONSTANT: CLS_FLUSH_CACHE  HEX: 20
-: CLS_GROW_CACHE   HEX: 40  ;
+CONSTANT: CLS_GROW_CACHE   HEX: 40
-: CLS_NEED_BIND    HEX: 80  ;
+CONSTANT: CLS_NEED_BIND    HEX: 80
-: CLS_METHOD_ARRAY HEX: 100 ;
+CONSTANT: CLS_METHOD_ARRAY HEX: 100
 
 FUNCTION: int objc_getClassList ( void* buffer, int bufferLen ) ;
 

basis/cocoa/subclassing/subclassing.factor

@@ -38,9 +38,9 @@ IN: cocoa.subclassing
     ] map concat ;
 
 : prepare-method ( ret types quot -- type imp )
-    [ [ encode-types ] 2keep ] dip [
+    [ [ encode-types ] 2keep ] dip
-        "cdecl" swap 4array % \ alien-callback ,
+    '[ _ _ "cdecl" _ alien-callback ]
-    ] [ ] make define-temp ;
+    (( -- callback )) define-temp ;
 
 : prepare-methods ( methods -- methods )
     [

basis/cocoa/views/views.factor

@@ -5,43 +5,43 @@ cocoa cocoa.messages cocoa.classes cocoa.types sequences
 continuations accessors ;
 IN: cocoa.views
 
-: NSOpenGLPFAAllRenderers 1 ;
+CONSTANT: NSOpenGLPFAAllRenderers 1
-: NSOpenGLPFADoubleBuffer 5 ;
+CONSTANT: NSOpenGLPFADoubleBuffer 5
-: NSOpenGLPFAStereo 6 ;
+CONSTANT: NSOpenGLPFAStereo 6
-: NSOpenGLPFAAuxBuffers 7 ;
+CONSTANT: NSOpenGLPFAAuxBuffers 7
-: NSOpenGLPFAColorSize 8 ;
+CONSTANT: NSOpenGLPFAColorSize 8
-: NSOpenGLPFAAlphaSize 11 ;
+CONSTANT: NSOpenGLPFAAlphaSize 11
-: NSOpenGLPFADepthSize 12 ;
+CONSTANT: NSOpenGLPFADepthSize 12
-: NSOpenGLPFAStencilSize 13 ;
+CONSTANT: NSOpenGLPFAStencilSize 13
-: NSOpenGLPFAAccumSize 14 ;
+CONSTANT: NSOpenGLPFAAccumSize 14
-: NSOpenGLPFAMinimumPolicy 51 ;
+CONSTANT: NSOpenGLPFAMinimumPolicy 51
-: NSOpenGLPFAMaximumPolicy 52 ;
+CONSTANT: NSOpenGLPFAMaximumPolicy 52
-: NSOpenGLPFAOffScreen 53 ;
+CONSTANT: NSOpenGLPFAOffScreen 53
-: NSOpenGLPFAFullScreen 54 ;
+CONSTANT: NSOpenGLPFAFullScreen 54
-: NSOpenGLPFASampleBuffers 55 ;
+CONSTANT: NSOpenGLPFASampleBuffers 55
-: NSOpenGLPFASamples 56 ;
+CONSTANT: NSOpenGLPFASamples 56
-: NSOpenGLPFAAuxDepthStencil 57 ;
+CONSTANT: NSOpenGLPFAAuxDepthStencil 57
-: NSOpenGLPFAColorFloat  58 ;
+CONSTANT: NSOpenGLPFAColorFloat  58
-: NSOpenGLPFAMultisample 59 ;
+CONSTANT: NSOpenGLPFAMultisample 59
-: NSOpenGLPFASupersample 60 ;
+CONSTANT: NSOpenGLPFASupersample 60
-: NSOpenGLPFASampleAlpha 61 ;
+CONSTANT: NSOpenGLPFASampleAlpha 61
-: NSOpenGLPFARendererID 70 ;
+CONSTANT: NSOpenGLPFARendererID 70
-: NSOpenGLPFASingleRenderer 71 ;
+CONSTANT: NSOpenGLPFASingleRenderer 71
-: NSOpenGLPFANoRecovery 72 ;
+CONSTANT: NSOpenGLPFANoRecovery 72
-: NSOpenGLPFAAccelerated 73 ;
+CONSTANT: NSOpenGLPFAAccelerated 73
-: NSOpenGLPFAClosestPolicy 74 ;
+CONSTANT: NSOpenGLPFAClosestPolicy 74
-: NSOpenGLPFARobust 75 ;
+CONSTANT: NSOpenGLPFARobust 75
-: NSOpenGLPFABackingStore 76 ;
+CONSTANT: NSOpenGLPFABackingStore 76
-: NSOpenGLPFAMPSafe 78 ;
+CONSTANT: NSOpenGLPFAMPSafe 78
-: NSOpenGLPFAWindow 80 ;
+CONSTANT: NSOpenGLPFAWindow 80
-: NSOpenGLPFAMultiScreen 81 ;
+CONSTANT: NSOpenGLPFAMultiScreen 81
-: NSOpenGLPFACompliant 83 ;
+CONSTANT: NSOpenGLPFACompliant 83
-: NSOpenGLPFAScreenMask 84 ;
+CONSTANT: NSOpenGLPFAScreenMask 84
-: NSOpenGLPFAPixelBuffer 90 ;
+CONSTANT: NSOpenGLPFAPixelBuffer 90
-: NSOpenGLPFAAllowOfflineRenderers 96 ;
+CONSTANT: NSOpenGLPFAAllowOfflineRenderers 96
-: NSOpenGLPFAVirtualScreenCount 128 ;
+CONSTANT: NSOpenGLPFAVirtualScreenCount 128
 
-: kCGLRendererGenericFloatID HEX: 00020400 ;
+CONSTANT: kCGLRendererGenericFloatID HEX: 00020400
 
 <PRIVATE
 
@@ -94,7 +94,7 @@ PRIVATE>
 USE: opengl.gl
 USE: alien.syntax
 
-: NSOpenGLCPSwapInterval 222 ;
+CONSTANT: NSOpenGLCPSwapInterval 222
 
 LIBRARY: OpenGL
 

basis/cocoa/windows/windows.factor

@@ -4,15 +4,15 @@ USING: arrays kernel math cocoa cocoa.messages cocoa.classes
 sequences math.bitwise ;
 IN: cocoa.windows
 
-: NSBorderlessWindowMask     0 ; inline
+CONSTANT: NSBorderlessWindowMask     0
-: NSTitledWindowMask         1 ; inline
+CONSTANT: NSTitledWindowMask         1
-: NSClosableWindowMask       2 ; inline
+CONSTANT: NSClosableWindowMask       2
-: NSMiniaturizableWindowMask 4 ; inline
+CONSTANT: NSMiniaturizableWindowMask 4
-: NSResizableWindowMask      8 ; inline
+CONSTANT: NSResizableWindowMask      8
 
-: NSBackingStoreRetained    0 ; inline
+CONSTANT: NSBackingStoreRetained    0
-: NSBackingStoreNonretained 1 ; inline
+CONSTANT: NSBackingStoreNonretained 1
-: NSBackingStoreBuffered    2 ; inline
+CONSTANT: NSBackingStoreBuffered    2
 
 : standard-window-type ( -- n )
     {

basis/colors/colors.factor

@@ -18,16 +18,16 @@ M: color red>>   ( color -- red   ) >rgba red>>   ;
 M: color green>> ( color -- green ) >rgba green>> ;
 M: color blue>>  ( color -- blue  ) >rgba blue>>  ;
 
-: black        T{ rgba f 0.0   0.0   0.0   1.0  } ; inline
+CONSTANT: black        T{ rgba f 0.0   0.0   0.0   1.0  }
-: blue         T{ rgba f 0.0   0.0   1.0   1.0  } ; inline
+CONSTANT: blue         T{ rgba f 0.0   0.0   1.0   1.0  }
-: cyan         T{ rgba f 0     0.941 0.941 1    } ; inline
+CONSTANT: cyan         T{ rgba f 0     0.941 0.941 1    }
-: gray         T{ rgba f 0.6   0.6   0.6   1.0  } ; inline
+CONSTANT: gray         T{ rgba f 0.6   0.6   0.6   1.0  }
-: green        T{ rgba f 0.0   1.0   0.0   1.0  } ; inline
+CONSTANT: green        T{ rgba f 0.0   1.0   0.0   1.0  }
-: light-gray   T{ rgba f 0.95  0.95  0.95  0.95 } ; inline
+CONSTANT: light-gray   T{ rgba f 0.95  0.95  0.95  0.95 }
-: light-purple T{ rgba f 0.8   0.8   1.0   1.0  } ; inline
+CONSTANT: light-purple T{ rgba f 0.8   0.8   1.0   1.0  }
-: magenta      T{ rgba f 0.941 0     0.941 1    } ; inline
+CONSTANT: magenta      T{ rgba f 0.941 0     0.941 1    }
-: orange       T{ rgba f 0.941 0.627 0     1    } ; inline
+CONSTANT: orange       T{ rgba f 0.941 0.627 0     1    }
-: purple       T{ rgba f 0.627 0     0.941 1    } ; inline
+CONSTANT: purple       T{ rgba f 0.627 0     0.941 1    }
-: red          T{ rgba f 1.0   0.0   0.0   1.0  } ; inline
+CONSTANT: red          T{ rgba f 1.0   0.0   0.0   1.0  }
-: white        T{ rgba f 1.0   1.0   1.0   1.0  } ; inline
+CONSTANT: white        T{ rgba f 1.0   1.0   1.0   1.0  }
-: yellow       T{ rgba f 1.0   1.0   0.0   1.0  } ; inline
+CONSTANT: yellow       T{ rgba f 1.0   1.0   0.0   1.0  }

basis/compiler/cfg/debugger/debugger.factor

@@ -16,7 +16,7 @@ M: callable test-cfg
     build-tree optimize-tree gensym build-cfg ;
 
 M: word test-cfg
-    [ build-tree-from-word nip optimize-tree ] keep build-cfg ;
+    [ build-tree-from-word optimize-tree ] keep build-cfg ;
 
 SYMBOL: allocate-registers?
 

basis/compiler/compiler-docs.factor

@@ -1,5 +1,5 @@
 USING: help.markup help.syntax words io parser
-assocs words.private sequences compiler.units ;
+assocs words.private sequences compiler.units quotations ;
 IN: compiler
 
 HELP: enable-compiler
@@ -16,6 +16,8 @@ ARTICLE: "compiler-usage" "Calling the optimizing compiler"
 { $subsection optimized-recompile-hook }
 "Removing a word's optimized definition:"
 { $subsection decompile }
+"Compiling a single quotation:"
+{ $subsection compile-call }
 "Higher-level words can be found in " { $link "compilation-units" } "." ;
 
 ARTICLE: "compiler" "Optimizing compiler"
@@ -48,3 +50,8 @@ HELP: optimized-recompile-hook
 { $values { "words" "a sequence of words" } { "alist" "an association list" } }
 { $description "Compile a set of words." }
 { $notes "This is an internal word, and user code should call " { $link compile } " instead." } ;
+
+HELP: compile-call
+{ $values { "quot" quotation } }
+{ $description "Compiles and runs a quotation." }
+{ $notes "This word is used by compiler unit tests to test compilation of small pieces of code." } ;

basis/compiler/compiler.factor

@@ -1,46 +1,47 @@
 ! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel namespaces arrays sequences io
+USING: accessors kernel namespaces arrays sequences io words fry
-words fry continuations vocabs assocs dlists definitions math
+continuations vocabs assocs dlists definitions math graphs
-graphs generic combinators deques search-deques io
+generic combinators deques search-deques io stack-checker
-stack-checker stack-checker.state stack-checker.inlining
+stack-checker.state stack-checker.inlining
-compiler.errors compiler.units compiler.tree.builder
+combinators.short-circuit compiler.errors compiler.units
-compiler.tree.optimizer compiler.cfg.builder
+compiler.tree.builder compiler.tree.optimizer
-compiler.cfg.optimizer compiler.cfg.linearization
+compiler.cfg.builder compiler.cfg.optimizer
-compiler.cfg.two-operand compiler.cfg.linear-scan
+compiler.cfg.linearization compiler.cfg.two-operand
-compiler.cfg.stack-frame compiler.codegen compiler.utilities ;
+compiler.cfg.linear-scan compiler.cfg.stack-frame
+compiler.codegen compiler.utilities ;
 IN: compiler
 
 SYMBOL: compile-queue
 SYMBOL: compiled
 
-: queue-compile ( word -- )
+: queue-compile? ( word -- ? )
     {
-        { [ dup "forgotten" word-prop ] [ ] }
+        [ "forgotten" word-prop ]
-        { [ dup compiled get key? ] [ ] }
+        [ compiled get key? ]
-        { [ dup inlined-block? ] [ ] }
+        [ inlined-block? ]
-        { [ dup primitive? ] [ ] }
+        [ primitive? ]
-        [ dup compile-queue get push-front ]
+    } 1|| not ;
-    } cond drop ;
+
+: queue-compile ( word -- )
+    dup queue-compile? [ compile-queue get push-front ] [ drop ] if ;
 
 : maybe-compile ( word -- )
     dup optimized>> [ drop ] [ queue-compile ] if ;
 
-SYMBOL: +failed+
+SYMBOLS: +optimized+ +unoptimized+ ;
 
 : ripple-up ( words -- )
-    dup "compiled-effect" word-prop +failed+ eq?
+    dup "compiled-status" word-prop +unoptimized+ eq?
     [ usage [ word? ] filter ] [ compiled-usage keys ] if
     [ queue-compile ] each ;
 
-: ripple-up? ( word effect -- ? )
+: ripple-up? ( word status -- ? )
-    #! If the word has previously been compiled and had a
+    swap "compiled-status" word-prop [ = not ] keep and ;
-    #! different stack effect, we have to recompile any callers.
-    swap "compiled-effect" word-prop [ = not ] keep and ;
 
-: save-effect ( word effect -- )
+: save-compiled-status ( word status -- )
     [ dupd ripple-up? [ ripple-up ] [ drop ] if ]
-    [ "compiled-effect" set-word-prop ]
+    [ "compiled-status" set-word-prop ]
     2bi ;
 
 : start ( word -- )
@@ -49,18 +50,18 @@ SYMBOL: +failed+
     H{ } clone generic-dependencies set
     f swap compiler-error ;
 
-: fail ( word error -- )
+: fail ( word error -- * )
     [ swap compiler-error ]
     [
         drop
         [ compiled-unxref ]
         [ f swap compiled get set-at ]
-        [ +failed+ save-effect ]
+        [ +unoptimized+ save-compiled-status ]
         tri
     ] 2bi
     return ;
 
-: frontend ( word -- effect nodes )
+: frontend ( word -- nodes )
     [ build-tree-from-word ] [ fail ] recover optimize-tree ;
 
 ! Only switch this off for debugging.
@@ -84,8 +85,8 @@ t compile-dependencies? set-global
         save-asm
     ] each ;
 
-: finish ( effect word -- )
+: finish ( word -- )
-    [ swap save-effect ]
+    [ +optimized+ save-compiled-status ]
     [ compiled-unxref ]
     [
         dup crossref?
@@ -112,6 +113,9 @@ t compile-dependencies? set-global
 : decompile ( word -- )
     f 2array 1array modify-code-heap ;
 
+: compile-call ( quot -- )
+    [ dup infer define-temp ] with-compilation-unit execute ;
+
 : optimized-recompile-hook ( words -- alist )
     [
         <hashed-dlist> compile-queue set

basis/compiler/constants/constants.factor

@@ -4,8 +4,8 @@ USING: math kernel layouts system strings ;
 IN: compiler.constants
 
 ! These constants must match vm/memory.h
-: card-bits 8 ; inline
+CONSTANT: card-bits 8
-: deck-bits 18 ; inline
+CONSTANT: deck-bits 18
 : card-mark ( -- n ) HEX: 40 HEX: 80 bitor ; inline
 
 ! These constants must match vm/layouts.h
@@ -26,25 +26,25 @@ IN: compiler.constants
 : compiled-header-size ( -- n ) 4 bootstrap-cells ; inline
 
 ! Relocation classes
-: rc-absolute-cell    0 ; inline
+CONSTANT: rc-absolute-cell    0
-: rc-absolute         1 ; inline
+CONSTANT: rc-absolute         1
-: rc-relative         2 ; inline
+CONSTANT: rc-relative         2
-: rc-absolute-ppc-2/2 3 ; inline
+CONSTANT: rc-absolute-ppc-2/2 3
-: rc-relative-ppc-2   4 ; inline
+CONSTANT: rc-relative-ppc-2   4
-: rc-relative-ppc-3   5 ; inline
+CONSTANT: rc-relative-ppc-3   5
-: rc-relative-arm-3   6 ; inline
+CONSTANT: rc-relative-arm-3   6
-: rc-indirect-arm     7 ; inline
+CONSTANT: rc-indirect-arm     7
-: rc-indirect-arm-pc  8 ; inline
+CONSTANT: rc-indirect-arm-pc  8
 
 ! Relocation types
-: rt-primitive   0 ; inline
+CONSTANT: rt-primitive   0
-: rt-dlsym       1 ; inline
+CONSTANT: rt-dlsym       1
-: rt-dispatch    2 ; inline
+CONSTANT: rt-dispatch    2
-: rt-xt          3 ; inline
+CONSTANT: rt-xt          3
-: rt-here        4 ; inline
+CONSTANT: rt-here        4
-: rt-label       5 ; inline
+CONSTANT: rt-label       5
-: rt-immediate   6 ; inline
+CONSTANT: rt-immediate   6
-: rt-stack-chain 7 ; inline
+CONSTANT: rt-stack-chain 7
 
 : rc-absolute? ( n -- ? )
     [ rc-absolute-ppc-2/2 = ]

basis/compiler/tests/codegen.factor

@@ -51,7 +51,7 @@ unit-test
     \ foo [ global >n get ndrop ] compile-call
 ] unit-test
 
-: blech drop ;
+: blech ( x -- ) drop ;
 
 [ 3 ]
 [
@@ -102,7 +102,7 @@ unit-test
 [ ] [
     [
         [ 200 dup [ 200 3array ] curry map drop ] times
-    ] [ define-temp ] with-compilation-unit drop
+    ] [ (( n -- )) define-temp ] with-compilation-unit drop
 ] unit-test
 
 ! Test how dispatch handles the end of a basic block

basis/compiler/tests/curry.factor

@@ -1,5 +1,5 @@
 USING: tools.test quotations math kernel sequences
-assocs namespaces make compiler.units ;
+assocs namespaces make compiler.units compiler ;
 IN: compiler.tests
 
 [ 3 ] [ 5 [ [ 2 - ] curry call ] compile-call ] unit-test
@@ -32,15 +32,15 @@ IN: compiler.tests
     compile-call
 ] unit-test
 
-: foobar ( quot -- )
+: foobar ( quot: ( -- ) -- )
-    dup slip swap [ foobar ] [ drop ] if ; inline
+    dup slip swap [ foobar ] [ drop ] if ; inline recursive
 
 [ ] [ [ [ f ] foobar ] compile-call ] unit-test
 
 [ { 6 7 8 } ] [ { 1 2 3 } 5 [ [ + ] curry map ] compile-call ] unit-test
 [ { 6 7 8 } ] [ { 1 2 3 } [ 5 [ + ] curry map ] compile-call ] unit-test
 
-: funky-assoc>map
+: funky-assoc>map ( assoc quot -- seq )
     [
         [ call f ] curry assoc-find 3drop
     ] { } make ; inline

basis/compiler/tests/float.factor

@@ -1,5 +1,5 @@
 IN: compiler.tests
-USING: compiler.units kernel kernel.private memory math
+USING: compiler.units compiler kernel kernel.private memory math
 math.private tools.test math.floats.private ;
 
 [ 5.0 ] [ [ 5.0 ] compile-call gc gc gc ] unit-test

basis/compiler/tests/intrinsics.factor

@@ -5,7 +5,7 @@ strings.private system random layouts vectors
 sbufs strings.private slots.private alien math.order
 alien.accessors alien.c-types alien.syntax alien.strings
 namespaces libc sequences.private io.encodings.ascii
-classes ;
+classes compiler ;
 IN: compiler.tests
 
 ! Make sure that intrinsic ops compile to correct code.

basis/compiler/tests/optimizer.factor

@@ -3,7 +3,8 @@ stack-checker kernel kernel.private math prettyprint sequences
 sbufs strings tools.test vectors words sequences.private
 quotations classes classes.algebra classes.tuple.private
 continuations growable namespaces hints alien.accessors
-compiler.tree.builder compiler.tree.optimizer sequences.deep ;
+compiler.tree.builder compiler.tree.optimizer sequences.deep
+compiler ;
 IN: optimizer.tests
 
 GENERIC: xyz ( obj -- obj )
@@ -54,7 +55,7 @@ TUPLE: pred-test ;
 
 ! regression
 
-: literal-not-branch 0 not [ ] [ ] if ;
+: literal-not-branch ( -- ) 0 not [ ] [ ] if ;
 
 [ ] [ literal-not-branch ] unit-test
 
@@ -107,12 +108,12 @@ GENERIC: void-generic ( obj -- * )
 [ 10 ] [ branch-fold-regression-1 ] unit-test
 
 ! another regression
-: constant-branch-fold-0 "hey" ; foldable
+: constant-branch-fold-0 ( -- value ) "hey" ; foldable
 : constant-branch-fold-1 ( -- ? ) constant-branch-fold-0 "hey" = ; inline
 [ 1 ] [ [ constant-branch-fold-1 [ 1 ] [ 2 ] if ] compile-call ] unit-test
 
 ! another regression
-: foo f ;
+: foo ( -- value ) f ;
 : bar ( -- ? ) foo 4 4 = and ;
 [ f ] [ bar ] unit-test
 
@@ -133,15 +134,15 @@ M: slice foozul ;
 ] unit-test
 
 ! regression
-: constant-fold-2 f ; foldable
+: constant-fold-2 ( -- value ) f ; foldable
-: constant-fold-3 4 ; foldable
+: constant-fold-3 ( -- value ) 4 ; foldable
 
 [ f t ] [
     [ constant-fold-2 constant-fold-3 4 = ] compile-call
 ] unit-test
 
-: constant-fold-4 f ; foldable
+: constant-fold-4 ( -- value ) f ; foldable
-: constant-fold-5 f ; foldable
+: constant-fold-5 ( -- value ) f ; foldable
 
 [ f ] [
     [ constant-fold-4 constant-fold-5 or ] compile-call
@@ -208,14 +209,14 @@ USE: sorting
 USE: binary-search
 USE: binary-search.private
 
-: old-binsearch ( elt quot seq -- elt quot i )
+: old-binsearch ( elt quot: ( -- ) seq -- elt quot i )
     dup length 1 <= [
         from>>
     ] [
         [ midpoint swap call ] 3keep roll dup zero?
         [ drop dup from>> swap midpoint@ + ]
-        [ dup midpoint@ cut-slice old-binsearch ] if
+        [ drop dup midpoint@ head-slice old-binsearch ] if
-    ] if ; inline
+    ] if ; inline recursive
 
 [ 10 ] [
     10 20 >vector <flat-slice>
@@ -246,7 +247,7 @@ USE: binary-search.private
 [ 3 "an integer" ] [ 3 lift-throw-tail-regression ] unit-test
 [ "hi" "a string" ] [ "hi" lift-throw-tail-regression ] unit-test
 
-: lift-loop-tail-test-1 ( a quot -- )
+: lift-loop-tail-test-1 ( a quot: ( -- ) -- )
     over even? [
         [ [ 3 - ] dip call ] keep lift-loop-tail-test-1
     ] [
@@ -255,11 +256,13 @@ USE: binary-search.private
         ] [
             [ [ 2 - ] dip call ] keep lift-loop-tail-test-1
         ] if
-    ] if ; inline
+    ] if ; inline recursive
 
-: lift-loop-tail-test-2
+: lift-loop-tail-test-2 ( -- a b c )
     10 [ ] lift-loop-tail-test-1 1 2 3 ;
 
+\ lift-loop-tail-test-2 must-infer
+
 [ 1 2 3 ] [ lift-loop-tail-test-2 ] unit-test
 
 ! Forgot a recursive inline check
@@ -300,7 +303,7 @@ HINTS: recursive-inline-hang-3 array ;
 : member-test ( obj -- ? ) { + - * / /i } member? ;
 
 \ member-test must-infer
-[ ] [ \ member-test build-tree-from-word optimize-tree 2drop ] unit-test
+[ ] [ \ member-test build-tree-from-word optimize-tree drop ] unit-test
 [ t ] [ \ + member-test ] unit-test
 [ f ] [ \ append member-test ] unit-test
 

basis/compiler/tests/peg-regression-2.factor

@@ -0,0 +1,15 @@
+IN: compiler.tests
+USING: peg.ebnf strings tools.test ;
+
+GENERIC: <times> ( times -- term' )
+M: string <times> ;
+
+EBNF: parse-regexp
+
+Times = .* => [[ "foo" ]]
+
+Regexp = Times:t => [[ t <times> ]]
+
+;EBNF
+
+[ "foo" ] [ "a" parse-regexp ] unit-test

basis/compiler/tests/simple.factor

@@ -18,13 +18,13 @@ IN: compiler.tests
 [ "hey" ] [ [ "hey" ] compile-call ] unit-test
 
 ! Calls
-: no-op ;
+: no-op ( -- ) ;
 
 [ ] [ [ no-op ] compile-call ] unit-test
 [ 3 ] [ [ no-op 3 ] compile-call ] unit-test
 [ 3 ] [ [ 3 no-op ] compile-call ] unit-test
 
-: bar 4 ;
+: bar ( -- value ) 4 ;
 
 [ 4 ] [ [ bar no-op ] compile-call ] unit-test
 [ 4 3 ] [ [ no-op bar 3 ] compile-call ] unit-test
@@ -54,7 +54,7 @@ IN: compiler.tests
 
 ! Labels
 
-: recursive-test ( ? -- ) [ f recursive-test ] when ; inline
+: recursive-test ( ? -- ) [ f recursive-test ] when ; inline recursive
 
 [ ] [ t [ recursive-test ] compile-call ] unit-test
 

basis/compiler/tests/tuples.factor

@@ -1,5 +1,5 @@
 IN: compiler.tests
-USING: kernel tools.test compiler.units ;
+USING: kernel tools.test compiler.units compiler ;
 
 TUPLE: color red green blue ;
 

basis/compiler/tree/builder/builder-tests.factor

@@ -8,4 +8,4 @@ compiler.tree ;
 
 : inline-recursive ( -- ) inline-recursive ; inline recursive
 
-[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] any? nip ] unit-test
+[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] any? ] unit-test

basis/compiler/tree/builder/builder.factor

@@ -12,18 +12,18 @@ IN: compiler.tree.builder
 
 : with-tree-builder ( quot -- nodes )
     '[ V{ } clone stack-visitor set @ ]
-    with-infer ; inline
+    with-infer nip ; inline
 
 : build-tree ( quot -- nodes )
     #! Not safe to call from inference transforms.
-    [ f initial-recursive-state infer-quot ] with-tree-builder nip ;
+    [ f initial-recursive-state infer-quot ] with-tree-builder ;
 
 : build-tree-with ( in-stack quot -- nodes out-stack )
     #! Not safe to call from inference transforms.
     [
         [ >vector \ meta-d set ]
         [ f initial-recursive-state infer-quot ] bi*
-    ] with-tree-builder nip
+    ] with-tree-builder
     unclip-last in-d>> ;
 
 : build-sub-tree ( #call quot -- nodes )
@@ -45,7 +45,7 @@ IN: compiler.tree.builder
 : check-no-compile ( word -- )
     dup "no-compile" word-prop [ cannot-infer-effect ] [ drop ] if ;
 
-: build-tree-from-word ( word -- effect nodes )
+: build-tree-from-word ( word -- nodes )
     [
         [
             {

basis/compiler/tree/cleanup/cleanup-tests.factor

@@ -474,7 +474,7 @@ cell-bits 32 = [
 ] unit-test
 
 ! A reduction
-: buffalo-sauce f ;
+: buffalo-sauce ( -- value ) f ;
 
 : steak ( -- )
     buffalo-sauce [ steak ] when ; inline recursive
@@ -510,3 +510,8 @@ cell-bits 32 = [
     [ { array } declare 2 <groups> [ . . ] assoc-each ]
     \ nth-unsafe inlined?
 ] unit-test
+
+[ t ] [
+    [ { fixnum fixnum } declare = ]
+    \ both-fixnums? inlined?
+] unit-test

basis/compiler/tree/comparisons/comparisons.factor

@@ -5,9 +5,9 @@ IN: compiler.tree.comparisons
 
 ! Some utilities for working with comparison operations.
 
-: comparison-ops { < > <= >= } ;
+CONSTANT: comparison-ops { < > <= >= }
 
-: generic-comparison-ops { before? after? before=? after=? } ;
+CONSTANT: generic-comparison-ops { before? after? before=? after=? }
 
 : assumption ( i1 i2 op -- i3 )
     {

basis/compiler/tree/debugger/debugger.factor

@@ -144,7 +144,7 @@ SYMBOL: node-count
 
 : make-report ( word/quot -- assoc )
     [
-        dup word? [ build-tree-from-word nip ] [ build-tree ] if
+        dup word? [ build-tree-from-word ] [ build-tree ] if
         optimize-tree
 
         H{ } clone words-called set

basis/compiler/tree/propagation/info/info.factor

@@ -32,9 +32,9 @@ literal?
 length
 slots ;
 
-: null-info T{ value-info f null empty-interval } ; inline
+CONSTANT: null-info T{ value-info f null empty-interval }
 
-: object-info T{ value-info f object full-interval } ; inline
+CONSTANT: object-info T{ value-info f object full-interval }
 
 : class-interval ( class -- interval )
     dup real class<=

basis/compiler/tree/propagation/known-words/known-words.factor

@@ -199,8 +199,11 @@ generic-comparison-ops [
 ] "outputs" set-word-prop
 
 \ both-fixnums? [
-    [ class>> fixnum classes-intersect? not ] either?
+    [ class>> ] bi@ {
-    f <literal-info> object-info ?
+        { [ 2dup [ fixnum classes-intersect? not ] either? ] [ f <literal-info> ] }
+        { [ 2dup [ fixnum class<= ] both? ] [ t <literal-info> ] }
+        [ object-info ]
+    } cond 2nip
 ] "outputs" set-word-prop
 
 {

basis/compiler/tree/recursive/recursive-tests.factor

@@ -87,7 +87,7 @@ compiler.tree.combinators ;
     ] contains-node?
 ] unit-test
 
-: blah f ;
+: blah ( -- value ) f ;
 
 DEFER: a
 

basis/compression/lzw/lzw.factor

@@ -69,11 +69,11 @@ ERROR: index-too-big n ;
 : omega-k-in-table? ( lzw -- ? )
     [ omega-k>> ] [ table>> ] bi key? ;
 
-ERROR: not-in-table ;
+ERROR: not-in-table value ;
 
 : write-output ( lzw -- )
     [
-        [ omega>> ] [ table>> ] bi at* [ not-in-table ] unless
+        [ omega>> ] [ table>> ] bi ?at [ not-in-table ] unless
     ] [
         [ lzw-bit-width-compress ]
         [ output>> write-bits ] bi

basis/core-foundation/core-foundation.factor

@@ -6,7 +6,7 @@ IN: core-foundation
 TYPEDEF: void* CFTypeRef
 
 TYPEDEF: void* CFAllocatorRef
-: kCFAllocatorDefault f ; inline
+CONSTANT: kCFAllocatorDefault f
 
 TYPEDEF: bool Boolean
 TYPEDEF: long CFIndex

basis/core-foundation/data/data.factor

@@ -10,28 +10,28 @@ TYPEDEF: void* CFNumberRef
 TYPEDEF: void* CFSetRef
 
 TYPEDEF: int CFNumberType
-: kCFNumberSInt8Type 1 ; inline
+CONSTANT: kCFNumberSInt8Type 1
-: kCFNumberSInt16Type 2 ; inline
+CONSTANT: kCFNumberSInt16Type 2
-: kCFNumberSInt32Type 3 ; inline
+CONSTANT: kCFNumberSInt32Type 3
-: kCFNumberSInt64Type 4 ; inline
+CONSTANT: kCFNumberSInt64Type 4
-: kCFNumberFloat32Type 5 ; inline
+CONSTANT: kCFNumberFloat32Type 5
-: kCFNumberFloat64Type 6 ; inline
+CONSTANT: kCFNumberFloat64Type 6
-: kCFNumberCharType 7 ; inline
+CONSTANT: kCFNumberCharType 7
-: kCFNumberShortType 8 ; inline
+CONSTANT: kCFNumberShortType 8
-: kCFNumberIntType 9 ; inline
+CONSTANT: kCFNumberIntType 9
-: kCFNumberLongType 10 ; inline
+CONSTANT: kCFNumberLongType 10
-: kCFNumberLongLongType 11 ; inline
+CONSTANT: kCFNumberLongLongType 11
-: kCFNumberFloatType 12 ; inline
+CONSTANT: kCFNumberFloatType 12
-: kCFNumberDoubleType 13 ; inline
+CONSTANT: kCFNumberDoubleType 13
-: kCFNumberCFIndexType 14 ; inline
+CONSTANT: kCFNumberCFIndexType 14
-: kCFNumberNSIntegerType 15 ; inline
+CONSTANT: kCFNumberNSIntegerType 15
-: kCFNumberCGFloatType 16 ; inline
+CONSTANT: kCFNumberCGFloatType 16
-: kCFNumberMaxType 16 ; inline
+CONSTANT: kCFNumberMaxType 16
 
 TYPEDEF: int CFPropertyListMutabilityOptions
-: kCFPropertyListImmutable                  0 ; inline
+CONSTANT: kCFPropertyListImmutable                  0
-: kCFPropertyListMutableContainers          1 ; inline
+CONSTANT: kCFPropertyListMutableContainers          1
-: kCFPropertyListMutableContainersAndLeaves 2 ; inline
+CONSTANT: kCFPropertyListMutableContainersAndLeaves 2
 
 FUNCTION: CFNumberRef CFNumberCreate ( CFAllocatorRef allocator, CFNumberType theType, void* valuePtr ) ;
 

basis/core-foundation/file-descriptors/file-descriptors.factor

@@ -15,8 +15,8 @@ FUNCTION: CFFileDescriptorRef CFFileDescriptorCreate (
     CFFileDescriptorContext* context
 ) ;
 
-: kCFFileDescriptorReadCallBack 1 ; inline
+CONSTANT: kCFFileDescriptorReadCallBack 1
-: kCFFileDescriptorWriteCallBack 2 ; inline
+CONSTANT: kCFFileDescriptorWriteCallBack 2
    
 FUNCTION: void CFFileDescriptorEnableCallBacks (
     CFFileDescriptorRef f,

basis/core-foundation/fsevents/fsevents.factor

@@ -9,17 +9,17 @@ core-foundation core-foundation.run-loop core-foundation.strings
 core-foundation.time ;
 IN: core-foundation.fsevents
 
-: kFSEventStreamCreateFlagUseCFTypes 2 ; inline
+CONSTANT: kFSEventStreamCreateFlagUseCFTypes 2
-: kFSEventStreamCreateFlagWatchRoot 4 ; inline
+CONSTANT: kFSEventStreamCreateFlagWatchRoot 4
 
-: kFSEventStreamEventFlagMustScanSubDirs 1 ; inline
+CONSTANT: kFSEventStreamEventFlagMustScanSubDirs 1
-: kFSEventStreamEventFlagUserDropped 2 ; inline
+CONSTANT: kFSEventStreamEventFlagUserDropped 2
-: kFSEventStreamEventFlagKernelDropped 4 ; inline
+CONSTANT: kFSEventStreamEventFlagKernelDropped 4
-: kFSEventStreamEventFlagEventIdsWrapped 8 ; inline
+CONSTANT: kFSEventStreamEventFlagEventIdsWrapped 8
-: kFSEventStreamEventFlagHistoryDone 16 ; inline
+CONSTANT: kFSEventStreamEventFlagHistoryDone 16
-: kFSEventStreamEventFlagRootChanged 32 ; inline
+CONSTANT: kFSEventStreamEventFlagRootChanged 32
-: kFSEventStreamEventFlagMount 64 ; inline
+CONSTANT: kFSEventStreamEventFlagMount 64
-: kFSEventStreamEventFlagUnmount 128 ; inline
+CONSTANT: kFSEventStreamEventFlagUnmount 128
 
 TYPEDEF: int FSEventStreamCreateFlags
 TYPEDEF: int FSEventStreamEventFlags
@@ -36,7 +36,7 @@ C-STRUCT: FSEventStreamContext
 ! callback(FSEventStreamRef streamRef, void *clientCallBackInfo, size_t numEvents, void *eventPaths, const FSEventStreamEventFlags eventFlags[], const FSEventStreamEventId eventIds[]);
 TYPEDEF: void* FSEventStreamCallback
 
-: FSEventStreamEventIdSinceNow HEX: FFFFFFFFFFFFFFFF ; inline
+CONSTANT: FSEventStreamEventIdSinceNow HEX: FFFFFFFFFFFFFFFF
 
 FUNCTION: FSEventStreamRef FSEventStreamCreate (
     CFAllocatorRef           allocator,

basis/core-foundation/run-loop/run-loop.factor

@@ -7,10 +7,10 @@ core-foundation.file-descriptors core-foundation.timers
 core-foundation.time ;
 IN: core-foundation.run-loop
 
-: kCFRunLoopRunFinished 1 ; inline
+CONSTANT: kCFRunLoopRunFinished 1
-: kCFRunLoopRunStopped 2 ; inline
+CONSTANT: kCFRunLoopRunStopped 2
-: kCFRunLoopRunTimedOut 3 ; inline
+CONSTANT: kCFRunLoopRunTimedOut 3
-: kCFRunLoopRunHandledSource 4 ; inline
+CONSTANT: kCFRunLoopRunHandledSource 4
 
 TYPEDEF: void* CFRunLoopRef
 TYPEDEF: void* CFRunLoopSourceRef

basis/core-foundation/strings/strings.factor

@@ -7,20 +7,20 @@ IN: core-foundation.strings
 TYPEDEF: void* CFStringRef
 
 TYPEDEF: int CFStringEncoding
-: kCFStringEncodingMacRoman HEX: 0 ;
+CONSTANT: kCFStringEncodingMacRoman HEX: 0
-: kCFStringEncodingWindowsLatin1 HEX: 0500 ;
+CONSTANT: kCFStringEncodingWindowsLatin1 HEX: 0500
-: kCFStringEncodingISOLatin1 HEX: 0201 ;
+CONSTANT: kCFStringEncodingISOLatin1 HEX: 0201
-: kCFStringEncodingNextStepLatin HEX: 0B01 ;
+CONSTANT: kCFStringEncodingNextStepLatin HEX: 0B01
-: kCFStringEncodingASCII HEX: 0600 ;
+CONSTANT: kCFStringEncodingASCII HEX: 0600
-: kCFStringEncodingUnicode HEX: 0100 ;
+CONSTANT: kCFStringEncodingUnicode HEX: 0100
-: kCFStringEncodingUTF8 HEX: 08000100 ;
+CONSTANT: kCFStringEncodingUTF8 HEX: 08000100
-: kCFStringEncodingNonLossyASCII HEX: 0BFF ;
+CONSTANT: kCFStringEncodingNonLossyASCII HEX: 0BFF
-: kCFStringEncodingUTF16 HEX: 0100 ;
+CONSTANT: kCFStringEncodingUTF16 HEX: 0100
-: kCFStringEncodingUTF16BE HEX: 10000100 ;
+CONSTANT: kCFStringEncodingUTF16BE HEX: 10000100
-: kCFStringEncodingUTF16LE HEX: 14000100 ;
+CONSTANT: kCFStringEncodingUTF16LE HEX: 14000100
-: kCFStringEncodingUTF32 HEX: 0c000100 ;
+CONSTANT: kCFStringEncodingUTF32 HEX: 0c000100
-: kCFStringEncodingUTF32BE HEX: 18000100 ;
+CONSTANT: kCFStringEncodingUTF32BE HEX: 18000100
-: kCFStringEncodingUTF32LE HEX: 1c000100 ;
+CONSTANT: kCFStringEncodingUTF32LE HEX: 1c000100
 
 FUNCTION: CFStringRef CFStringCreateWithBytes (
     CFAllocatorRef alloc,

basis/core-foundation/urls/urls.factor

@@ -4,7 +4,7 @@ USING: alien.syntax kernel core-foundation.strings
 core-foundation ;
 IN: core-foundation.urls
 
-: kCFURLPOSIXPathStyle 0 ; inline
+CONSTANT: kCFURLPOSIXPathStyle 0
 
 TYPEDEF: void* CFURLRef
 

basis/cpu/ppc/ppc.factor

@@ -27,8 +27,8 @@ M: ppc machine-registers
         { double-float-regs T{ range f 0 29 1 } }
     } ;
 
-: scratch-reg 28 ; inline
+CONSTANT: scratch-reg 28
-: fp-scratch-reg 30 ; inline
+CONSTANT: fp-scratch-reg 30
 
 M: ppc two-operand? f ;
 
@@ -40,8 +40,8 @@ M: ppc %load-reference ( reg obj -- )
 M: ppc %alien-global ( register symbol dll -- )
     [ 0 swap LOAD32 ] 2dip rc-absolute-ppc-2/2 rel-dlsym ;
 
-: ds-reg 29 ; inline
+CONSTANT: ds-reg 29
-: rs-reg 30 ; inline
+CONSTANT: rs-reg 30
 
 GENERIC: loc-reg ( loc -- reg )
 

basis/db/errors/postgresql/postgresql-tests.factor

@@ -5,7 +5,7 @@ db.errors.postgresql db.postgresql io.files.unique kernel namespaces
 tools.test db.tester continuations ;
 IN: db.errors.postgresql.tests
 
-postgresql-test-db [
+[
 
     [ "drop table foo;" sql-command ] ignore-errors
     [ "drop table ship;" sql-command ] ignore-errors
@@ -29,4 +29,4 @@ postgresql-test-db [
         sql-syntax-error?
     ] must-fail-with
 
-] with-db
+] test-postgresql

basis/db/types/types.factor

@@ -124,9 +124,6 @@ FACTOR-BLOB NULL URL ;
 ! PostgreSQL Types:
 ! http://developer.postgresql.org/pgdocs/postgres/datatype.html
 
-: ?at ( obj assoc -- value/obj ? )
-    dupd at* [ [ nip ] [ drop ] if ] keep ;
-
 ERROR: unknown-modifier modifier ;
 
 : lookup-modifier ( obj -- string )

basis/editors/editpadlite/editpadlite.factor

@@ -5,7 +5,7 @@ IN: editors.editpadlite
 
 : editpadlite-path ( -- path )
     \ editpadlite-path get-global [
-        "JGsoft" t [ >lower "editpadlite.exe" tail? ] find-in-program-files
+        "JGsoft" [ >lower "editpadlite.exe" tail? ] find-in-program-files
         [ "editpadlite.exe" ] unless*
     ] unless* ;
 

basis/editors/editpadpro/editpadpro.factor

@@ -5,7 +5,7 @@ IN: editors.editpadpro
 
 : editpadpro-path ( -- path )
     \ editpadpro-path get-global [
-        "JGsoft" t [ >lower "editpadpro.exe" tail? ] find-in-program-files
+        "JGsoft" [ >lower "editpadpro.exe" tail? ] find-in-program-files
         [ "editpadpro.exe" ] unless*
     ] unless* ;
 

basis/editors/editplus/editplus.factor

@@ -5,7 +5,7 @@ IN: editors.editplus
 
 : editplus-path ( -- path )
     \ editplus-path get-global [
-        "EditPlus 2" t [ "editplus.exe" tail? ] find-in-program-files
+        "EditPlus 2" [ "editplus.exe" tail? ] find-in-program-files
         [ "editplus.exe" ] unless*
     ] unless* ;
 

basis/editors/emacs/emacs.factor

@@ -1,6 +1,6 @@
 USING: definitions io.launcher kernel parser words sequences math
 math.parser namespaces editors make system combinators.short-circuit
-fry threads ;
+fry threads vocabs.loader ;
 IN: editors.emacs
 
 SYMBOL: emacsclient-path
@@ -11,7 +11,7 @@ M: object default-emacsclient ( -- path ) "emacsclient" ;
 
 : emacsclient ( file line -- )
     [
-        { [ \ emacsclient-path get ] [ default-emacsclient ] } 0|| ,
+        { [ emacsclient-path get ] [ default-emacsclient ] } 0|| ,
         "--no-wait" ,
         number>string "+" prepend ,
         ,
@@ -22,3 +22,5 @@ M: object default-emacsclient ( -- path ) "emacsclient" ;
     where first2 emacsclient ;
 
 [ emacsclient ] edit-hook set-global
+
+os windows? [ "editors.emacs.windows" require ] when

basis/editors/emacs/windows/windows.factor

@@ -6,7 +6,7 @@ IN: editors.emacs.windows
 
 M: windows default-emacsclient
     {
-        [ "Emacs" t [ "emacsclientw.exe" tail? ] find-in-program-files ]
+        [ "Emacs" [ "emacsclientw.exe" tail? ] find-in-program-files ]
-        [ "Emacs" t [ "emacsclient.exe" tail? ] find-in-program-files ]
+        [ "Emacs" [ "emacsclient.exe" tail? ] find-in-program-files ]
         [ "emacsclient.exe" ]
     } 0|| ;

basis/editors/emeditor/emeditor.factor

@@ -5,7 +5,7 @@ IN: editors.emeditor
 
 : emeditor-path ( -- path )
     \ emeditor-path get-global [
-        "EmEditor" t [ "EmEditor.exe" tail? ] find-in-program-files
+        "EmEditor" [ "EmEditor.exe" tail? ] find-in-program-files
         [ "EmEditor.exe" ] unless*
     ] unless* ;
 

basis/editors/etexteditor/etexteditor.factor

@@ -6,7 +6,7 @@ IN: editors.etexteditor
 
 : etexteditor-path ( -- str )
     \ etexteditor-path get-global [
-        "e" t [ "e.exe" tail? ] find-in-program-files
+        "e" [ "e.exe" tail? ] find-in-program-files
         [ "e" ] unless*
     ] unless* ;
 

basis/editors/gvim/windows/windows.factor

@@ -5,6 +5,6 @@ IN: editors.gvim.windows
 
 M: windows gvim-path
     \ gvim-path get-global [
-        "vim" t [ "gvim.exe" tail? ] find-in-program-files
+        "vim" [ "gvim.exe" tail? ] find-in-program-files
         [ "gvim.exe" ] unless*
     ] unless* ;

basis/editors/notepadpp/notepadpp.factor

@@ -4,7 +4,7 @@ IN: editors.notepadpp
 
 : notepadpp-path ( -- path )
     \ notepadpp-path get-global [
-        "notepad++" t [ "notepad++.exe" tail? ] find-in-program-files
+        "notepad++" [ "notepad++.exe" tail? ] find-in-program-files
         [ "notepad++.exe" ] unless*
     ] unless* ;
 

basis/editors/scite/scite.factor

@@ -7,11 +7,11 @@ IN: editors.scite
 
 : scite-path ( -- path )
     \ scite-path get-global [
-        "Scintilla Text Editor" t
+        "Scintilla Text Editor"
         [ >lower "scite.exe" tail? ] find-in-program-files
 
         [
-            "SciTE Source Code Editor" t
+            "SciTE Source Code Editor"
             [ >lower "scite.exe" tail? ] find-in-program-files
         ] unless*
         [ "scite.exe" ] unless*

basis/editors/ted-notepad/ted-notepad.factor

@@ -4,7 +4,7 @@ IN: editors.ted-notepad
 
 : ted-notepad-path ( -- path )
     \ ted-notepad-path get-global [
-        "TED Notepad" t [ "TedNPad.exe" tail? ] find-in-program-files
+        "TED Notepad" [ "TedNPad.exe" tail? ] find-in-program-files
         [ "TedNPad.exe" ] unless*
     ] unless* ;
 

basis/editors/textpad/textpad.factor

@@ -5,7 +5,7 @@ IN: editors.textpad
 
 : textpad-path ( -- path )
     \ textpad-path get-global [
-        "TextPad 5" t [ "TextPad.exe" tail? ] find-in-program-files
+        "TextPad 5" [ "TextPad.exe" tail? ] find-in-program-files
         [ "TextPad.exe" ] unless*
     ] unless* ;
 

basis/editors/ultraedit/ultraedit.factor

@@ -4,7 +4,7 @@ IN: editors.ultraedit
 
 : ultraedit-path ( -- path )
     \ ultraedit-path get-global [
-        "IDM Computer Solutions" t [ "uedit32.exe" tail? ] find-in-program-files
+        "IDM Computer Solutions" [ "uedit32.exe" tail? ] find-in-program-files
         [ "uedit32.exe" ] unless*
     ] unless* ;
 

basis/editors/wordpad/wordpad.factor

@@ -4,7 +4,7 @@ IN: editors.wordpad
 
 : wordpad-path ( -- path )
     \ wordpad-path get [
-        "Windows NT\\Accessories" t
+        "Windows NT\\Accessories"
         [ "wordpad.exe" tail? ] find-in-program-files
     ] unless* ;
 

basis/farkup/farkup.factor

@@ -157,7 +157,7 @@ stand-alone
            = (line | code | heading | list | table | paragraph | nl)*
 ;EBNF
 
-: invalid-url "javascript:alert('Invalid URL in farkup');" ;
+CONSTANT: invalid-url "javascript:alert('Invalid URL in farkup');"
 
 : check-url ( href -- href' )
     {

basis/functors/functors.factor

@@ -80,9 +80,9 @@ M: object fake-quotations> ;
     scan-param parsed
     \ add-mixin-instance parsed ; parsing
 
-: `inline \ inline parsed ; parsing
+: `inline [ word make-inline ] over push-all ; parsing
 
-: `parsing \ parsing parsed ; parsing
+: `parsing [ word make-parsing ] over push-all ; parsing
 
 : `(
     ")" parse-effect effect set ; parsing

basis/furnace/actions/actions.factor

@@ -63,7 +63,7 @@ TUPLE: action rest init authorize display validate submit ;
 : param ( name -- value )
     params get at ;
 
-: revalidate-url-key "__u" ;
+CONSTANT: revalidate-url-key "__u"
 
 : revalidate-url ( -- url/f )
     revalidate-url-key param

basis/furnace/alloy/alloy.factor

@@ -10,7 +10,7 @@ furnace.auth.providers
 furnace.auth.login.permits ;
 IN: furnace.alloy
 
-: state-classes { session aside conversation permit } ; inline
+CONSTANT: state-classes { session aside conversation permit }
 
 : init-furnace-tables ( -- )
     state-classes ensure-tables

basis/furnace/asides/asides.factor

@@ -23,7 +23,7 @@ aside "ASIDES" {
     { "post-data" "POST_DATA" FACTOR-BLOB }
 } define-persistent
 
-: aside-id-key "__a" ;
+CONSTANT: aside-id-key "__a"
 
 TUPLE: asides < server-state-manager ;
 

basis/furnace/auth/login/login.factor

@@ -64,7 +64,7 @@ SYMBOL: capabilities
 
 PRIVATE>
 
-: flashed-variables { description capabilities } ;
+CONSTANT: flashed-variables { description capabilities }
 
 : login-failed ( -- * )
     "invalid username or password" validation-error

basis/furnace/auth/providers/null/null.factor

@@ -3,9 +3,7 @@
 USING: furnace.auth.providers kernel ;
 IN: furnace.auth.providers.null
 
-TUPLE: no-users ;
+SINGLETON: no-users
-
-: no-users T{ no-users } ;
 
 M: no-users get-user 2drop f ;
 

basis/furnace/conversations/conversations.factor

@@ -20,7 +20,7 @@ conversation "CONVERSATIONS" {
     { "session" "SESSION" BIG-INTEGER +not-null+ }
 } define-persistent
 
-: conversation-id-key "__c" ;
+CONSTANT: conversation-id-key "__c"
 
 TUPLE: conversations < server-state-manager ;
 

basis/furnace/sessions/sessions.factor

@@ -73,7 +73,7 @@ TUPLE: sessions < server-state-manager domain verify? ;
     [ session set ] [ save-session-after ] bi
     sessions get responder>> call-responder ;
 
-: session-id-key "__s" ;
+CONSTANT: session-id-key "__s"
 
 : verify-session ( session -- session )
     sessions get verify?>> [

basis/furnace/utilities/utilities.factor

@@ -89,7 +89,7 @@ M: object modify-form drop f ;
         [XML <input type="hidden" value=<-> name=<->/> XML]
     ] [ drop ] if ;
 
-: nested-forms-key "__n" ;
+CONSTANT: nested-forms-key "__n"
 
 : request-params ( request -- assoc )
     dup method>> {
@@ -131,7 +131,7 @@ M: object modify-form drop f ;
 
 SYMBOL: exit-continuation
 
-: exit-with ( value -- )
+: exit-with ( value -- * )
     exit-continuation get continue-with ;
 
 : with-exit-continuation ( quot -- value )

basis/help/topics/topics.factor

@@ -54,7 +54,7 @@ M: no-article summary
     drop "Help article does not exist" ;
 
 : article ( name -- article )
-    dup articles get at* [ nip ] [ drop no-article ] if ;
+    articles get ?at [ no-article ] unless ;
 
 M: object article-name article article-name ;
 M: object article-title article article-title ;

basis/hints/hints.factor

@@ -96,8 +96,6 @@ M: object specializer-declaration class ;
 { string string }
 "specializer" set-word-prop
 
-\ find-last-sep { string sbuf } "specializer" set-word-prop
-
 \ >string { sbuf } "specializer" set-word-prop
 
 \ >array { { vector } } "specializer" set-word-prop

basis/html/templates/chloe/syntax/syntax.factor

@@ -18,7 +18,7 @@ tags [ H{ } clone ] initialize
 : CHLOE:
     scan parse-definition define-chloe-tag ; parsing
 
-: chloe-ns "http://factorcode.org/chloe/1.0" ; inline
+CONSTANT: chloe-ns "http://factorcode.org/chloe/1.0"
 
 : chloe-name? ( name -- ? )
     url>> chloe-ns = ;

basis/images/tiff/tiff.factor

@@ -243,9 +243,6 @@ ERROR: bad-tiff-magic bytes ;
 
 ERROR: no-tag class ;
 
-: ?at ( key assoc -- value/key ? )
-    dupd at* [ nip t ] [ drop f ] if ; inline
-
 : find-tag ( idf class -- tag )
     swap processed-tags>> ?at [ no-tag ] unless ;
 

basis/io/backend/unix/unix.factor

@@ -77,7 +77,7 @@ M: io-timeout summary drop "I/O operation timed out" ;
     '[ handle>> _ wait-for-fd ] with-timeout ;
 
 ! Some general stuff
-: file-mode OCT: 0666 ;
+CONSTANT: file-mode OCT: 0666
  
 ! Readers
 : (refill) ( port -- n )

basis/io/directories/search/search-docs.factor

@@ -38,7 +38,7 @@ HELP: find-in-directories
 
 HELP: find-all-files
 { $values
-     { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation }
+     { "path" "a pathname string" } { "quot" quotation }
      { "paths/f" "a sequence of pathname strings or f" }
 }
 { $description "Finds all files in the input directory matching the predicate quotation in a breadth-first or depth-first traversal." } ;

basis/io/directories/search/search-tests.factor

@@ -5,6 +5,6 @@ IN: io.directories.search.tests
 [ t ] [
     [
         10 [ "io.paths.test" "gogogo" make-unique-file ] replicate
-        current-temporary-directory get t [ ] find-all-files
+        current-temporary-directory get [ ] find-all-files
     ] with-unique-directory drop [ natural-sort ] bi@ =
 ] unit-test

basis/io/directories/search/search.factor

@@ -51,7 +51,8 @@ PRIVATE>
         [ keep and ] curry iterate-directory
     ] [ drop f ] recover ; inline
 
-: find-all-files ( path bfs? quot: ( obj -- ? ) -- paths/f )
+: find-all-files ( path quot: ( obj -- ? ) -- paths/f )
+    f swap
     '[
         _ _ _ [ <directory-iterator> ] dip
         pusher [ [ f ] compose iterate-directory drop ] dip

basis/io/directories/search/windows/windows.factor

@@ -7,7 +7,7 @@ IN: io.directories.search.windows
 : program-files-directories ( -- array )
     program-files program-files-x86 2array harvest ; inline
 
-: find-in-program-files ( base-directory bfs? quot -- path )
+: find-in-program-files ( base-directory quot -- path )
-    [
+    t swap [
         [ program-files-directories ] dip '[ _ append-path ] map
     ] 2dip find-in-directories ; inline

basis/io/encodings/8-bit/8-bit.factor

@@ -4,12 +4,12 @@ USING: math.parser arrays io.encodings sequences kernel assocs
 hashtables io.encodings.ascii generic parser classes.tuple words
 words.symbol io io.files splitting namespaces math
 compiler.units accessors classes.singleton classes.mixin
-io.encodings.iana ;
+io.encodings.iana fry ;
 IN: io.encodings.8-bit
 
 <PRIVATE
 
-: mappings {
+CONSTANT: mappings {
     ! encoding-name iana-name file-name
     { "latin1" "ISO_8859-1:1987" "8859-1" }
     { "latin2" "ISO_8859-2:1987" "8859-2" }
@@ -30,11 +30,10 @@ IN: io.encodings.8-bit
     { "windows-1252" "windows-1252" "CP1252" }
     { "ebcdic" "IBM037" "CP037" }
     { "mac-roman" "macintosh" "ROMAN" }
-} ;
+}
 
 : encoding-file ( file-name -- stream )
-    "vocab:io/encodings/8-bit/" swap ".TXT"
+    "vocab:io/encodings/8-bit/" ".TXT" surround ;
-    3append ;
 
 : process-contents ( lines -- assoc )
     [ "#" split1 drop ] map harvest
@@ -42,7 +41,7 @@ IN: io.encodings.8-bit
 
 : byte>ch ( assoc -- array )
     256 replacement-char <array>
-    [ [ swapd set-nth ] curry assoc-each ] keep ;
+    [ '[ swap _ set-nth ] assoc-each ] keep ;
 
 : ch>byte ( assoc -- newassoc )
     [ swap ] assoc-map >hashtable ;

basis/io/files/info/unix/unix.factor

@@ -114,21 +114,21 @@ M: file-info file-mode? [ permissions>> ] dip mask? ;
 
 PRIVATE>
 
-: UID           OCT: 0004000 ; inline
+CONSTANT: UID           OCT: 0004000
-: GID           OCT: 0002000 ; inline
+CONSTANT: GID           OCT: 0002000
-: STICKY        OCT: 0001000 ; inline
+CONSTANT: STICKY        OCT: 0001000
-: USER-ALL      OCT: 0000700 ; inline
+CONSTANT: USER-ALL      OCT: 0000700
-: USER-READ     OCT: 0000400 ; inline
+CONSTANT: USER-READ     OCT: 0000400
-: USER-WRITE    OCT: 0000200 ; inline
+CONSTANT: USER-WRITE    OCT: 0000200
-: USER-EXECUTE  OCT: 0000100 ; inline
+CONSTANT: USER-EXECUTE  OCT: 0000100
-: GROUP-ALL     OCT: 0000070 ; inline
+CONSTANT: GROUP-ALL     OCT: 0000070
-: GROUP-READ    OCT: 0000040 ; inline
+CONSTANT: GROUP-READ    OCT: 0000040
-: GROUP-WRITE   OCT: 0000020 ; inline
+CONSTANT: GROUP-WRITE   OCT: 0000020
-: GROUP-EXECUTE OCT: 0000010 ; inline
+CONSTANT: GROUP-EXECUTE OCT: 0000010
-: OTHER-ALL     OCT: 0000007 ; inline
+CONSTANT: OTHER-ALL     OCT: 0000007
-: OTHER-READ    OCT: 0000004 ; inline
+CONSTANT: OTHER-READ    OCT: 0000004
-: OTHER-WRITE   OCT: 0000002 ; inline
+CONSTANT: OTHER-WRITE   OCT: 0000002
-: OTHER-EXECUTE OCT: 0000001 ; inline
+CONSTANT: OTHER-EXECUTE OCT: 0000001
 
 : uid? ( obj -- ? ) UID file-mode? ;
 : gid? ( obj -- ? ) GID file-mode? ;

basis/io/mmap/mmap-tests.factor

@@ -1,6 +1,6 @@
 USING: io io.mmap io.mmap.char io.files io.files.temp
 io.directories kernel tools.test continuations sequences
-io.encodings.ascii accessors ;
+io.encodings.ascii accessors math ;
 IN: io.mmap.tests
 
 [ "mmap-test-file.txt" temp-file delete-file ] ignore-errors
@@ -9,3 +9,13 @@ IN: io.mmap.tests
 [ 5 ] [ "mmap-test-file.txt" temp-file [ length ] with-mapped-char-file ] unit-test
 [ "22345" ] [ "mmap-test-file.txt" temp-file ascii file-contents ] unit-test
 [ "mmap-test-file.txt" temp-file delete-file ] ignore-errors
+
+
+[ "mmap-empty-file.txt" temp-file delete-file ] ignore-errors
+[ ] [ "mmap-empty-file.txt" temp-file touch-file ] unit-test
+
+[
+    "mmap-empty-file.txt" temp-file [
+        drop
+    ] with-mapped-file
+] [ bad-mmap-size? ] must-fail-with

basis/io/mmap/mmap.factor

@@ -2,15 +2,20 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: continuations destructors io.files io.files.info
 io.backend kernel quotations system alien alien.accessors
-accessors system vocabs.loader combinators alien.c-types ;
+accessors system vocabs.loader combinators alien.c-types
+math ;
 IN: io.mmap
 
 TUPLE: mapped-file address handle length disposed ;
 
 HOOK: (mapped-file) os ( path length -- address handle )
 
+ERROR: bad-mmap-size path size ;
+
 : <mapped-file> ( path -- mmap )
-    [ normalize-path ] [ file-info size>> ] bi [ (mapped-file) ] keep
+    [ normalize-path ] [ file-info size>> ] bi
+    dup 0 <= [ bad-mmap-size ] when
+    [ (mapped-file) ] keep
     f mapped-file boa ;
 
 HOOK: close-mapped-file io-backend ( mmap -- )

basis/io/mmap/unix/unix.factor

@@ -9,7 +9,7 @@ IN: io.mmap.unix
 :: mmap-open ( path length prot flags -- alien fd )
     [
         f length prot flags
-        path open-r/w |dispose
+        path open-r/w [ <fd> |dispose drop ] keep
         [ 0 mmap dup MAP_FAILED = [ (io-error) ] when ] keep
     ] with-destructors ;
 

basis/io/sockets/unix/unix.factor

@@ -94,7 +94,7 @@ M: unix (datagram)
 
 SYMBOL: receive-buffer
 
-: packet-size 65536 ; inline
+CONSTANT: packet-size 65536
 
 [ packet-size malloc receive-buffer set-global ] "io.sockets.unix" add-init-hook
 

basis/io/streams/byte-array/byte-array.factor

@@ -1,5 +1,8 @@
+! Copyright (C) 2008, 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
 USING: byte-arrays byte-vectors kernel io.encodings io.streams.string
-sequences io namespaces io.encodings.private accessors ;
+sequences io namespaces io.encodings.private accessors sequences.private
+io.streams.sequence destructors ;
 IN: io.streams.byte-array
 
 : <byte-writer> ( encoding -- stream )
@@ -9,8 +12,16 @@ IN: io.streams.byte-array
     [ <byte-writer> ] dip [ output-stream get ] compose with-output-stream*
     dup encoder? [ stream>> ] when >byte-array ; inline
 
+TUPLE: byte-reader { underlying byte-array read-only } { i array-capacity } ;
+
+M: byte-reader stream-read-partial stream-read ;
+M: byte-reader stream-read sequence-read ;
+M: byte-reader stream-read1 sequence-read1 ;
+M: byte-reader stream-read-until sequence-read-until ;
+M: byte-reader dispose drop ;
+
 : <byte-reader> ( byte-array encoding -- stream )
-    [ >byte-vector dup reverse-here ] dip <decoder> ;
+    [ B{ } like 0 byte-reader boa ] dip <decoder> ;
 
 : with-byte-reader ( byte-array encoding quot -- )
     [ <byte-reader> ] dip with-input-stream* ; inline

basis/logging/server/server.factor

@@ -63,7 +63,7 @@ SYMBOL: log-files
     dup values [ try-dispose ] each
     clear-assoc ;
 
-: keep-logs 10 ;
+CONSTANT: keep-logs 10
 
 : ?delete-file ( path -- )
     dup exists? [ delete-file ] [ drop ] if ;

basis/macros/macros.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2007, 2008 Slava Pestov.
+! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: parser kernel sequences words effects combinators assocs
 definitions quotations namespaces memoize accessors ;
@@ -7,7 +7,7 @@ IN: macros
 <PRIVATE
 
 : real-macro-effect ( word -- effect' )
-    "declared-effect" word-prop in>> 1 <effect> ;
+    stack-effect in>> 1 <effect> ;
 
 PRIVATE>
 

basis/math/bits/bits-tests.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test math.bits sequences arrays ;
+USING: tools.test math math.bits sequences arrays ;
 IN: math.bits.tests
 
 [ t ] [ BIN: 111111 3 <bits> second ] unit-test
@@ -14,3 +14,18 @@ IN: math.bits.tests
 [ 2 ] [ -3 make-bits length ] unit-test
 [ 1 ] [ 1 make-bits length ] unit-test
 [ 1 ] [ -1 make-bits length ] unit-test
+
+! Odd bug
+[ t ] [
+    1067811677921310779 make-bits
+    1067811677921310779 >bignum make-bits
+    sequence=
+] unit-test
+
+[ t ] [
+    1067811677921310779 make-bits peek
+] unit-test
+
+[ t ] [
+    1067811677921310779 >bignum make-bits peek
+] unit-test

basis/math/bitwise/bitwise-tests.factor

@@ -19,8 +19,8 @@ IN: math.bitwise.tests
 [ 268 ] [ 1 { 8 { 3 2 } } bitfield ] unit-test
 [ 512 ] [ 1 { { 1+ 8 } } bitfield ] unit-test
 
-: a 1 ; inline
+CONSTANT: a 1
-: b 2 ; inline
+CONSTANT: b 2
 
 : foo ( -- flags ) { a b } flags ;
 

basis/math/functions/functions-tests.factor

@@ -137,3 +137,17 @@ IN: math.functions.tests
 
 [ 6 59967 ] [ 3837888 factor-2s ] unit-test
 [ 6 -59967 ] [ -3837888 factor-2s ] unit-test
+
+[ 1 ] [
+    183009416410801897
+    1067811677921310779
+    2135623355842621559
+    ^mod
+] unit-test
+
+[ 1 ] [
+    183009416410801897
+    1067811677921310779
+    2135623355842621559
+    [ >bignum ] tri@ ^mod
+] unit-test

basis/math/miller-rabin/miller-rabin-tests.factor

@@ -7,4 +7,5 @@ IN: math.miller-rabin.tests
 [ f ] [ 36 miller-rabin ] unit-test
 [ t ] [ 37 miller-rabin ] unit-test
 [ 101 ] [ 100 next-prime ] unit-test
+[ t ] [ 2135623355842621559 miller-rabin ] unit-test
 [ 100000000000031 ] [ 100000000000000 next-prime ] unit-test

basis/math/quaternions/quaternions.factor

@@ -45,13 +45,13 @@ PRIVATE>
     first2 [ imaginary-part ] dip >rect 3array ;
 
 ! Zero
-: q0 { 0 0 } ;
+CONSTANT: q0 { 0 0 }
 
 ! Units
-: q1 { 1 0 } ;
+CONSTANT: q1 { 1 0 }
-: qi { C{ 0 1 } 0 } ;
+CONSTANT: qi { C{ 0 1 } 0 }
-: qj { 0 1 } ;
+CONSTANT: qj { 0 1 }
-: qk { 0 C{ 0 1 } } ;
+CONSTANT: qk { 0 C{ 0 1 } }
 
 ! Euler angles
 

basis/memoize/memoize-tests.factor

@@ -1,7 +1,7 @@
-! Copyright (C) 2007 Slava Pestov, Daniel Ehrenberg.
+! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: math kernel memoize tools.test parser generalizations
-prettyprint io.streams.string sequences eval ;
+prettyprint io.streams.string sequences eval namespaces ;
 IN: memoize.tests
 
 MEMO: fib ( m -- n )
@@ -17,6 +17,10 @@ MEMO: see-test ( a -- b ) reverse ;
 [ [ \ see-test see ] with-string-writer ]
 unit-test
 
-[ ] [ "IN: memoize.tests : fib ;" eval ] unit-test
+[ ] [ "IN: memoize.tests : fib ( -- ) ;" eval ] unit-test
 
 [ "IN: memoize.tests\n: fib ( -- ) ;\n" ] [ [ \ fib see ] with-string-writer ] unit-test
+
+[ sq ] (( a -- b )) memoize-quot "q" set
+
+[ 9 ] [ 3 "q" get call ] unit-test

basis/memoize/memoize.factor

@@ -1,47 +1,45 @@
-! Copyright (C) 2007 Slava Pestov, Daniel Ehrenberg.
+! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel hashtables sequences arrays words namespaces make
 parser math assocs effects definitions quotations summary
-accessors ;
+accessors fry ;
 IN: memoize
 
-: packer ( n -- quot )
-    { [ f ] [ ] [ 2array ] [ 3array ] [ 4array ] } nth ;
-
-: unpacker ( n -- quot )
-    { [ drop ] [ ] [ first2 ] [ first3 ] [ first4 ] } nth ;
-
-: #in ( word -- n )
-    stack-effect in>> length ;
-
-: #out ( word -- n )
-    stack-effect out>> length ;
-
-: pack/unpack ( quot word -- newquot )
-    [ dup #in unpacker % swap % #out packer % ] [ ] make ;
-
-: make-memoizer ( quot word -- quot )
-    [
-        [ #in packer % ] keep
-        [ "memoize" word-prop , ] keep
-        [ pack/unpack , ] keep
-        \ cache ,
-        #out unpacker %
-    ] [ ] make ;
-
 ERROR: too-many-arguments ;
 
 M: too-many-arguments summary
     drop "There must be no more than 4 input and 4 output arguments" ;
 
-: check-memoized ( word -- )
+<PRIVATE
-    [ #in ] [ #out ] bi [ 4 > ] either? [ too-many-arguments ] when ;
+
+: packer ( seq -- quot )
+    length { [ f ] [ ] [ 2array ] [ 3array ] [ 4array ] } nth ;
+
+: unpacker ( seq -- quot )
+    length { [ drop ] [ ] [ first2 ] [ first3 ] [ first4 ] } nth ;
+
+: pack/unpack ( quot effect -- newquot )
+    [ in>> packer ] [ out>> unpacker ] bi surround ;
+
+: unpack/pack ( quot effect -- newquot )
+    [ in>> unpacker ] [ out>> packer ] bi surround ;
+
+: check-memoized ( effect -- )
+    [ in>> ] [ out>> ] bi [ length 4 > ] either? [ too-many-arguments ] when ;
+
+: make-memoizer ( table quot effect -- quot )
+    [ check-memoized ] keep
+    [ unpack/pack '[ _ _ cache ] ] keep
+    pack/unpack ;
+
+PRIVATE>
 
 : define-memoized ( word quot -- )
-    over check-memoized
+    [ H{ } clone ] dip
-    2dup "memo-quot" set-word-prop
+    [ pick stack-effect make-memoizer define ]
-    over H{ } clone "memoize" set-word-prop
+    [ nip "memo-quot" set-word-prop ]
-    over make-memoizer define ;
+    [ drop "memoize" set-word-prop ]
+    3tri ;
 
 : MEMO: (:) define-memoized ; parsing
 
@@ -57,11 +55,10 @@ M: memoized reset-word
     bi ;
 
 : memoize-quot ( quot effect -- memo-quot )
-    gensym swap dupd "declared-effect" set-word-prop
+    [ H{ } clone ] 2dip make-memoizer ;
-    dup rot define-memoized 1quotation ;
 
 : reset-memoized ( word -- )
     "memoize" word-prop clear-assoc ;
 
 : invalidate-memoized ( inputs... word -- )
-    [ #in packer call ] [ "memoize" word-prop delete-at ] bi ;
+    [ stack-effect in>> packer call ] [ "memoize" word-prop delete-at ] bi ;