From 29327a787c6a236ffa10c65c8838759ec7a70c58 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 15 Jun 2009 13:07:15 -0500 Subject: [PATCH] Remove initial-quot feature --- .../escape-analysis-tests.factor | 7 --- basis/io/servers/connection/connection.factor | 24 ++++++---- core/bootstrap/syntax.factor | 1 - core/classes/tuple/parser/parser-tests.factor | 10 +--- core/classes/tuple/tuple-tests.factor | 47 ------------------- core/classes/tuple/tuple.factor | 30 ++---------- core/slots/slots.factor | 10 +--- core/syntax/syntax.factor | 2 - 8 files changed, 22 insertions(+), 109 deletions(-) diff --git a/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor b/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor index 2688f7f8f1..4fb01608f0 100644 --- a/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor +++ b/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor @@ -328,10 +328,3 @@ C: 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 \ No newline at end of file diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor index de75165c7a..345b739b61 100644 --- a/basis/io/servers/connection/connection.factor +++ b/basis/io/servers/connection/connection.factor @@ -11,17 +11,18 @@ combinators.short-circuit ; IN: io.servers.connection TUPLE: threaded-server -{ name initial: "server" } -{ log-level initial: DEBUG } -secure insecure -{ secure-config initial-quot: [ ] } -{ sockets initial-quot: [ V{ } clone ] } +name +log-level +secure +insecure +secure-config +sockets max-connections semaphore -{ timeout initial-quot: [ 1 minutes ] } +timeout encoding -{ handler initial: [ "No handler quotation" throw ] } -{ ready initial-quot: [ ] } ; +handler +ready ; : local-server ( port -- addrspec ) "localhost" swap ; @@ -29,6 +30,13 @@ encoding : new-threaded-server ( encoding class -- threaded-server ) new + "server" >>name + DEBUG >>log-level + >>secure-config + V{ } clone >>sockets + 1 minutes >>timeout + [ "No handler quotation" throw ] >>handler + >>ready swap >>encoding ; : ( encoding -- threaded-server ) diff --git a/core/bootstrap/syntax.factor b/core/bootstrap/syntax.factor index 24538229c6..f5182a0210 100644 --- a/core/bootstrap/syntax.factor +++ b/core/bootstrap/syntax.factor @@ -80,7 +80,6 @@ IN: bootstrap.syntax ">>" "call-next-method" "initial:" - "initial-quot:" "read-only" "call(" "execute(" diff --git a/core/classes/tuple/parser/parser-tests.factor b/core/classes/tuple/parser/parser-tests.factor index 350b594274..72457ff974 100644 --- a/core/classes/tuple/parser/parser-tests.factor +++ b/core/classes/tuple/parser/parser-tests.factor @@ -141,12 +141,4 @@ TUPLE: parsing-corner-case x ; "USE: classes.tuple.parser.tests T{ parsing-corner-case {" " 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 +] [ error>> unexpected-eof? ] must-fail-with \ No newline at end of file diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index 4b23578a29..191ec75544 100644 --- a/core/classes/tuple/tuple-tests.factor +++ b/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 diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index 4ca57a59ed..7633f9b4c8 100755 --- a/core/classes/tuple/tuple.factor +++ b/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 [ ] any? [ drop f ] unless "prototype" set-word-prop ; + dup tuple-prototype "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 [ - first2 [ (clone) ] dip [ call( obj -- obj ) ] when* - ] [ - tuple-layout - ] ?if ; + dup "prototype" word-prop [ (clone) ] [ tuple-layout ] ?if ; M: tuple-class boa [ "boa-check" word-prop [ call ] when* ] diff --git a/core/slots/slots.factor b/core/slots/slots.factor index c8be08e79b..304ded0adb 100755 --- a/core/slots/slots.factor +++ b/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? diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 8093b6345b..7b9a0d36ef 100644 --- a/core/syntax/syntax.factor +++ b/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