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

basis/cocoa/cocoa.factor

@@ -60,6 +60,7 @@ SYNTAX: IMPORT: scan [ ] import-objc-class ;
         "NSOpenGLPixelFormat"
         "NSOpenGLView"
         "NSOpenPanel"
+        "NSPanel"
         "NSPasteboard"
         "NSPropertyListSerialization"
         "NSResponder"

basis/cocoa/windows/windows.factor

@@ -4,36 +4,37 @@ USING: arrays kernel math cocoa cocoa.messages cocoa.classes
 sequences math.bitwise ;
 IN: cocoa.windows
 
+! Window styles
 CONSTANT: NSBorderlessWindowMask     0
 CONSTANT: NSTitledWindowMask         1
 CONSTANT: NSClosableWindowMask       2
 CONSTANT: NSMiniaturizableWindowMask 4
 CONSTANT: NSResizableWindowMask      8
 
+! Additional panel-only styles 
+CONSTANT: NSUtilityWindowMask       16
+CONSTANT: NSDocModalWindowMask      64
+CONSTANT: NSNonactivatingPanelMask 128
+CONSTANT: NSHUDWindowMask    HEX: 1000
+
 CONSTANT: NSBackingStoreRetained    0
 CONSTANT: NSBackingStoreNonretained 1
 CONSTANT: NSBackingStoreBuffered    2
 
-: standard-window-type ( -- n )
+: <NSWindow> ( rect style class -- window )
-    {
+    [ -> alloc ] curry 2dip NSBackingStoreBuffered 1
-        NSTitledWindowMask
-        NSClosableWindowMask
-        NSMiniaturizableWindowMask
-        NSResizableWindowMask
-    } flags ; inline
-
-: <NSWindow> ( rect -- window )
-    NSWindow -> alloc swap
-    standard-window-type NSBackingStoreBuffered 1
     -> initWithContentRect:styleMask:backing:defer: ;
 
-: <ViewWindow> ( view rect -- window )
+: class-for-style ( style -- NSWindow/NSPanel )
-    <NSWindow> [ swap -> setContentView: ] keep
+    HEX: 1ff0 bitand zero? NSWindow NSPanel ? ;
+
+: <ViewWindow> ( view rect style -- window )
+    dup class-for-style <NSWindow> [ swap -> setContentView: ] keep
     dup dup -> contentView -> setInitialFirstResponder:
     dup 1 -> setAcceptsMouseMovedEvents:
     dup 0 -> setReleasedWhenClosed: ;
 
 : window-content-rect ( window -- rect )
-    [ NSWindow ] dip
+    dup -> class swap
     [ -> frame ] [ -> styleMask ] bi
     -> contentRectForFrameRect:styleMask: ;

basis/compiler/tree/escape-analysis/escape-analysis-tests.factor

@@ -328,10 +328,3 @@ C: <ro-box> ro-box
 TUPLE: empty-tuple ;
 
 [ ] [ [ empty-tuple boa layout-of ] count-unboxed-allocations drop ] unit-test
-
-! Make sure that initial-quot: doesn't inhibit unboxing
-TUPLE: initial-quot-tuple { x read-only initial-quot: [ 0 ] } ;
-
-[ 1 ] [
-    [ initial-quot-tuple new x>> ] count-unboxed-allocations
-] unit-test

basis/functors/functors.factor

@@ -58,8 +58,6 @@ M: object (fake-quotations>) , ;
     [ parse-definition* ] dip
     parsed ;
 
-: DEFINE* ( accum -- accum ) \ define-declared* parsed ;
-
 SYNTAX: `TUPLE:
     scan-param parsed
     scan {

basis/heaps/heaps.factor

@@ -51,9 +51,6 @@ M: heap heap-size ( heap -- n )
 : data-nth ( n heap -- entry )
     data>> nth-unsafe ; inline
 
-: up-value ( n heap -- entry )
-    [ up ] dip data-nth ; inline
-
 : left-value ( n heap -- entry )
     [ left ] dip data-nth ; inline
 
@@ -75,9 +72,6 @@ M: heap heap-size ( heap -- n )
 : data-pop* ( heap -- )
     data>> pop* ; inline
 
-: data-peek ( heap -- entry )
-    data>> last ; inline
-
 : data-first ( heap -- entry )
     data>> first ; inline
 
@@ -130,9 +124,6 @@ DEFER: up-heap
     2dup right-bounds-check?
     [ drop left ] [ (child) ] if ;
 
-: swap-down ( m heap -- )
-    [ child ] 2keep data-exchange ;
-
 DEFER: down-heap
 
 : (down-heap) ( m heap -- )

basis/help/lint/lint.factor

@@ -55,8 +55,6 @@ PRIVATE>
         ] check-something
     ] [ drop ] if ;
 
-: check-words ( words -- ) [ check-word ] each ;
-
 : check-article ( article -- )
     [ with-interactive-vocabs ] vocabs-quot set
     >link dup '[

basis/io/servers/connection/connection.factor

@@ -11,17 +11,18 @@ combinators.short-circuit ;
 IN: io.servers.connection
 
 TUPLE: threaded-server
-{ name initial: "server" }
+name
-{ log-level initial: DEBUG }
+log-level
-secure insecure
+secure
-{ secure-config initial-quot: [ <secure-config> ] }
+insecure
-{ sockets initial-quot: [ V{ } clone ] }
+secure-config
+sockets
 max-connections
 semaphore
-{ timeout initial-quot: [ 1 minutes ] }
+timeout
 encoding
-{ handler initial: [ "No handler quotation" throw ] }
+handler
-{ ready initial-quot: [ <flag> ] } ;
+ready ;
 
 : local-server ( port -- addrspec ) "localhost" swap <inet> ;
 
@@ -29,6 +30,13 @@ encoding
 
 : new-threaded-server ( encoding class -- threaded-server )
     new
+        "server" >>name
+        DEBUG >>log-level
+        <secure-config> >>secure-config
+        V{ } clone >>sockets
+        1 minutes >>timeout
+        [ "No handler quotation" throw ] >>handler
+        <flag> >>ready
         swap >>encoding ;
 
 : <threaded-server> ( encoding -- threaded-server )

basis/opengl/opengl.factor

@@ -25,6 +25,7 @@ IN: opengl
         { HEX: 0503 "Stack overflow" }
         { HEX: 0504 "Stack underflow" }
         { HEX: 0505 "Out of memory" }
+        { HEX: 0506 "Invalid framebuffer operation" }
     } at "Unknown error" or ;
 
 TUPLE: gl-error code string ;

basis/opengl/shaders/shaders.factor

@@ -61,10 +61,21 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ;
 
 ! Programs
 
+: <mrt-gl-program> ( shaders frag-data-locations -- program )
+    glCreateProgram 
+    [
+        [ swap [ glAttachShader ] with each ]
+        [ swap [ first2 swap glBindFragDataLocationEXT ] with each ] bi-curry bi*
+    ]
+    [ glLinkProgram ]
+    [ ] tri
+    gl-error ;
+
 : <gl-program> ( shaders -- program )
-    glCreateProgram swap
+    glCreateProgram 
-    [ dupd glAttachShader ] each
+    [ swap [ glAttachShader ] with each ]
-    [ glLinkProgram ] keep
+    [ glLinkProgram ]
+    [ ] tri
     gl-error ;
     
 : (gl-program?) ( object -- ? )

basis/opengl/textures/textures.factor

@@ -135,9 +135,6 @@ TUPLE: multi-texture grid display-list loc disposed ;
     [ dup image-locs ] dip
     '[ [ _ v+ <single-texture> |dispose ] 2map ] 2map ;
 
-: draw-textured-grid ( grid -- )
-    [ [ [ dim>> ] keep (draw-textured-rect) ] each ] each ;
-
 : grid-has-alpha? ( grid -- ? )
     first first image>> has-alpha? ;
 

basis/persistent/vectors/vectors-docs.factor

@@ -2,7 +2,7 @@ USING: help.markup help.syntax kernel math sequences ;
 IN: persistent.vectors
 
 HELP: PV{
-{ $syntax "elements... }" }
+{ $syntax "PV{ elements... }" }
 { $description "Parses a literal " { $link persistent-vector } "." } ;
 
 HELP: >persistent-vector

basis/ui/backend/cocoa/cocoa.factor

@@ -109,10 +109,23 @@ M: cocoa-ui-backend (set-fullscreen) ( world ? -- )
 M: cocoa-ui-backend (fullscreen?) ( world -- ? )
     handle>> view>> -> isInFullScreenMode zero? not ;
 
+CONSTANT: window-control>styleMask
+    H{
+        { close-button $ NSClosableWindowMask }
+        { minimize-button $ NSMiniaturizableWindowMask }
+        { maximize-button 0 }
+        { resize-handles $ NSResizableWindowMask }
+        { small-title-bar $[ NSTitledWindowMask NSUtilityWindowMask bitor ] }
+        { normal-title-bar $ NSTitledWindowMask }
+    }
+
+: world>styleMask ( world -- n )
+    window-controls>> [ window-control>styleMask at ] map 0 [ bitor ] reduce ;
+
 M:: cocoa-ui-backend (open-window) ( world -- )
     world [ [ dim>> ] dip <FactorView> ]
     with-world-pixel-format :> view
-    view world world>NSRect <ViewWindow> :> window
+    view world [ world>NSRect ] [ world>styleMask ] bi <ViewWindow> :> window
     view -> release
     world view register-window
     window world window-loc>> auto-position
@@ -145,7 +158,7 @@ M: cocoa-ui-backend (ungrab-input) ( handle -- )
 M: cocoa-ui-backend close-window ( gadget -- )
     find-world [
         handle>> [
-            window>> f -> performClose:
+            window>> -> close
         ] when*
     ] when* ;
 

basis/ui/baseline-alignment/baseline-alignment.factor

@@ -36,9 +36,6 @@ TUPLE: gadget-metrics height ascent descent cap-height ;
 : max-descent ( seq -- n )
     [ descent>> ] map ?supremum ;
 
-: max-text-height ( seq -- y )
-    [ ascent>> ] filter [ height>> ] map ?supremum ;
-
 : max-graphics-height ( seq -- y )
     [ ascent>> not ] filter [ height>> ] map ?supremum 0 or ;
 

basis/ui/gadgets/gadgets.factor

@@ -112,8 +112,7 @@ M: gadget gadget-text-separator
     orientation>> vertical = "\n" "" ? ;
 
 : gadget-seq-text ( seq gadget -- )
-    gadget-text-separator swap
+    gadget-text-separator '[ _ % ] [ gadget-text* ] interleave ;
-    [ dup % ] [ gadget-text* ] interleave drop ;
 
 M: gadget gadget-text*
     [ children>> ] keep gadget-seq-text ;

basis/ui/gadgets/panes/panes.factor

@@ -96,10 +96,6 @@ M: pane selected-children
         add-incremental
     ] [ next-line ] bi ;
 
-: ?pane-nl ( pane -- )
-    [ dup current>> children>> empty? [ pane-nl ] [ drop ] if ]
-    [ pane-nl ] bi ;
-
 : smash-pane ( pane -- gadget ) [ pane-nl ] [ output>> smash-line ] bi ;
 
 : pane-write ( seq pane -- )

basis/ui/gadgets/sliders/sliders-docs.factor

@@ -5,10 +5,6 @@ IN: ui.gadgets.sliders
 HELP: elevator
 { $class-description "An elevator is the part of a " { $link slider } " between the up/down arrow buttons, where a " { $link thumb } " may be moved up and down." } ;
 
-HELP: find-elevator
-{ $values { "gadget" gadget } { "elevator/f" { $maybe elevator } } }
-{ $description "Finds the first parent of " { $snippet "gadget" } " which is an " { $link elevator } ". Outputs " { $link f } " if the gadget is not contained in an " { $link elevator } "." } ;
-
 HELP: slider
 { $class-description "A slider is a control for graphically manipulating a " { $link "models-range" } "."
 $nl

basis/ui/gadgets/sliders/sliders.factor

@@ -23,8 +23,6 @@ TUPLE: slider < track elevator thumb saved line ;
 
 TUPLE: elevator < gadget direction ;
 
-: find-elevator ( gadget -- elevator/f ) [ elevator? ] find-parent ;
-
 : find-slider ( gadget -- slider/f ) [ slider? ] find-parent ;
 
 CONSTANT: elevator-padding 4

basis/ui/gadgets/worlds/worlds.factor

@@ -7,16 +7,34 @@ ui.gadgets ui.gestures ui.render ui.backend ui.gadgets.tracks
 ui.pixel-formats destructors literals strings ;
 IN: ui.gadgets.worlds
 
+SYMBOLS:
+    close-button
+    minimize-button
+    maximize-button
+    resize-handles
+    small-title-bar
+    normal-title-bar ;
+
 CONSTANT: default-world-pixel-format-attributes
     { windowed double-buffered T{ depth-bits { value 16 } } }
 
+CONSTANT: default-world-window-controls
+    {
+        normal-title-bar
+        close-button
+        minimize-button
+        maximize-button
+        resize-handles
+    }
+
 TUPLE: world < track
     active? focused? grab-input?
     layers
     title status status-owner
     text-handle handle images
     window-loc
-    pixel-format-attributes ;
+    pixel-format-attributes
+    window-controls ;
 
 TUPLE: world-attributes
     { world-class initial: world }
@@ -24,7 +42,8 @@ TUPLE: world-attributes
     { title string initial: "Factor Window" }
     status
     gadgets
-    { pixel-format-attributes initial: $ default-world-pixel-format-attributes } ;
+    { pixel-format-attributes initial: $ default-world-pixel-format-attributes }
+    { window-controls initial: $ default-world-window-controls } ;
 
 : <world-attributes> ( -- world-attributes )
     world-attributes new ; inline
@@ -86,6 +105,7 @@ M: world request-focus-on ( child gadget -- )
         [ title>> >>title ]
         [ status>> >>status ]
         [ pixel-format-attributes>> >>pixel-format-attributes ]
+        [ window-controls>> >>window-controls ]
         [ grab-input?>> >>grab-input? ]
         [ gadgets>> [ 1 track-add ] each ]
     } cleave ;

basis/unicode/breaks/breaks.factor

@@ -72,9 +72,6 @@ SYMBOL: table
 : connect ( class1 class2 -- ) 1 set-table ;
 : disconnect ( class1 class2 -- ) 0 set-table ;
   
-: break-around ( classes1 classes2 -- )
-    [ disconnect ] [ swap disconnect ] 2bi ;
-
 : make-grapheme-table ( -- )
     { CR } { LF } connect
     { Control CR LF } graphemes disconnect
@@ -91,9 +88,6 @@ VALUE: grapheme-table
 : grapheme-break? ( class1 class2 -- ? )
     grapheme-table nth nth not ;
 
-: chars ( i str n -- str[i] str[i+n] )
-    swap [ dupd + ] dip [ ?nth ] curry bi@ ;
-
 PRIVATE>
 
 : first-grapheme ( str -- i )

core/bootstrap/syntax.factor

@@ -80,7 +80,6 @@ IN: bootstrap.syntax
     ">>"
     "call-next-method"
     "initial:"
-    "initial-quot:"
     "read-only"
     "call("
     "execute("

core/classes/tuple/parser/parser-tests.factor

@@ -142,11 +142,3 @@ TUPLE: parsing-corner-case x ;
         "    x 3 }"
     } "\n" join eval( -- tuple )
 ] [ error>> unexpected-eof? ] must-fail-with
-
-
-[ ] [
-    <" USE: sequences
-    IN: classes.tuple.tests
-    TUPLE: book { name initial-quot: [ "Lord of the " "Rings" append ] } ;">
-    eval( -- )
-] unit-test

core/classes/tuple/tuple-tests.factor

@@ -729,50 +729,3 @@ DEFER: redefine-tuple-twice
 [ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval( -- ) ] unit-test
 
 [ t ] [ \ redefine-tuple-twice symbol? ] unit-test
-
-TUPLE: lucky-number { n initial-quot: [ 64 random-bits ] } ;
-SLOT: winner?
-
-[ t ] [ lucky-number new n>> integer? ] unit-test
-
-: compiled-lucky-number ( -- tuple ) lucky-number new ;
-
-[ t ] [ compiled-lucky-number n>> integer? ] unit-test
-
-! Reshaping initial-quot:
-lucky-number new dup n>> 2array "luckiest-number" set
-
-[ t ] [ "luckiest-number" get first2 [ n>> ] dip = ] unit-test
-
-[ ] [ "USING: accessors random ; IN: classes.tuple.tests TUPLE: lucky-number { n initial-quot: [ 64 random-bits ] } { winner? initial-quot: [ t ] } ;" eval( -- ) ] unit-test
-
-[ t ] [ "luckiest-number" get first2 [ n>> ] dip = ] unit-test
-[ t ] [ "luckiest-number" get first winner?>> ] unit-test
-
-! invalid-quot: together with type declaration
-TUPLE: decl-initial-quot { x integer initial-quot: [ 1 ] } ;
-
-[ t ] [ decl-initial-quot new x>> integer? ] unit-test
-
-: compiled-decl-initial-quot ( -- tuple ) decl-initial-quot new ;
-
-[ t ] [ compiled-decl-initial-quot x>> integer? ] unit-test
-
-! invalid-quot: with read-only
-TUPLE: read-only-initial-quot { x integer read-only initial-quot: [ 1 ] } ;
-
-[ t ] [ read-only-initial-quot new x>> integer? ] unit-test
-
-: compiled-read-only-initial-quot ( -- tuple ) read-only-initial-quot new ;
-
-[ t ] [ compiled-read-only-initial-quot x>> integer? ] unit-test
-
-! Specifying both initial: and initial-quot: should fail
-2 [
-    [
-        "IN: classes.tuple.test TUPLE: redundant-decl { x initial: 0 initial-quot: [ 0 ] } ;"
-        eval( -- )
-    ]
-    [ error>> duplicate-initial-values? ]
-    must-fail-with
-] times

core/classes/tuple/tuple.factor

@@ -50,9 +50,6 @@ M: tuple class layout-of 2 slot { word } declare ;
 
 PRIVATE>
 
-: initial-quots? ( class -- ? )
-    all-slots [ initial-quot>> ] any? ;
-
 : initial-values ( class -- slots )
     all-slots [ initial>> ] map ;
 
@@ -149,21 +146,12 @@ ERROR: bad-superclass class ;
 : define-boa-check ( class -- )
     dup boa-check-quot "boa-check" set-word-prop ;
 
-: tuple-initial-quots-quot ( class -- quot )
-    all-slots [ initial-quot>> ] filter
-    [
-        [
-            [ initial-quot>> % \ over , ] [ offset>> , ] bi \ set-slot ,
-        ] each
-    ] [ ] make f like ;
-
 : tuple-prototype ( class -- prototype )
-    [ initial-values ] [ over [ ] any? ] [ initial-quots? or ] tri
+    [ initial-values ] keep over [ ] any?
     [ slots>tuple ] [ 2drop f ] if ;
 
 : define-tuple-prototype ( class -- )
-    dup [ tuple-prototype ] [ tuple-initial-quots-quot ] bi 2array
+    dup tuple-prototype "prototype" set-word-prop ;
-    dup [ ] any? [ drop f ] unless "prototype" set-word-prop ;
 
 : prepare-slots ( slots superclass -- slots' )
     [ make-slots ] [ class-size 2 + ] bi* finalize-slots ;
@@ -185,16 +173,10 @@ ERROR: bad-superclass class ;
 : define-tuple-layout ( class -- )
     dup make-tuple-layout "layout" set-word-prop ;
 
-: calculate-initial-value ( slot-spec -- value )
-    dup initial>> [ ] [
-        dup initial-quot>>
-        [ call( -- obj ) ] [ drop f ] ?if
-    ] ?if ;
-
 : compute-slot-permutation ( new-slots old-slots -- triples )
     [ [ [ name>> ] map ] bi@ [ index ] curry map ]
     [ drop [ class>> ] map ]
-    [ drop [ calculate-initial-value ] map ]
+    [ drop [ initial>> ] map ]
     2tri 3array flip ;
 
 : update-slot ( old-values n class initial -- value )
@@ -358,11 +340,7 @@ M: tuple tuple-hashcode
 M: tuple hashcode* tuple-hashcode ;
 
 M: tuple-class new
-    dup "prototype" word-prop [
+    dup "prototype" word-prop [ (clone) ] [ tuple-layout <tuple> ] ?if ;
-        first2 [ (clone) ] dip [ call( obj -- obj ) ] when*
-    ] [
-        tuple-layout <tuple>
-    ] ?if ;
 
 M: tuple-class boa
     [ "boa-check" word-prop [ call ] when* ]

core/generic/math/math-docs.factor

@@ -40,6 +40,4 @@ $nl
 HELP: math-generic
 { $class-description "The class of generic words using " { $link math-combination } "." } ;
 
-HELP: last/first
+
-{ $values { "seq" sequence } { "pair" "a two-element array" } }
-{ $description "Creates an array holding the first and last element of the sequence." } ;

core/generic/math/math.factor

@@ -15,8 +15,6 @@ PREDICATE: math-class < class
 
 <PRIVATE
 
-: last/first ( seq -- pair ) [ last ] [ first ] bi 2array ;
-
 : bootstrap-words ( classes -- classes' )
     [ bootstrap-word ] map ;
 

core/lexer/lexer-docs.factor

@@ -29,7 +29,7 @@ HELP: <lexer-error>
 
 HELP: skip
 { $values { "i" "a starting index" } { "seq" sequence } { "?" "a boolean" } { "n" integer } }
-{ $description "Skips to the first space character (if " { $snippet "boolean" } " is " { $link f } ") or the first non-space character (otherwise)." } ;
+{ $description "Skips to the first space character (if " { $snippet "boolean" } " is " { $link f } ") or the first non-space character (otherwise). Tabulations used as separators instead of spaces will be flagged as an error." } ;
 
 HELP: change-lexer-column
 { $values { "lexer" lexer } { "quot" { $quotation "( col line -- newcol )" } } }

core/lexer/lexer.factor

@@ -22,9 +22,17 @@ TUPLE: lexer text line line-text line-length column ;
 : <lexer> ( text -- lexer )
     lexer new-lexer ;
 
+ERROR: unexpected want got ;
+
+PREDICATE: unexpected-tab < unexpected
+    got>> CHAR: \t = ;
+
+: forbid-tab ( c -- c )
+    [ CHAR: \t eq? [ "[space]" "[tab]" unexpected ] when ] keep ;
+
 : skip ( i seq ? -- n )
     over length
-    [ [ swap CHAR: \s eq? xor ] curry find-from drop ] dip or ;
+    [ [ swap forbid-tab CHAR: \s eq? xor ] curry find-from drop ] dip or ;
 
 : change-lexer-column ( lexer quot -- )
     [ [ column>> ] [ line-text>> ] bi ] prepose keep
@@ -65,8 +73,6 @@ M: lexer skip-word ( lexer -- )
 
 : scan ( -- str/f ) lexer get parse-token ;
 
-ERROR: unexpected want got ;
-
 PREDICATE: unexpected-eof < unexpected
     got>> not ;
 

core/sequences/sequences-tests.factor

@@ -286,3 +286,8 @@ M: bogus-hashcode hashcode* 2drop 0 >bignum ;
 [ f f ] [
     { 1 2 3 4 5 6 7 8 } [ H{ { 11 "hi" } } at ] map-find
 ] unit-test
+
+USE: make
+
+[ { "a" 1 "b" 1 "c" } ]
+[ 1 { "a" "b" "c" } [ [ dup , ] [ , ] interleave drop ] { } make ] unit-test

core/sequences/sequences.factor

@@ -510,7 +510,7 @@ PRIVATE>
 : interleave ( seq between quot -- )
     pick empty? [ 3drop ] [
         [ [ drop first-unsafe ] dip call ]
-        [ [ rest-slice ] 2dip [ [ call ] bi@ ] 2curry each ]
+        [ [ rest-slice ] 2dip [ bi* ] 2curry each ]
         3bi
     ] if ; inline
 

core/slots/slots.factor

@@ -6,7 +6,7 @@ classes classes.algebra slots.private combinators accessors
 words sequences.private assocs alien quotations hashtables ;
 IN: slots
 
-TUPLE: slot-spec name offset class initial initial-quot read-only ;
+TUPLE: slot-spec name offset class initial read-only ;
 
 PREDICATE: reader < word "reader" word-prop ;
 
@@ -190,7 +190,6 @@ ERROR: bad-slot-attribute key ;
     dup empty? [
         unclip {
             { initial: [ [ first >>initial ] [ rest ] bi ] }
-            { initial-quot: [ [ first >>initial-quot ] [ rest ] bi ] }
             { read-only [ [ t >>read-only ] dip ] }
             [ bad-slot-attribute ]
         } case
@@ -198,14 +197,7 @@ ERROR: bad-slot-attribute key ;
 
 ERROR: bad-initial-value name ;
 
-ERROR: duplicate-initial-values slot ;
-
-: check-duplicate-initial-values ( slot-spec -- slot-spec )
-    dup [ initial>> ] [ initial-quot>> ] bi and
-    [ duplicate-initial-values ] when ;
-
 : check-initial-value ( slot-spec -- slot-spec )
-    check-duplicate-initial-values
     dup initial>> [
         [ ] [
             dup [ initial>> ] [ class>> ] bi instance?

core/syntax/syntax.factor

@@ -246,8 +246,6 @@ IN: bootstrap.syntax
     
     "initial:" "syntax" lookup define-symbol
 
-    "initial-quot:" "syntax" lookup define-symbol
-
     "read-only" "syntax" lookup define-symbol
 
     "call(" [ \ call-effect parse-call( ] define-core-syntax