Move call( and execute( to core

diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index c3fd41e68973ee64545218b49d216003782c5dba..dc35f8bbb05fb94f0345c512c0907241df5f1721 100755 (executable)
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -4,7 +4,7 @@ USING: byte-arrays arrays assocs kernel kernel.private libc math
 namespaces make parser sequences strings words assocs splitting
 math.parser cpu.architecture alien alien.accessors quotations
 layouts system compiler.units io.files io.encodings.binary
-accessors combinators effects continuations fry call classes ;
+accessors combinators effects continuations fry classes ;
 IN: alien.c-types
 
 DEFER: <int>

diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor
index aeedef39bdc7e2b5e391ea52e404d095b13fbc9e..a2621f4c32500d7b8b468d8f6a84f3cbf393a362 100644 (file)
--- a/basis/bootstrap/image/image.factor
+++ b/basis/bootstrap/image/image.factor
@@ -446,6 +446,8 @@ M: quotation '
         quotation type-number object tag-number [
             emit ! array
             f ' emit ! compiled
+            f ' emit ! cached-effect
+            f ' emit ! cache-counter
             0 emit ! xt
             0 emit ! code
         ] emit-object

diff --git a/basis/call/authors.txt b/basis/call/authors.txt
deleted file mode 100644 (file)
index 33616a2..0000000
--- a/basis/call/authors.txt
+++ /dev/null
@@ -1,2 +0,0 @@
-Daniel Ehrenberg
-Slava Pestov

diff --git a/basis/call/call-docs.factor b/basis/call/call-docs.factor
deleted file mode 100644 (file)
index 5f76f53..0000000
--- a/basis/call/call-docs.factor
+++ /dev/null
@@ -1,47 +0,0 @@
-! Copyright (C) 2009 Daniel Ehrenberg.
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax quotations effects words call.private ;
-IN: call
-
-ABOUT: "call"
-
-ARTICLE: "call" "Calling code with known stack effects"
-"The " { $vocab-link "call" } " vocabulary allows for arbitrary quotations to be called from code accepted by the optimizing compiler. This is done by specifying the stack effect of the quotation literally. It is checked at runtime that the stack effect is accurate."
-$nl
-"Quotations:"
-{ $subsection POSTPONE: call( }
-{ $subsection call-effect }
-"Words:"
-{ $subsection POSTPONE: execute( }
-{ $subsection execute-effect }
-"Unsafe calls:"
-{ $subsection POSTPONE: execute-unsafe( }
-{ $subsection execute-effect-unsafe } ;
-
-HELP: call(
-{ $syntax "call( stack -- effect )" }
-{ $description "Calls the quotation on the top of the stack, asserting that it has the given stack effect. The quotation does not need to be known at compile time." } ;
-
-HELP: call-effect
-{ $values { "quot" quotation } { "effect" effect } }
-{ $description "Given a quotation and a stack effect, calls the quotation, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary quotation which is not required at compile time." } ;
-
-HELP: execute(
-{ $syntax "execute( stack -- effect )" }
-{ $description "Calls the word on the top of the stack, asserting that it has the given stack effect. The word does not need to be known at compile time." } ;
-
-HELP: execute-effect
-{ $values { "word" word } { "effect" effect } }
-{ $description "Given a word and a stack effect, executes the word, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary word which is not required at compile time." } ;
-
-HELP: execute-unsafe(
-{ $syntax "execute-unsafe( stack -- effect )" }
-{ $description "Calls the word on the top of the stack, blindly declaring that it has the given stack effect. The word does not need to be known at compile time." }
-{ $warning "If the word being executed has an incorrect stack effect, undefined behavior will result. User code should use " { $link POSTPONE: execute( } " instead." } ;
-HELP: execute-effect-unsafe
-{ $values { "word" word } { "effect" effect } }
-{ $description "Given a word and a stack effect, executes the word, blindly declaring at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary word which is not required at compile time." }
-{ $warning "If the word being executed has an incorrect stack effect, undefined behavior will result. User code should use " { $link execute-effect-unsafe } " instead." } ;
-    
-{ call-effect execute-effect execute-effect-unsafe } related-words
-{ POSTPONE: call( POSTPONE: execute( POSTPONE: execute-unsafe( } related-words
\ No newline at end of file

diff --git a/basis/call/call-tests.factor b/basis/call/call-tests.factor
deleted file mode 100644 (file)
index bc6f9a5..0000000
--- a/basis/call/call-tests.factor
+++ /dev/null
@@ -1,33 +0,0 @@
-! Copyright (C) 2009 Daniel Ehrenberg.
-! See http://factorcode.org/license.txt for BSD license.
-USING: math tools.test call call.private kernel accessors ;
-IN: call.tests
-
-[ 3 ] [ 1 2 [ + ] call( x y -- z ) ] unit-test
-[ 1 2 [ + ] call( -- z ) ] must-fail
-[ 1 2 [ + ] call( x y -- z a ) ] must-fail
-[ 1 2 3 { 1 2 3 4 } ] [ 1 2 3 4 [ datastack nip ] call( x -- y ) ] unit-test
-[ [ + ] call( x y -- z ) ] must-infer
-
-[ 3 ] [ 1 2 \ + execute( x y -- z ) ] unit-test
-[ 1 2 \ + execute( -- z ) ] must-fail
-[ 1 2 \ + execute( x y -- z a ) ] must-fail
-[ \ + execute( x y -- z ) ] must-infer
-
-: compile-execute(-test-1 ( a b -- c ) \ + execute( a b -- c ) ;
-
-[ t ] [ \ compile-execute(-test-1 optimized>> ] unit-test
-[ 4 ] [ 1 3 compile-execute(-test-1 ] unit-test
-
-: compile-execute(-test-2 ( a b w -- c ) execute( a b -- c ) ;
-
-[ t ] [ \ compile-execute(-test-2 optimized>> ] unit-test
-[ 4 ] [ 1 3 \ + compile-execute(-test-2 ] unit-test
-[ 5 ] [ 1 4 \ + compile-execute(-test-2 ] unit-test
-[ -3 ] [ 1 4 \ - compile-execute(-test-2 ] unit-test
-[ 5 ] [ 1 4 \ + compile-execute(-test-2 ] unit-test
-
-[ t ] [ \ + (( a b -- c )) execute-effect-unsafe? ] unit-test
-[ t ] [ \ + (( a b c -- d e )) execute-effect-unsafe? ] unit-test
-[ f ] [ \ + (( a b c -- d )) execute-effect-unsafe? ] unit-test
-[ f ] [ \ call (( x -- )) execute-effect-unsafe? ] unit-test

diff --git a/basis/call/call.factor b/basis/call/call.factor
deleted file mode 100644 (file)
index e4803c3..0000000
--- a/basis/call/call.factor
+++ /dev/null
@@ -1,74 +0,0 @@
-! Copyright (C) 2009 Daniel Ehrenberg, Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel kernel.private macros fry summary sequences
-sequences.private accessors effects effects.parser parser words
-make ;
-IN: call
-
-ERROR: wrong-values effect ;
-
-M: wrong-values summary drop "Quotation called with stack effect" ;
-
-<PRIVATE
-
-: parse-call( ( accum word -- accum )
-    [ ")" parse-effect parsed ] dip parsed ;
-
-: call-effect-unsafe ( quot effect -- )
-    drop call ;
-
-: call-unsafe( \ call-effect-unsafe parse-call( ; parsing
-
-PRIVATE>
-
-: (call-effect>quot) ( in out effect -- quot )
-    [
-        [ [ datastack ] dip dip ] %
-        [ [ , ] bi@ \ check-datastack , ] dip [ wrong-values ] curry , \ unless ,
-    ] [ ] make ;
-
-: call-effect>quot ( effect -- quot )
-    [ in>> length ] [ out>> length ] [ ] tri
-    [ (call-effect>quot) ] keep add-effect-input
-    [ call-effect-unsafe ] 2curry ;
-
-MACRO: call-effect ( effect -- quot )
-    call-effect>quot ;
-
-: call( \ call-effect parse-call( ; parsing
-
-<PRIVATE
-
-: execute-effect-unsafe ( word effect -- )
-    drop execute ;
-
-: execute-unsafe( \ execute-effect-unsafe parse-call( ; parsing
-
-: execute-effect-slow ( word effect -- )
-    [ [ execute ] curry ] dip call-effect ; inline
-
-: cache-hit? ( word ic -- ? ) first-unsafe eq? ; inline
-
-: cache-hit ( word effect ic -- ) drop execute-effect-unsafe ; inline
-
-: execute-effect-unsafe? ( word effect -- ? )
-    over optimized>> [ [ stack-effect ] dip effect<= ] [ 2drop f ] if ; inline
-
-: cache-miss ( word effect ic -- )
-    2over execute-effect-unsafe?
-    [ [ nip set-first ] [ drop execute-effect-unsafe ] 3bi ]
-    [ execute-effect-slow ] if ; inline
-
-: execute-effect-ic ( word effect ic -- )
-    #! ic is a mutable cell { effect }
-    3dup nip cache-hit? [ cache-hit ] [ cache-miss ] if ; inline
-
-: execute-effect>quot ( effect -- quot )
-    { f } clone [ execute-effect-ic ] 2curry ;
-
-PRIVATE>
-
-MACRO: execute-effect ( effect -- )
-    execute-effect>quot ;
-
-: execute( \ execute-effect parse-call( ; parsing

diff --git a/basis/call/summary.txt b/basis/call/summary.txt
deleted file mode 100644 (file)
index d449497..0000000
--- a/basis/call/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-Calling arbitrary quotations and executing arbitrary words with a static stack effect

diff --git a/basis/call/tags.txt b/basis/call/tags.txt
deleted file mode 100644 (file)
index f427429..0000000
--- a/basis/call/tags.txt
+++ /dev/null
@@ -1 +0,0 @@
-extensions

diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor
index 8818c9a217a6f241231db53ba6d05555cc148863..f71b9f3f56a7f6987f36421caead7c646010699e 100644 (file)
--- a/basis/cocoa/messages/messages.factor
+++ b/basis/cocoa/messages/messages.factor
@@ -5,7 +5,7 @@ continuations combinators compiler compiler.alien stack-checker kernel
 math namespaces make parser quotations sequences strings words
 cocoa.runtime io macros memoize io.encodings.utf8 effects libc
 libc.private parser lexer init core-foundation fry generalizations
-specialized-arrays.direct.alien call ;
+specialized-arrays.direct.alien ;
 IN: cocoa.messages
 
 : make-sender ( method function -- quot )

diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index 486675ec26d918587fb1dc9c2cdcf2c88ff55d22..40b1f56f8b121eca5e6eebb445600cb079666e97 100755 (executable)
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -3,7 +3,7 @@
 USING: namespaces make math math.order math.parser sequences accessors
 kernel kernel.private layouts assocs words summary arrays
 combinators classes.algebra alien alien.c-types alien.structs
-alien.strings alien.arrays alien.complex sets libc call
+alien.strings alien.arrays alien.complex sets libc
 continuations.private fry cpu.architecture
 compiler.errors
 compiler.alien

diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor
index f9627752e7ae84a202f8fa7b8793f18422d4c1be..c8e1e5fd0f49fa37fc2d6598c91e0652664d75a2 100644 (file)
--- a/basis/compiler/compiler.factor
+++ b/basis/compiler/compiler.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel namespaces arrays sequences io words fry
 continuations vocabs assocs dlists definitions math graphs generic
-combinators deques search-deques macros io stack-checker call
+combinators deques search-deques macros io stack-checker
 stack-checker.state stack-checker.inlining combinators.short-circuit
 compiler.errors compiler.units compiler.tree.builder
 compiler.tree.optimizer compiler.cfg.builder compiler.cfg.optimizer

diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor
index e03c062e9e0249ad6485fbf21e94a92bd67309bc..f82b6d479f1bfc46c2fc002e6468723831f6a00e 100644 (file)
--- a/basis/compiler/constants/constants.factor
+++ b/basis/compiler/constants/constants.factor
@@ -20,7 +20,7 @@ CONSTANT: deck-bits 18
 : tuple-class-offset ( -- n ) bootstrap-cell tuple tag-number - ; inline
 : class-hash-offset ( -- n ) bootstrap-cell object tag-number - ; inline
 : word-xt-offset ( -- n ) 9 bootstrap-cells object tag-number - ; inline
-: quot-xt-offset ( -- n ) 3 bootstrap-cells object tag-number - ; inline
+: quot-xt-offset ( -- n ) 5 bootstrap-cells object tag-number - ; inline
 : word-code-offset ( -- n ) 10 bootstrap-cells object tag-number - ; inline
 : array-start-offset ( -- n ) 2 bootstrap-cells object tag-number - ; inline
 : compiled-header-size ( -- n ) 4 bootstrap-cells ; inline

diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor
index 953956c3bd20b738be8a6e685f28e2c42e1d21f0..f18cfcd3a3aad1e48c56ddd3d12a4c0cf5798fb5 100755 (executable)
--- a/basis/compiler/tree/propagation/inlining/inlining.factor
+++ b/basis/compiler/tree/propagation/inlining/inlining.factor
@@ -1,6 +1,6 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel arrays sequences math math.order call
+USING: accessors kernel arrays sequences math math.order
 math.partial-dispatch generic generic.standard generic.math
 classes.algebra classes.union sets quotations assocs combinators
 words namespaces continuations classes fry combinators.smart

diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor
index 627fd953843f1e361ce3a874da3dc20e3c085a40..efd35ab2803055b47556bbf552bc73c1e7d991c9 100644 (file)
--- a/basis/debugger/debugger.factor
+++ b/basis/debugger/debugger.factor
@@ -325,3 +325,5 @@ M: bad-literal-tuple summary drop "Bad literal tuple" ;
 M: check-mixin-class summary drop "Not a mixin class" ;
 
 M: not-found-in-roots summary drop "Cannot resolve vocab: path" ;
+
+M: wrong-values summary drop "Quotation called with wrong stack effect" ;
\ No newline at end of file

diff --git a/basis/eval/eval.factor b/basis/eval/eval.factor
index dfa9baf418d2806859f2388e3eb717f2df36ea0c..3672337a584d0f17f8860a816246f6ef87d93348 100644 (file)
--- a/basis/eval/eval.factor
+++ b/basis/eval/eval.factor
@@ -4,7 +4,7 @@ USING: splitting parser compiler.units kernel namespaces
 debugger io.streams.string fry ;
 IN: eval
 
-: parse-string ( str -- )
+: parse-string ( str -- quot )
     [ string-lines parse-lines ] with-compilation-unit ;
 
 : (eval) ( str -- )

diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor
index b0814db4dd93efc34fdf68d58e814d25759d72aa..a582755dc4e6cce6802f81477139acb081ca4a8e 100644 (file)
--- a/basis/furnace/actions/actions.factor
+++ b/basis/furnace/actions/actions.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.\r
 USING: accessors sequences kernel assocs combinators\r
 validators http hashtables namespaces fry continuations locals\r
-io arrays math boxes splitting urls call\r
+io arrays math boxes splitting urls\r
 xml.entities\r
 http.server\r
 http.server.responses\r

diff --git a/basis/furnace/boilerplate/boilerplate.factor b/basis/furnace/boilerplate/boilerplate.factor
index 84b29bf831f1af0be6bdc1c480ebaab954663f77..b4bc574ae224e66bbfc30293ddb9351874b859c6 100644 (file)
--- a/basis/furnace/boilerplate/boilerplate.factor
+++ b/basis/furnace/boilerplate/boilerplate.factor
@@ -1,6 +1,6 @@
 ! Copyright (c) 2008, 2009 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel math.order namespaces combinators.short-circuit call
+USING: accessors kernel math.order namespaces combinators.short-circuit
 html.forms
 html.templates
 html.templates.chloe

diff --git a/basis/furnace/referrer/referrer.factor b/basis/furnace/referrer/referrer.factor
index acd4563cd6f07179673d0adbf18b5bb4e7d0f860..0eb00bac2796f7c415b7881eef4ee9fed72fb67c 100644 (file)
--- a/basis/furnace/referrer/referrer.factor
+++ b/basis/furnace/referrer/referrer.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel http.server http.server.filters
-http.server.responses furnace.utilities call ;
+http.server.responses furnace.utilities ;
 IN: furnace.referrer
 
 TUPLE: referrer-check < filter-responder quot ;

diff --git a/basis/help/help.factor b/basis/help/help.factor
index 27a81f9948b1eb50ac1bf05c1cfef40dcdc649d4..d8629008d2078c3c0a70f0a516aefaafde1a6074 100644 (file)
--- a/basis/help/help.factor
+++ b/basis/help/help.factor
@@ -5,7 +5,7 @@ parser prettyprint sequences words words.symbol assocs
 definitions generic quotations effects slots continuations
 classes.tuple debugger combinators vocabs help.stylesheet
 help.topics help.crossref help.markup sorting classes
-vocabs.loader call ;
+vocabs.loader ;
 IN: help
 
 GENERIC: word-help* ( word -- content )

diff --git a/basis/help/lint/lint.factor b/basis/help/lint/lint.factor
index 2281c295c394429fa0a9d57e5253e28497e4037c..7942f90e0a85a74762b9ae18d6b6b76859a9dbbe 100755 (executable)
--- a/basis/help/lint/lint.factor
+++ b/basis/help/lint/lint.factor
@@ -7,7 +7,7 @@ combinators combinators.short-circuit splitting debugger
 hashtables sorting effects vocabs vocabs.loader assocs editors
 continuations classes.predicate macros math sets eval
 vocabs.parser words.symbol values grouping unicode.categories
-sequences.deep call ;
+sequences.deep ;
 IN: help.lint
 
 SYMBOL: vocabs-quot

diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor
index ea64def75194a6ab606baf947f447b5a4625d23e..8ea36d62fbb810d4c21bc1f2ff04773e9942b088 100644 (file)
--- a/basis/help/markup/markup.factor
+++ b/basis/help/markup/markup.factor
@@ -4,7 +4,7 @@ USING: accessors arrays definitions generic io kernel assocs
 hashtables namespaces make parser prettyprint sequences strings
 io.styles vectors words math sorting splitting classes slots fry
 sets vocabs help.stylesheet help.topics vocabs.loader quotations
-combinators call see ;
+combinators see ;
 IN: help.markup
 
 PREDICATE: simple-element < array

diff --git a/basis/html/forms/forms.factor b/basis/html/forms/forms.factor
index 4cab87acfaa9bca720f7a7cc44fe85d567e00b6c..cc8b4f0a1595cc36566fae4b4dc08b5f2e1a5cd0 100644 (file)
--- a/basis/html/forms/forms.factor
+++ b/basis/html/forms/forms.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008, 2009 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors strings namespaces assocs hashtables io call
+USING: kernel accessors strings namespaces assocs hashtables io
 mirrors math fry sequences words continuations
 xml.entities xml.writer xml.syntax ;
 IN: html.forms

diff --git a/basis/html/templates/chloe/chloe.factor b/basis/html/templates/chloe/chloe.factor
index da0d45a9d4f1489556896b4e093f11a54804ec31..1fe90b08d3d51f56afbd204214c2aa7809a61a9d 100644 (file)
--- a/basis/html/templates/chloe/chloe.factor
+++ b/basis/html/templates/chloe/chloe.factor
@@ -4,7 +4,7 @@ USING: accessors kernel sequences combinators kernel fry
 namespaces make classes.tuple assocs splitting words arrays io
 io.files io.files.info io.encodings.utf8 io.streams.string
 unicode.case mirrors math urls present multiline quotations xml
-logging call
+logging
 xml.data xml.writer xml.syntax strings
 html.forms
 html

diff --git a/basis/html/templates/chloe/compiler/compiler.factor b/basis/html/templates/chloe/compiler/compiler.factor
index 3cb7523bdc204bf10acaf144b4c055308c4ba6fe..92e4a8dc494ea63d558f07cda1e4f4cc732e7653 100644 (file)
--- a/basis/html/templates/chloe/compiler/compiler.factor
+++ b/basis/html/templates/chloe/compiler/compiler.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs namespaces make kernel sequences accessors
 combinators strings splitting io io.streams.string present
-xml.writer xml.data xml.entities html.forms call
+xml.writer xml.data xml.entities html.forms
 html.templates html.templates.chloe.syntax ;
 IN: html.templates.chloe.compiler
 

diff --git a/basis/html/templates/fhtml/fhtml.factor b/basis/html/templates/fhtml/fhtml.factor
index 78202d6460ac96460ba53858dee3d1de90e0eff8..f3539f6a0fb826e8006650a3f1cd63a5b35f44f7 100644 (file)
--- a/basis/html/templates/fhtml/fhtml.factor
+++ b/basis/html/templates/fhtml/fhtml.factor
@@ -3,7 +3,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: continuations sequences kernel namespaces debugger
 combinators math quotations generic strings splitting accessors
-assocs fry vocabs.parser parser lexer io io.files call
+assocs fry vocabs.parser parser lexer io io.files
 io.streams.string io.encodings.utf8 html.templates ;
 IN: html.templates.fhtml
 
@@ -65,7 +65,7 @@ DEFER: <% delimiter
     ] with-file-vocabs ;
 
 : eval-template ( string -- )
-    parse-template call ;
+    parse-template call( -- ) ;
 
 TUPLE: fhtml path ;
 

diff --git a/basis/html/templates/templates.factor b/basis/html/templates/templates.factor
index fcb1b28b1ae271500b3304d32fdde3a9effce063..aebae701ed07d4a85c78f3d6c9d6413e0bd0ac73 100644 (file)
--- a/basis/html/templates/templates.factor
+++ b/basis/html/templates/templates.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel fry io io.encodings.utf8 io.files
 debugger prettyprint continuations namespaces boxes sequences
-arrays strings html io.streams.string assocs call
+arrays strings html io.streams.string assocs
 quotations xml.data xml.writer xml.syntax ;
 IN: html.templates
 

diff --git a/basis/http/server/static/static.factor b/basis/http/server/static/static.factor
index 13b9efc86d55bd16d54f11a86ded7491be5b190b..bbca70d84591dab79913dc8a0ebf68f107c69d9b 100644 (file)
--- a/basis/http/server/static/static.factor
+++ b/basis/http/server/static/static.factor
@@ -6,7 +6,7 @@ sorting logging calendar.format accessors splitting io io.files
 io.files.info io.directories io.pathnames io.encodings.binary\r
 fry xml.entities destructors urls html xml.syntax\r
 html.templates.fhtml http http.server http.server.responses\r
-http.server.redirection xml.writer call ;\r
+http.server.redirection xml.writer ;\r
 IN: http.server.static\r
 \r
 TUPLE: file-responder root hook special allow-listings ;\r

diff --git a/basis/inverse/inverse.factor b/basis/inverse/inverse.factor
index 9dc79e91b5a013376997467bfd08622bfc8785af..3a86703cafb1a49ffc12c2bb8ad09b66e17449b5 100755 (executable)
--- a/basis/inverse/inverse.factor
+++ b/basis/inverse/inverse.factor
@@ -5,7 +5,7 @@ sequences assocs math arrays stack-checker effects generalizations
 continuations debugger classes.tuple namespaces make vectors
 bit-arrays byte-arrays strings sbufs math.functions macros
 sequences.private combinators mirrors splitting
-combinators.short-circuit fry words.symbol generalizations call ;
+combinators.short-circuit fry words.symbol generalizations ;
 RENAME: _ fry => __
 IN: inverse
 

diff --git a/basis/io/pipes/pipes.factor b/basis/io/pipes/pipes.factor
index ad59cbc6327bf00219de00c1e1488b76d91ba5ab..c15663b0319c714e5ebaa09552b37d1f1a3a2f8c 100644 (file)
--- a/basis/io/pipes/pipes.factor
+++ b/basis/io/pipes/pipes.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.encodings io.backend io.ports io.streams.duplex
 io splitting grouping sequences namespaces kernel
-destructors math concurrency.combinators accessors call fry
+destructors math concurrency.combinators accessors fry
 arrays continuations quotations system vocabs.loader combinators ;
 IN: io.pipes
 

diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor
index 5a3233afa9471d1281fb34f5569f1c303223be7f..8eafe1b5bf24a6f0e63330f556f771ce2be4f64f 100644 (file)
--- a/basis/io/servers/connection/connection.factor
+++ b/basis/io/servers/connection/connection.factor
@@ -7,7 +7,7 @@ fry accessors arrays io io.sockets io.encodings.ascii
 io.sockets.secure io.files io.streams.duplex io.timeouts
 io.encodings threads make concurrency.combinators
 concurrency.semaphores concurrency.flags
-combinators.short-circuit call ;
+combinators.short-circuit ;
 IN: io.servers.connection
 
 TUPLE: threaded-server

diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor
index 78a9c03d205d2f401511bc986220dffbc044f215..4f7ccf227e54e12567e6e4d7f47916fa123278d5 100644 (file)
--- a/basis/listener/listener.factor
+++ b/basis/listener/listener.factor
@@ -4,7 +4,7 @@ USING: arrays hashtables io kernel math math.parser memory
 namespaces parser lexer sequences strings io.styles
 vectors words generic system combinators continuations debugger
 definitions compiler.units accessors colors prettyprint fry
-sets vocabs.parser call ;
+sets vocabs.parser ;
 IN: listener
 
 GENERIC: stream-read-quot ( stream -- quot/f )

diff --git a/basis/lists/lazy/lazy.factor b/basis/lists/lazy/lazy.factor
index d3b08a11fb9e16440b3462c20bfe8823df4e907f..139f6726e8bc61c419abcfb03b204b8c3de2522e 100644 (file)
--- a/basis/lists/lazy/lazy.factor
+++ b/basis/lists/lazy/lazy.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2008 Chris Double, Matthew Willis, James Cash.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences math vectors arrays namespaces make
-quotations promises combinators io lists accessors call ;
+quotations promises combinators io lists accessors ;
 IN: lists.lazy
 
 M: promise car ( promise -- car )

diff --git a/basis/models/arrow/arrow.factor b/basis/models/arrow/arrow.factor
index fcdfd166c5acc119f97cf2a61543e0bc9f1897d1..e0cf73c7f115560c689e49b7731c6f78d115dccb 100644 (file)
--- a/basis/models/arrow/arrow.factor
+++ b/basis/models/arrow/arrow.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
-USING: accessors models kernel call ;\r
+USING: accessors models kernel ;\r
 IN: models.arrow\r
 \r
 TUPLE: arrow < model model quot ;\r

diff --git a/basis/peg/ebnf/ebnf.factor b/basis/peg/ebnf/ebnf.factor
index db29ce1ee76af515de7dae81890e128a6e0ecd0e..1f526d47f2bd3122a02197bf55d839fd2b2430ad 100644 (file)
--- a/basis/peg/ebnf/ebnf.factor
+++ b/basis/peg/ebnf/ebnf.factor
@@ -5,7 +5,7 @@ sequences quotations vectors namespaces make math assocs
 continuations peg peg.parsers unicode.categories multiline\r
 splitting accessors effects sequences.deep peg.search\r
 combinators.short-circuit lexer io.streams.string stack-checker\r
-io combinators parser call ;\r
+io combinators parser ;\r
 IN: peg.ebnf\r
 \r
 : rule ( name word -- parser )\r

diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor
index 01891a1da17cfd97d7854d5a593888b3847809c7..6c0772aacc3269d883872d0874b25d8beeef14d1 100644 (file)
--- a/basis/peg/peg.factor
+++ b/basis/peg/peg.factor
@@ -4,7 +4,7 @@ USING: kernel sequences strings fry namespaces make math assocs
 io vectors arrays math.parser math.order vectors combinators
 classes sets unicode.categories compiler.units parser words
 quotations effects memoize accessors locals effects splitting
-combinators.short-circuit generalizations call ;
+combinators.short-circuit generalizations ;
 IN: peg
 
 TUPLE: parse-result remaining ast ;

diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor
index 63a2f25885b06308da29e7cdc932fef9fe362089..5889b19e476d122b2212a87bbf1b5270e81c4667 100644 (file)
--- a/basis/regexp/regexp.factor
+++ b/basis/regexp/regexp.factor
@@ -4,7 +4,7 @@ USING: accessors combinators kernel kernel.private math sequences
 sequences.private strings sets assocs prettyprint.backend
 prettyprint.custom make lexer namespaces parser arrays fry locals
 regexp.parser splitting sorting regexp.ast regexp.negation
-regexp.compiler compiler.units words call call.private math.ranges ;
+regexp.compiler compiler.units words math.ranges ;
 IN: regexp
 
 TUPLE: regexp
@@ -35,7 +35,7 @@ M: lookbehind question>quot ! Returns ( index string -- ? )
 : match-index-from ( i string regexp -- index/f )
     ! This word is unsafe. It assumes that i is a fixnum
     ! and that string is a string.
-    dup dfa>> execute-unsafe( index string regexp -- i/f ) ; inline
+    dup dfa>> execute( index string regexp -- i/f ) ; inline
 
 GENERIC: end/start ( string regexp -- end start )
 M: regexp end/start drop length 0 ;
@@ -68,7 +68,7 @@ PRIVATE>
 
 : do-next-match ( i string regexp -- i start end ? )
     dup next-match>>
-    execute-unsafe( i string regexp -- i start end ? ) ; inline
+    execute( i string regexp -- i start end ? ) ; inline
 
 :: (each-match) ( i string regexp quot: ( start end string -- ) -- )
     i string regexp do-next-match [| i' start end |

diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor
index 392cea62d6b536f55cb2cb2b9c7f97cc29739528..a7f348d36b624a84c9745c103acf70c35e5cbb62 100644 (file)
--- a/basis/stack-checker/known-words/known-words.factor
+++ b/basis/stack-checker/known-words/known-words.factor
@@ -11,7 +11,7 @@ strings.private system threads.private classes.tuple
 classes.tuple.private vectors vectors.private words definitions
 words.private assocs summary compiler.units system.private
 combinators locals locals.backend locals.types words.private
-quotations.private call call.private stack-checker.values
+quotations.private combinators.private stack-checker.values
 stack-checker.alien
 stack-checker.state
 stack-checker.errors
@@ -135,11 +135,6 @@ M: object infer-call*
     peek-d literal value>> second 1+ { tuple } <effect>
     apply-word/effect ;
 
-: infer-(throw) ( -- )
-    \ (throw)
-    peek-d literal value>> 2 + { "*" } <effect>
-    apply-word/effect ;
-
 : infer-effect-unsafe ( word -- )
     pop-literal nip
     add-effect-input
@@ -194,7 +189,6 @@ M: object infer-call*
         { \ if [ infer-if ] }
         { \ dispatch [ infer-dispatch ] }
         { \ <tuple-boa> [ infer-<tuple-boa> ] }
-        { \ (throw) [ infer-(throw) ] }
         { \ exit [ infer-exit ] }
         { \ load-local [ 1 infer->r ] }
         { \ load-locals [ infer-load-locals ] }
@@ -218,7 +212,7 @@ M: object infer-call*
 {
     declare call (call) slip 2slip 3slip dip 2dip 3dip curry compose
     execute (execute) call-effect-unsafe execute-effect-unsafe if
-    dispatch <tuple-boa> (throw) exit load-local load-locals get-local
+    dispatch <tuple-boa> exit load-local load-locals get-local
     drop-locals do-primitive alien-invoke alien-indirect
     alien-callback
 } [ t "special" set-word-prop ] each

diff --git a/basis/stack-checker/transforms/authors.txt b/basis/stack-checker/transforms/authors.txt
index 1901f27a24507e2512d93a1f956aaaa0d2f05714..a44f8d7f8d462129605979ca2bec95cc98dc3a48 100644 (file)
--- a/basis/stack-checker/transforms/authors.txt
+++ b/basis/stack-checker/transforms/authors.txt
@@ -1 +1,2 @@
 Slava Pestov
+Daniel Ehrenberg

diff --git a/basis/stack-checker/transforms/transforms-tests.factor b/basis/stack-checker/transforms/transforms-tests.factor
index fe580084c06977e77d0d7ec39b988d269eceb6b6..751e589c2801582e3aaafe7afce75de77fa1026e 100644 (file)
--- a/basis/stack-checker/transforms/transforms-tests.factor
+++ b/basis/stack-checker/transforms/transforms-tests.factor
@@ -65,4 +65,9 @@ DEFER: curry-folding-test ( quot -- )
 
 { 3 0 } [ [ 1 2 3 ] curry-folding-test ] must-infer-as
 { 3 0 } [ 1 [ 2 3 ] curry curry-folding-test ] must-infer-as
-{ 3 0 } [ [ 1 2 ] 3 [ ] curry compose curry-folding-test ] must-infer-as
\ No newline at end of file
+{ 3 0 } [ [ 1 2 ] 3 [ ] curry compose curry-folding-test ] must-infer-as
+
+[ t ] [ \ + (( a b -- c )) execute-effect-unsafe? ] unit-test
+[ t ] [ \ + (( a b c -- d e )) execute-effect-unsafe? ] unit-test
+[ f ] [ \ + (( a b c -- d )) execute-effect-unsafe? ] unit-test
+[ f ] [ \ call (( x -- )) execute-effect-unsafe? ] unit-test
\ No newline at end of file

diff --git a/basis/stack-checker/transforms/transforms.factor b/basis/stack-checker/transforms/transforms.factor
index ecc2365cf906932cd9a922169ccd05f3deb5bc49..6c1d3914906cae00d42e0cf81f39065c8c4ae751 100755 (executable)
--- a/basis/stack-checker/transforms/transforms.factor
+++ b/basis/stack-checker/transforms/transforms.factor
@@ -1,11 +1,12 @@
-! Copyright (C) 2007, 2009 Slava Pestov.
+! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: fry accessors arrays kernel words sequences generic math
-namespaces make quotations assocs combinators classes.tuple
-classes.tuple.private effects summary hashtables classes generic
-sets definitions generic.standard slots.private continuations locals
-generalizations stack-checker.backend stack-checker.state
-stack-checker.visitor stack-checker.errors stack-checker.values
+USING: fry accessors arrays kernel kernel.private combinators.private
+words sequences generic math namespaces make quotations assocs
+combinators classes.tuple classes.tuple.private effects summary
+hashtables classes generic sets definitions generic.standard
+slots.private continuations locals generalizations
+stack-checker.backend stack-checker.state stack-checker.visitor
+stack-checker.errors stack-checker.values
 stack-checker.recursive-state ;
 IN: stack-checker.transforms
 
@@ -50,6 +51,47 @@ IN: stack-checker.transforms
     [ nip "transform-n" set-word-prop ]
     3bi ;
 
+! call( and execute(
+: (call-effect>quot) ( in out effect -- quot )
+    [
+        [ [ datastack ] dip dip ] %
+        [ [ , ] bi@ \ check-datastack , ] dip
+        '[ _ wrong-values ] , \ unless ,
+    ] [ ] make ;
+
+: call-effect>quot ( effect -- quot )
+    [ in>> length ] [ out>> length ] [ ] tri
+    [ (call-effect>quot) ] keep add-effect-input
+    [ call-effect-unsafe ] 2curry ;
+
+\ call-effect [ call-effect>quot ] 1 define-transform
+
+: execute-effect-slow ( word effect -- )
+    [ '[ _ execute ] ] dip call-effect ; inline
+
+TUPLE: inline-cache value ;
+
+: cache-hit? ( word ic -- ? ) value>> eq? ; inline
+
+: cache-hit ( word effect ic -- ) drop execute-effect-unsafe ; inline
+
+: execute-effect-unsafe? ( word effect -- ? )
+    over optimized>> [ [ stack-effect ] dip effect<= ] [ 2drop f ] if ; inline
+
+: cache-miss ( word effect ic -- )
+    2over execute-effect-unsafe?
+    [ [ nip (>>value) ] [ drop execute-effect-unsafe ] 3bi ]
+    [ drop execute-effect-slow ] if ; inline
+
+: execute-effect-ic ( word effect ic -- )
+    #! ic is a mutable cell { effect }
+    3dup nip cache-hit? [ cache-hit ] [ cache-miss ] if ; inline
+
+: execute-effect>quot ( effect -- quot )
+    inline-cache new '[ _ _ execute-effect-ic ] ;
+
+\ execute-effect [ execute-effect>quot ] 1 define-transform
+
 ! Combinators
 \ cond [ cond>quot ] 1 define-transform
 
@@ -141,8 +183,12 @@ CONSTANT: bit-member-n 256
     dup bit-member? [
         bit-member-quot
     ] [
-        [ literalize [ t ] ] { } map>assoc
-        [ drop f ] suffix [ case ] curry
+        dup length 4 <= [
+            [ drop f ] swap
+            [ literalize [ t ] ] { } map>assoc linear-case-quot
+        ] [
+            unique [ key? ] curry
+        ] if
     ] if ;
 
 \ member? [

diff --git a/basis/threads/threads.factor b/basis/threads/threads.factor
index 3f4267df15e7771614719d259e390d36a1ec737c..1f25c0e0312770f59cc5c43400600e2945f61dd9 100644 (file)
--- a/basis/threads/threads.factor
+++ b/basis/threads/threads.factor
@@ -1,10 +1,10 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2009 Slava Pestov.
 ! Copyright (C) 2005 Mackenzie Straight.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays hashtables heaps kernel kernel.private math
 namespaces sequences vectors continuations continuations.private
-dlists assocs system combinators init boxes accessors
-math.order deques strings quotations fry ;
+dlists assocs system combinators combinators.private init boxes
+accessors math.order deques strings quotations fry ;
 IN: threads
 
 SYMBOL: initial-thread
@@ -126,7 +126,7 @@ DEFER: stop
         { } set-retainstack
         { } set-datastack
         self quot>> [ call stop ] call-clear
-    ] 2 (throw) ;
+    ] (( namestack thread -- * )) call-effect-unsafe ;
 
 DEFER: next
 

diff --git a/basis/tools/deploy/deploy-docs.factor b/basis/tools/deploy/deploy-docs.factor
index a47b3dca32a7a98fd7a5ad7cee2c9cf14a12383a..2db53f22928fcd03d6779a8d0105428b4b6d5b0b 100644 (file)
--- a/basis/tools/deploy/deploy-docs.factor
+++ b/basis/tools/deploy/deploy-docs.factor
@@ -1,5 +1,5 @@
 USING: help.markup help.syntax words alien.c-types assocs
-kernel call call.private tools.deploy.config ;
+kernel combinators combinators.private tools.deploy.config ;
 IN: tools.deploy
 
 ARTICLE: "prepare-deploy" "Preparing to deploy an application"

diff --git a/basis/tools/deploy/test/12/12.factor b/basis/tools/deploy/test/12/12.factor
index 3ee0643c38f3966eda297d0694b46a8d5b06888a..3bc2af3da475411a3576d7e6b4e367070caa3246 100644 (file)
--- a/basis/tools/deploy/test/12/12.factor
+++ b/basis/tools/deploy/test/12/12.factor
@@ -1,10 +1,12 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: call math.parser io math ;
+USING: math.parser io math ;
 IN: tools.deploy.test.12
 
 : execute-test ( a b w -- c ) execute( a b -- c ) ;
 
-: foo ( -- ) 1 2 \ + execute-test number>string print ;
+: call-test ( a b q -- c ) call( a b -- c ) ;
+
+: foo ( -- ) 1 2 \ + execute-test 4 [ * ] call-test number>string print ;
 
 MAIN: foo
\ No newline at end of file

diff --git a/basis/tools/walker/walker.factor b/basis/tools/walker/walker.factor
index f0d9a084b13677494a1df9859cbf6c5f9f5eb0df..b4ace6b770aef27a1eea84532c21c05121a0977c 100644 (file)
--- a/basis/tools/walker/walker.factor
+++ b/basis/tools/walker/walker.factor
@@ -139,7 +139,6 @@ SYMBOL: +stopped+
     { dip [ (step-into-dip) ] }
     { 2dip [ (step-into-2dip) ] }
     { 3dip [ (step-into-3dip) ] }
-    { (throw) [ drop (step-into-quot) ] }
     { execute [ (step-into-execute) ] }
     { if [ (step-into-if) ] }
     { dispatch [ (step-into-dispatch) ] }

diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor
index 5cb02f5ad6084f8ac3f231936cdfda7f84f6443f..fc392c595d40e0dc13f940211c3a5d5d3f030b14 100755 (executable)
--- a/basis/ui/backend/cocoa/cocoa.factor
+++ b/basis/ui/backend/cocoa/cocoa.factor
@@ -8,7 +8,7 @@ ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
 ui.backend.cocoa.views core-foundation core-foundation.run-loop
 core-graphics.types threads math.rectangles fry libc
 generalizations alien.c-types cocoa.views
-combinators io.thread locals call ;
+combinators io.thread locals ;
 IN: ui.backend.cocoa
 
 TUPLE: handle ;

diff --git a/basis/ui/commands/commands.factor b/basis/ui/commands/commands.factor
index d6c7c7905be1aa9b9f3191561ca455a233c767a1..28529b013bf9ca19e7da6ea57d0fea955a8d471b 100644 (file)
--- a/basis/ui/commands/commands.factor
+++ b/basis/ui/commands/commands.factor
@@ -2,8 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays definitions kernel sequences strings
 math assocs words generic namespaces make assocs quotations
-splitting ui.gestures unicode.case unicode.categories tr fry
-call ;
+splitting ui.gestures unicode.case unicode.categories tr fry ;
 IN: ui.commands
 
 SYMBOL: +nullary+

diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor
index ebac290f4bdfc4fc4152d29bbdc912d9bfe1ded7..0504231972e655c3b1010ee50aef53156b922042 100644 (file)
--- a/basis/ui/gadgets/buttons/buttons.factor
+++ b/basis/ui/gadgets/buttons/buttons.factor
@@ -6,7 +6,7 @@ classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets
 ui.gadgets.borders ui.gadgets.labels ui.gadgets.tracks
 ui.gadgets.packs ui.gadgets.worlds ui.gestures ui.pens ui.pens.solid
 ui.pens.image ui.pens.tile math.rectangles locals fry
-combinators.smart call ;
+combinators.smart ;
 IN: ui.gadgets.buttons
 
 TUPLE: button < border pressed? selected? quot ;

diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor
index 4398b0ce70cf8e7f4c7f854c3529ecdd6b5abcdf..bda9938f8a97e838f78f50f827a1fc8f03fa060f 100755 (executable)
--- a/basis/ui/gadgets/editors/editors.factor
+++ b/basis/ui/gadgets/editors/editors.factor
@@ -8,7 +8,7 @@ continuations ui.clipboards ui.commands ui.gadgets ui.gadgets.borders
 ui.gadgets.buttons ui.gadgets.labels ui.gadgets.scrollers
 ui.gadgets.menus ui.gadgets.wrappers ui.render ui.pens.solid
 ui.gadgets.line-support ui.text ui.gestures ui.baseline-alignment
-math.rectangles splitting unicode.categories fonts grouping call ;
+math.rectangles splitting unicode.categories fonts grouping ;
 IN: ui.gadgets.editors
 
 TUPLE: editor < line-gadget

diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor
index 6019d6a95492268fc5c7f0b12ccec8b7d2836fef..44da013f2cecf90e2edb46d959b31e3892f1affb 100644 (file)
--- a/basis/ui/gadgets/panes/panes.factor
+++ b/basis/ui/gadgets/panes/panes.factor
@@ -10,7 +10,7 @@ ui.gadgets.paragraphs ui.gadgets.incremental ui.gadgets.packs
 ui.gadgets.menus ui.clipboards ui.gestures ui.traverse ui.render
 ui.text ui.gadgets.presentations ui.gadgets.grids ui.gadgets.tracks
 ui.gadgets.icons ui.gadgets.grid-lines ui.baseline-alignment
-colors call io.styles ;
+colors io.styles ;
 IN: ui.gadgets.panes
 
 TUPLE: pane < track

diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor
index ccfa83334b202079c81c1500535c27135a7fb13c..163dbff514493b244aaa248c9a22f013a98be76f 100644 (file)
--- a/basis/ui/gadgets/worlds/worlds.factor
+++ b/basis/ui/gadgets/worlds/worlds.factor
@@ -1,10 +1,10 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs continuations kernel math models
-call namespaces opengl sequences io combinators
-combinators.short-circuit fry math.vectors math.rectangles cache
-ui.gadgets ui.gestures ui.render ui.text ui.text.private
-ui.backend ui.gadgets.tracks ui.commands ;
+namespaces opengl sequences io combinators combinators.short-circuit
+fry math.vectors math.rectangles cache ui.gadgets ui.gestures
+ui.render ui.text ui.text.private ui.backend ui.gadgets.tracks
+ui.commands ;
 IN: ui.gadgets.worlds
 
 TUPLE: world < track

diff --git a/basis/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor
index 2e52a2fe1e54460a6d772924f6528b46e0f88067..c7db0839d7b08c0f8f139ffd5c25ccffe4a65b49 100644 (file)
--- a/basis/ui/gestures/gestures.factor
+++ b/basis/ui/gestures/gestures.factor
@@ -4,7 +4,7 @@ USING: accessors arrays assocs kernel math math.order models
 namespaces make sequences words strings system hashtables math.parser
 math.vectors classes.tuple classes boxes calendar alarms combinators
 sets columns fry deques ui.gadgets ui.gadgets.private unicode.case
-unicode.categories combinators.short-circuit call ;
+unicode.categories combinators.short-circuit ;
 IN: ui.gestures
 
 GENERIC: handle-gesture ( gesture gadget -- ? )

diff --git a/basis/ui/operations/operations.factor b/basis/ui/operations/operations.factor
index 2f9cfba961adf3795f1de6eeba25b25c2f8aac85..db6048061e47997dc2291e8a85337475a9bbb399 100644 (file)
--- a/basis/ui/operations/operations.factor
+++ b/basis/ui/operations/operations.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays definitions kernel ui.commands
 ui.gestures sequences strings math words generic namespaces
-hashtables help.markup quotations assocs fry call linked-assocs ;
+hashtables help.markup quotations assocs fry linked-assocs ;
 IN: ui.operations
 
 SYMBOL: +keyboard+

diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor
index fe318101ee8475e7d5b7a4f3302a923f7efd91d5..8ce8f57cf0e0e31c773c170b63df3848f1c1c8f3 100644 (file)
--- a/basis/ui/ui.factor
+++ b/basis/ui/ui.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs io kernel math models namespaces make dlists
-deques sequences threads sequences words continuations init call
+deques sequences threads sequences words continuations init
 combinators hashtables concurrency.flags sets accessors calendar fry
 destructors ui.gadgets ui.gadgets.private ui.gadgets.worlds
 ui.gadgets.tracks ui.gestures ui.backend ui.render ui.text

diff --git a/basis/wrap/wrap.factor b/basis/wrap/wrap.factor
index 0b7f869141a47dd61d64e3d3e04570297880434f..58957ba8e74265239d2e2346fd839a267c1553f6 100644 (file)
--- a/basis/wrap/wrap.factor
+++ b/basis/wrap/wrap.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences math arrays locals fry accessors
-lists splitting call make combinators.short-circuit namespaces
+lists splitting make combinators.short-circuit namespaces
 grouping splitting.monotonic ;
 IN: wrap
 

diff --git a/basis/xmode/loader/syntax/syntax.factor b/basis/xmode/loader/syntax/syntax.factor
index 60318e669e7fea9cffb97649a07d07c21a2236d7..4cbf58c8aa62c59a244c631a72db353c5854e2a4 100644 (file)
--- a/basis/xmode/loader/syntax/syntax.factor
+++ b/basis/xmode/loader/syntax/syntax.factor
@@ -12,7 +12,7 @@ IN: xmode.loader.syntax
 
 : RULE:
     scan scan-word scan-word [
-        parse-definition { } make
+        [ parse-definition call( -- ) ] { } make
         swap [ (parse-rule-tag) ] 2curry
     ] dip swap define-tag ; parsing
 

diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index f04a42f493ea8191255b6dce0b040590856144ec..5ad693bc86a3bd59472952b127d41ada5ca1fdba 100644 (file)
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -243,6 +243,8 @@ bi
 "quotation" "quotations" create {
     { "array" { "array" "arrays" } read-only }
     { "compiled" read-only }
+    "cached-effect"
+    "cache-counter"
 } define-builtin
 
 "dll" "alien" create {
@@ -491,7 +493,6 @@ tuple
     { "set-alien-double" "alien.accessors" }
     { "alien-cell" "alien.accessors" }
     { "set-alien-cell" "alien.accessors" }
-    { "(throw)" "kernel.private" }
     { "alien-address" "alien" }
     { "set-slot" "slots.private" }
     { "string-nth" "strings.private" }

diff --git a/core/bootstrap/syntax.factor b/core/bootstrap/syntax.factor
index 654a8f5f3468b61f29b1b3b4b601350b9ec43081..1c97ee5a500cf482428bc25d74e0cd5fbc41b30d 100644 (file)
--- a/core/bootstrap/syntax.factor
+++ b/core/bootstrap/syntax.factor
@@ -78,6 +78,8 @@ IN: bootstrap.syntax
     "call-next-method"
     "initial:"
     "read-only"
+    "call("
+    "execute("
 } [ "syntax" create drop ] each
 
 "t" "syntax" lookup define-symbol

diff --git a/core/combinators/authors.txt b/core/combinators/authors.txt
index 1901f27a24507e2512d93a1f956aaaa0d2f05714..a44f8d7f8d462129605979ca2bec95cc98dc3a48 100644 (file)
--- a/core/combinators/authors.txt
+++ b/core/combinators/authors.txt
@@ -1 +1,2 @@
 Slava Pestov
+Daniel Ehrenberg

diff --git a/core/combinators/combinators-docs.factor b/core/combinators/combinators-docs.factor
index a26c2fbe5d1db84517d0a4af7ab758ef0c782274..cc502140ad18db3284fab98ee088b2144ab7f20f 100644 (file)
--- a/core/combinators/combinators-docs.factor
+++ b/core/combinators/combinators-docs.factor
@@ -1,6 +1,7 @@
 USING: arrays help.markup help.syntax strings sbufs vectors
 kernel quotations generic generic.standard classes
-math assocs sequences sequences.private ;
+math assocs sequences sequences.private combinators.private
+effects words ;
 IN: combinators
 
 ARTICLE: "combinators-quot" "Quotation construction utilities"
@@ -9,6 +10,19 @@ ARTICLE: "combinators-quot" "Quotation construction utilities"
 { $subsection case>quot }
 { $subsection alist>quot } ;
 
+ARTICLE: "call" "Calling code with known stack effects"
+"Arbitrary quotations and words can be called from code accepted by the optimizing compiler. This is done by specifying the stack effect of the quotation literally. It is checked at runtime that the stack effect is accurate."
+$nl
+"Quotations:"
+{ $subsection POSTPONE: call( }
+{ $subsection call-effect }
+"Words:"
+{ $subsection POSTPONE: execute( }
+{ $subsection execute-effect }
+"Unsafe calls:"
+{ $subsection call-effect-unsafe }
+{ $subsection execute-effect-unsafe } ;
+
 ARTICLE: "combinators" "Additional combinators"
 "The " { $vocab-link "combinators" } " vocabulary provides a few useful combinators."
 $nl
@@ -27,11 +41,27 @@ $nl
 $nl
 "A combinator which can help with implementing methods on " { $link hashcode* } ":"
 { $subsection recursive-hashcode }
+{ $subsection "call" }
 { $subsection "combinators-quot" }
 { $see-also "quotations" "dataflow" } ;
 
 ABOUT: "combinators"
 
+HELP: call-effect
+{ $values { "quot" quotation } { "effect" effect } }
+{ $description "Given a quotation and a stack effect, calls the quotation, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary quotation which is not required at compile time." } ;
+
+HELP: execute-effect
+{ $values { "word" word } { "effect" effect } }
+{ $description "Given a word and a stack effect, executes the word, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary word which is not required at compile time." } ;
+
+HELP: execute-effect-unsafe
+{ $values { "word" word } { "effect" effect } }
+{ $description "Given a word and a stack effect, executes the word, blindly declaring at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary word which is not required at compile time." }
+{ $warning "If the word being executed has an incorrect stack effect, undefined behavior will result. User code should use " { $link POSTPONE: execute( } " instead." } ;
+    
+{ call-effect call-effect-unsafe execute-effect execute-effect-unsafe } related-words
+
 HELP: cleave
 { $values { "x" object } { "seq" "a sequence of quotations with stack effect " { $snippet "( x -- ... )" } } }
 { $description "Applies each quotation to the object in turn." }

diff --git a/core/combinators/combinators-tests.factor b/core/combinators/combinators-tests.factor
index 1ee3a4e3ed9c15b981625c2b9d4f6f391f4609e9..1a4ee34fa2e5acb971782fff49833b2f43064abe 100644 (file)
--- a/core/combinators/combinators-tests.factor
+++ b/core/combinators/combinators-tests.factor
@@ -3,6 +3,30 @@ namespaces combinators words classes sequences accessors
 math.functions arrays ;
 IN: combinators.tests
 
+[ 3 ] [ 1 2 [ + ] call( x y -- z ) ] unit-test
+[ 1 2 [ + ] call( -- z ) ] must-fail
+[ 1 2 [ + ] call( x y -- z a ) ] must-fail
+[ 1 2 3 { 1 2 3 4 } ] [ 1 2 3 4 [ datastack nip ] call( x -- y ) ] unit-test
+[ [ + ] call( x y -- z ) ] must-infer
+
+[ 3 ] [ 1 2 \ + execute( x y -- z ) ] unit-test
+[ 1 2 \ + execute( -- z ) ] must-fail
+[ 1 2 \ + execute( x y -- z a ) ] must-fail
+[ \ + execute( x y -- z ) ] must-infer
+
+: compile-execute(-test-1 ( a b -- c ) \ + execute( a b -- c ) ;
+
+[ t ] [ \ compile-execute(-test-1 optimized>> ] unit-test
+[ 4 ] [ 1 3 compile-execute(-test-1 ] unit-test
+
+: compile-execute(-test-2 ( a b w -- c ) execute( a b -- c ) ;
+
+[ t ] [ \ compile-execute(-test-2 optimized>> ] unit-test
+[ 4 ] [ 1 3 \ + compile-execute(-test-2 ] unit-test
+[ 5 ] [ 1 4 \ + compile-execute(-test-2 ] unit-test
+[ -3 ] [ 1 4 \ - compile-execute(-test-2 ] unit-test
+[ 5 ] [ 1 4 \ + compile-execute(-test-2 ] unit-test
+
 ! Compiled
 : cond-test-1 ( obj -- str )
     {

diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor
index daf247d678b438b9e0c24c54daace8d17a642451..4c600e06ca76bee4ed4c2e683e589c0176431489 100755 (executable)
--- a/core/combinators/combinators.factor
+++ b/core/combinators/combinators.factor
@@ -1,10 +1,34 @@
-! Copyright (C) 2006, 2008 Slava Pestov.
+! Copyright (C) 2006, 2009 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays sequences sequences.private math.private
 kernel kernel.private math assocs quotations vectors
 hashtables sorting words sets math.order make ;
 IN: combinators
 
+<PRIVATE
+
+: call-effect-unsafe ( quot effect -- ) drop call ;
+
+: execute-effect-unsafe ( word effect -- ) drop execute ;
+
+M: object throw 5 getenv [ die ] or (( error -- * )) call-effect-unsafe ;
+
+PRIVATE>
+
+ERROR: wrong-values effect ;
+
+! We can't USE: effects here so we forward reference slots instead
+SLOT: in
+SLOT: out
+
+: call-effect ( quot effect -- )
+    [ [ datastack ] dip dip ] dip
+    [ in>> length ] [ out>> length ] [ ] tri [ check-datastack ] dip
+    [ wrong-values ] curry unless ;
+
+: execute-effect ( word effect -- )
+    [ [ execute ] curry ] dip call-effect ;
+
 ! cleave
 : cleave ( x seq -- )
     [ call ] with each ;

diff --git a/core/continuations/continuations-docs.factor b/core/continuations/continuations-docs.factor
index 0d66829898dc2f3762b3aa32b9d8cff712ac5380..0627ed5265dc78ebc614d872170f35e7adb74827 100644 (file)
--- a/core/continuations/continuations-docs.factor
+++ b/core/continuations/continuations-docs.factor
@@ -83,7 +83,6 @@ $nl
 { $subsection with-return }
 "Reflecting the datastack:"
 { $subsection with-datastack }
-{ $subsection assert-depth }
 "Continuations serve as the building block for a number of higher-level abstractions, such as " { $link "errors" } " and " { $link "threads" } "."
 { $subsection "continuations.private" } ;
 
@@ -217,10 +216,6 @@ HELP: with-datastack
     { $example "USING: continuations math prettyprint ;" "{ 3 7 } [ + ] with-datastack ." "{ 10 }" }
 } ;
 
-HELP: assert-depth
-{ $values { "quot" "a quotation" } }
-{ $description "Runs a quotation. Throws an error if the quotation attempts to take input values from the stack, or leave outputs on the stack." } ;
-
 HELP: attempt-all
 { $values
      { "seq" sequence } { "quot" quotation }

diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor
index 37418b85f5adc672319e45338a94d380e8f6991b..051d28d8c23eeca8a60a31c5343c60e641927987 100644 (file)
--- a/core/continuations/continuations.factor
+++ b/core/continuations/continuations.factor
@@ -1,8 +1,8 @@
-! Copyright (C) 2003, 2008 Slava Pestov.
+! Copyright (C) 2003, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays vectors kernel kernel.private sequences
 namespaces make math splitting sorting quotations assocs
-combinators accessors ;
+combinators combinators.private accessors ;
 IN: continuations
 
 SYMBOL: error
@@ -73,7 +73,7 @@ C: <continuation> continuation
 
 <PRIVATE
 
-: (continue) ( continuation -- )
+: (continue) ( continuation -- * )
     >continuation<
     set-catchstack
     set-namestack
@@ -81,19 +81,18 @@ C: <continuation> continuation
     [ set-datastack ] dip
     set-callstack ;
 
-: (continue-with) ( obj continuation -- )
-    swap 4 setenv
-    >continuation<
-    set-catchstack
-    set-namestack
-    set-retainstack
-    [ set-datastack drop 4 getenv f 4 setenv f ] dip
-    set-callstack ;
-
 PRIVATE>
 
 : continue-with ( obj continuation -- * )
-    [ (continue-with) ] 2 (throw) ;
+    [
+        swap 4 setenv
+        >continuation<
+        set-catchstack
+        set-namestack
+        set-retainstack
+        [ set-datastack drop 4 getenv f 4 setenv f ] dip
+        set-callstack
+    ] (( obj continuation -- * )) call-effect-unsafe ;
 
 : continue ( continuation -- * )
     f swap continue-with ;
@@ -111,12 +110,9 @@ SYMBOL: return-continuation
         [
             [ [ { } like set-datastack ] dip call datastack ] dip
             continue-with
-        ] 3 (throw)
+        ] (( stack quot continuation -- * )) call-effect-unsafe
     ] callcc1 2nip ;
 
-: assert-depth ( quot -- )
-    { } swap with-datastack { } assert= ; inline
-
 GENERIC: compute-restarts ( error -- seq )
 
 <PRIVATE
@@ -133,7 +129,7 @@ SYMBOL: thread-error-hook
     dup save-error
     catchstack* empty? [
         thread-error-hook get-global
-        [ 1 (throw) ] [ die ] if*
+        [ (( error -- * )) call-effect-unsafe ] [ die ] if*
     ] when
     c> continue-with ;
 

diff --git a/core/effects/parser/parser.factor b/core/effects/parser/parser.factor
index a009db76b1245e3186265d57db274dd3d96f4f3b..04dc42712ce027ff0d3648c7b6da12a7189f6afa 100644 (file)
--- a/core/effects/parser/parser.factor
+++ b/core/effects/parser/parser.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: lexer sets sequences kernel splitting effects
 combinators arrays parser ;
@@ -26,3 +26,6 @@ ERROR: bad-effect ;
 : parse-effect ( end -- effect )
     parse-effect-tokens { "--" } split1 dup
     [ <effect> ] [ "Stack effect declaration must contain --" throw ] if ;
+
+: parse-call( ( accum word -- accum )
+    [ ")" parse-effect parsed ] dip parsed ;
\ No newline at end of file

diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor
index cf4bf95db96afeff4a604aaccd53a2a18664cf9e..52529892f42008f2460e24a91391e1c83bef2a9a 100644 (file)
--- a/core/kernel/kernel.factor
+++ b/core/kernel/kernel.factor
@@ -22,6 +22,8 @@ DEFER: 3dip
 ! Combinators
 GENERIC: call ( callable -- )
 
+GENERIC: execute ( word -- )
+
 DEFER: if
 
 : ? ( ? true false -- true/false )
@@ -235,7 +237,7 @@ GENERIC: boa ( ... class -- tuple )
 
 ! Error handling -- defined early so that other files can
 ! throw errors before continuations are loaded
-: throw ( error -- * ) 5 getenv [ die ] or 1 (throw) ;
+GENERIC: throw ( error -- * )
 
 ERROR: assert got expect ;
 

diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor
index 6b90abecede6d0608f7c899c7cca09fbb84c3a5e..adf1c8adcf84d377811804bb1f2a423b2ea5b8d8 100644 (file)
--- a/core/parser/parser-tests.factor
+++ b/core/parser/parser-tests.factor
@@ -402,9 +402,7 @@ IN: parser.tests
     [ t ] [ "foo" "parser.tests" lookup symbol? ] unit-test
 ] times
 
-[ "vocab:parser/test/assert-depth.factor" run-file ]
-[ got>> { 1 2 3 } sequence= ]
-must-fail-with
+[ "vocab:parser/test/assert-depth.factor" run-file ] must-fail
 
 2 [
     [ ] [

diff --git a/core/parser/parser.factor b/core/parser/parser.factor
index dddea09db96d1a075487cbb529798a9de173fa45..1f4d377b27ce599374cc7b72e2116dfa91eed77a 100644 (file)
--- a/core/parser/parser.factor
+++ b/core/parser/parser.factor
@@ -1,11 +1,10 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays definitions generic assocs kernel math namespaces
-sequences strings vectors words words.symbol quotations io
-combinators sorting splitting math.parser effects continuations
-io.files vocabs io.encodings.utf8 source-files
-classes hashtables compiler.errors compiler.units accessors sets
-lexer vocabs.parser slots ;
+sequences strings vectors words words.symbol quotations io combinators
+sorting splitting math.parser effects continuations io.files vocabs
+io.encodings.utf8 source-files classes hashtables compiler.errors
+compiler.units accessors sets lexer vocabs.parser slots ;
 IN: parser
 
 : location ( -- loc )
@@ -90,9 +89,9 @@ SYMBOL: auto-use?
 
 ERROR: staging-violation word ;
 
-: execute-parsing ( word -- )
+: execute-parsing ( accum word -- accum )
     dup changed-definitions get key? [ staging-violation ] when
-    execute ;
+    execute( accum -- accum ) ;
 
 : scan-object ( -- object )
     scan-word dup parsing-word?
@@ -125,7 +124,7 @@ M: f parse-quotation \ ] parse-until >quotation ;
     [ f parse-until >quotation ] with-lexer ;
 
 : parse-lines ( lines -- quot )
-    lexer-factory get call (parse-lines) ;
+    lexer-factory get call( lines -- lexer ) (parse-lines) ;
 
 : parse-literal ( accum end quot -- accum )
     [ parse-until ] dip call parsed ; inline
@@ -214,7 +213,7 @@ print-use-hook [ [ ] ] initialize
     [
         V{ } clone amended-use set
         parse-lines
-        amended-use get empty? [ print-use-hook get assert-depth ] unless
+        amended-use get empty? [ print-use-hook get call( -- ) ] unless
     ] with-file-vocabs ;
 
 : parsing-file ( file -- )
@@ -288,7 +287,7 @@ print-use-hook [ [ ] ] initialize
     ] recover ;
 
 : run-file ( file -- )
-    [ parse-file call ] curry assert-depth ;
+    parse-file call( -- ) ;
 
 : ?run-file ( path -- )
     dup exists? [ run-file ] [ drop ] if ;

diff --git a/core/strings/parser/parser.factor b/core/strings/parser/parser.factor
index 8c9d0b555794faa169b47962953c0db2e1bf2343..c6e58f659a5bd6e1d53d908d1135fd32590de84e 100644 (file)
--- a/core/strings/parser/parser.factor
+++ b/core/strings/parser/parser.factor
@@ -29,7 +29,7 @@ name>char-hook [
 : unicode-escape ( str -- ch str' )
     "{" ?head-slice [
         CHAR: } over index cut-slice
-        [ >string name>char-hook get call ] dip
+        [ >string name>char-hook get call( name -- char ) ] dip
         rest-slice
     ] [
         6 cut-slice [ hex> ] dip
@@ -45,10 +45,10 @@ name>char-hook [
 : (parse-string) ( str -- m )
     dup [ "\"\\" member? ] find dup [
         [ cut-slice [ % ] dip rest-slice ] dip
-        dup CHAR: " = [
-            drop from>>
+        CHAR: " = [
+            from>>
         ] [
-            drop next-escape [ , ] dip (parse-string)
+            next-escape [ , ] dip (parse-string)
         ] if
     ] [
         "Unterminated string" throw
@@ -59,8 +59,8 @@ name>char-hook [
         [ swap tail-slice (parse-string) ] "" make swap
     ] change-lexer-column ;
 
-: (unescape-string) ( str -- str' )
-    dup [ CHAR: \\ = ] find [
+: (unescape-string) ( str -- )
+    CHAR: \\ over index dup [
         cut-slice [ % ] dip rest-slice
         next-escape [ , ] dip
         (unescape-string)

diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor
index 25b963c574331bd53b05c661ffbdbeef96bde2d5..1a61845fd183d50ce42f34f25cc0a43b03ab17cb 100644 (file)
--- a/core/syntax/syntax-docs.factor
+++ b/core/syntax/syntax-docs.factor
@@ -770,3 +770,13 @@ HELP: call-next-method
 { POSTPONE: call-next-method (call-next-method) next-method } related-words
 
 { POSTPONE: << POSTPONE: >> } related-words
+
+HELP: call(
+{ $syntax "call( stack -- effect )" }
+{ $description "Calls the quotation on the top of the stack, asserting that it has the given stack effect. The quotation does not need to be known at compile time." } ;
+
+HELP: execute(
+{ $syntax "execute( stack -- effect )" }
+{ $description "Calls the word on the top of the stack, asserting that it has the given stack effect. The word does not need to be known at compile time." } ;
+
+{ POSTPONE: call( POSTPONE: execute( } related-words
\ No newline at end of file

diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor
index de3be98ceb28b201dd729e67daa1fc357561dcbc..f6d124d8da6445ffa755c5c3e5626121379b8ae3 100644 (file)
--- a/core/syntax/syntax.factor
+++ b/core/syntax/syntax.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: accessors alien arrays byte-arrays definitions generic
 hashtables kernel math namespaces parser lexer sequences strings
@@ -246,4 +246,8 @@ IN: bootstrap.syntax
     "initial:" "syntax" lookup define-symbol
     
     "read-only" "syntax" lookup define-symbol
+
+    "call(" [ \ call-effect parse-call( ] define-syntax
+
+    "execute(" [ \ execute-effect parse-call( ] define-syntax
 ] with-compilation-unit

diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor
index 00c4df92a63ab88e07a07c9cc24a60920691cb89..df6d2d02a7919520b44297b2da1ec1084927195a 100644 (file)
--- a/core/vocabs/loader/loader.factor
+++ b/core/vocabs/loader/loader.factor
@@ -64,7 +64,7 @@ SYMBOL: load-help?
         +parsing+ >>source-loaded?
         dup vocab-source-path [ parse-file ] [ [ ] ] if*
         [ +parsing+ >>source-loaded? ] dip
-        [ % ] [ assert-depth ] if-bootstrapping
+        [ % ] [ call( -- ) ] if-bootstrapping
         +done+ >>source-loaded? drop
     ] [ ] [ f >>source-loaded? ] cleanup ;
 

diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor
index 977eac2b35950846616337b3e498324813484a50..b9f38dfef3b6a0391efc445609ae2fc898003ec7 100644 (file)
--- a/core/vocabs/vocabs.factor
+++ b/core/vocabs/vocabs.factor
@@ -105,4 +105,4 @@ M: vocab-spec forget* forget-vocab ;
 
 SYMBOL: load-vocab-hook ! ( name -- vocab )
 
-: load-vocab ( name -- vocab ) load-vocab-hook get call ;
\ No newline at end of file
+: load-vocab ( name -- vocab ) load-vocab-hook get call( name -- vocab ) ;
\ No newline at end of file

diff --git a/core/words/words.factor b/core/words/words.factor
index cd11fb2db19b35e653d51dbcae5677b52a7d4ba0..c4a94f0a4cfae8ea4d50e91759141a7ceeeb6618 100755 (executable)
--- a/core/words/words.factor
+++ b/core/words/words.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: accessors arrays definitions graphs assocs kernel
 kernel.private slots.private math namespaces sequences strings
@@ -10,8 +10,6 @@ IN: words
 
 : set-word ( word -- ) \ word set-global ;
 
-GENERIC: execute ( word -- )
-
 M: word execute (execute) ;
 
 M: word <=>

diff --git a/extra/4DNav/4DNav.factor b/extra/4DNav/4DNav.factor
index f6c00154bbd0b4b0e237d6b6402dcc623fd6f4f5..ee37b33fbff41b7765b82ea2c1009089458d2e55 100755 (executable)
--- a/extra/4DNav/4DNav.factor
+++ b/extra/4DNav/4DNav.factor
@@ -17,7 +17,6 @@ colors
 colors.constants\r
 prettyprint\r
 vars\r
-call\r
 quotations\r
 io\r
 io.directories\r

diff --git a/extra/monads/monads-tests.factor b/extra/monads/monads-tests.factor
index 44234bc4bc538242503e11d55e3664c9439630d2..ee63b14f3c27d999d6556881af3522ab5291957c 100644 (file)
--- a/extra/monads/monads-tests.factor
+++ b/extra/monads/monads-tests.factor
@@ -79,7 +79,7 @@ IN: monads.tests
 LAZY: nats-from ( n -- list )
     dup 1+ nats-from cons ;
 
-: nats 0 nats-from ;
+: nats ( -- list ) 0 nats-from ;
 
 [ 3 ] [
     {

diff --git a/extra/monads/monads.factor b/extra/monads/monads.factor
index e9ae1675323d53170bb47ccdd76739088b60c76e..6b35772596f92e59e06c18b8ff6055e19ab6720d 100644 (file)
--- a/extra/monads/monads.factor
+++ b/extra/monads/monads.factor
@@ -6,7 +6,7 @@ shuffle ;
 IN: monads
 
 ! Functors
-GENERIC# fmap 1 ( functor quot -- functor' ) inline
+GENERIC# fmap 1 ( functor quot -- functor' )
 
 ! Monads
 
@@ -21,7 +21,7 @@ GENERIC: >>= ( mvalue -- quot )
 M: monad return monad-of return ;
 M: monad fail   monad-of fail   ;
 
-: bind ( mvalue quot -- mvalue' ) swap >>= call ;
+: bind ( mvalue quot -- mvalue' ) swap >>= call( quot -- mvalue ) ;
 : >>   ( mvalue k -- mvalue' ) '[ drop _ ] bind ;
 
 :: lift-m2 ( m1 m2 f monad -- m3 )
@@ -30,14 +30,14 @@ M: monad fail   monad-of fail   ;
 :: apply ( mvalue mquot monad -- result )
     mvalue [| value |
         mquot [| quot |
-            value quot call monad return
+            value quot call( value -- mvalue ) monad return
         ] bind
     ] bind ;
 
 M: monad fmap over '[ @ _ return ] bind ;
 
 ! 'do' notation
-: do ( quots -- result ) unclip dip [ bind ] each ;
+: do ( quots -- result ) unclip [ call( -- mvalue ) ] curry dip [ bind ] each ;
 
 ! Identity
 SINGLETON: identity-monad
@@ -51,7 +51,7 @@ M: identity monad-of drop identity-monad ;
 M: identity-monad return drop identity boa ;
 M: identity-monad fail   "Fail" throw ;
 
-M: identity >>= value>> '[ _ swap call ] ;
+M: identity >>= value>> '[ _ swap call( x -- y ) ] ;
 
 : run-identity ( identity -- value ) value>> ;
 
@@ -73,7 +73,7 @@ M: maybe-monad return drop just ;
 M: maybe-monad fail   2drop nothing ;
 
 M: nothing >>= '[ drop _ ] ;
-M: just    >>= value>> '[ _ swap call ] ;
+M: just    >>= value>> '[ _ swap call( x -- y ) ] ;
 
 : if-maybe ( maybe just-quot nothing-quot -- )
     pick nothing? [ 2nip call ] [ drop [ value>> ] dip call ] if ; inline
@@ -97,7 +97,7 @@ M: either-monad return  drop right ;
 M: either-monad fail    drop left ;
 
 M: left  >>= '[ drop _ ] ;
-M: right >>= value>> '[ _ swap call ] ;
+M: right >>= value>> '[ _ swap call( x -- y ) ] ;
 
 : if-either ( value left-quot right-quot -- )
     [ [ value>> ] [ left? ] bi ] 2dip if ; inline
@@ -140,14 +140,14 @@ M: state monad-of drop state-monad ;
 M: state-monad return drop '[ _ 2array ] state ;
 M: state-monad fail   "Fail" throw ;
 
-: mcall ( state -- ) quot>> call ;
+: mcall ( x state -- y ) quot>> call( x -- y ) ;
 
 M: state >>= '[ _ swap '[ _ mcall first2 @ mcall ] state ] ;
 
 : get-st ( -- state ) [ dup 2array ] state ;
 : put-st ( value -- state ) '[ drop _ f 2array ] state ;
 
-: run-st ( state initial -- ) swap mcall second ;
+: run-st ( state initial -- value ) swap mcall second ;
 
 : return-st ( value -- mvalue ) state-monad return ;
 
@@ -166,7 +166,7 @@ M: reader-monad fail   "Fail" throw ;
 
 M: reader >>= '[ _ swap '[ dup _ mcall @ mcall ] reader ] ;
 
-: run-reader ( reader env -- ) swap mcall ;
+: run-reader ( reader env -- value ) swap quot>> call( env -- value ) ;
 
 : ask ( -- reader ) [ ] reader ;
 : local ( reader quot -- reader' ) swap '[ @ _ mcall ] reader ;
@@ -187,6 +187,6 @@ M: writer-monad fail   "Fail" throw ;
 
 M: writer >>= '[ [ _ run-writer ] dip '[ @ run-writer ] dip append writer ] ;
 
-: pass ( writer -- writer' ) run-writer [ first2 ] dip swap call writer ;
+: pass ( writer -- writer' ) run-writer [ first2 ] dip swap call( x -- y ) writer ;
 : listen ( writer -- writer' ) run-writer [ 2array ] keep writer ;
 : tell ( seq -- writer ) f swap writer ;

diff --git a/extra/promises/promises.factor b/extra/promises/promises.factor
index bec2761e5337327253fee9efc4c9af31fc1f1540..0e193741ebba35be1f1e7cad179dd691062fe385 100755 (executable)
--- a/extra/promises/promises.factor
+++ b/extra/promises/promises.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2004, 2006 Chris Double, Matthew Willis.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel sequences math vectors arrays namespaces call
+USING: arrays kernel sequences math vectors arrays namespaces
 make quotations parser effects stack-checker words accessors ;
 IN: promises
 

diff --git a/extra/ui/gadgets/lists/lists.factor b/extra/ui/gadgets/lists/lists.factor
index 982aabe2e8c6f9217d7dfc4fe7603d66de01bfdd..d7301ca042b77539972e181abd05ff7d2b5669da 100644 (file)
--- a/extra/ui/gadgets/lists/lists.factor
+++ b/extra/ui/gadgets/lists/lists.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors math.vectors classes.tuple math.rectangles colors
-kernel sequences models opengl math math.order namespaces call
+kernel sequences models opengl math math.order namespaces
 ui.commands ui.gestures ui.render ui.gadgets ui.gadgets.labels
 ui.gadgets.scrollers ui.gadgets.presentations ui.gadgets.viewports
 ui.gadgets.packs ;

diff --git a/vm/cpu-x86.32.S b/vm/cpu-x86.32.S
index 36db5d6c80bcdc489db117f0ff4a162a0a610429..7a8e579c6227a282e9fb684b7b537f3a6a6bacdf 100755 (executable)
--- a/vm/cpu-x86.32.S
+++ b/vm/cpu-x86.32.S
@@ -29,7 +29,7 @@ and the callstack top is passed in EDX */
        pop %ebp ; \
        pop %ebx
 
-#define QUOT_XT_OFFSET 9
+#define QUOT_XT_OFFSET 17
 
 /* We pass a function pointer to memcpy to work around a Mac OS X
 ABI limitation which would otherwise require us to do a bizzaro PC-relative

diff --git a/vm/cpu-x86.64.S b/vm/cpu-x86.64.S
index 7b5b5f3167fdfb9eb0ef43bc4fa4b423b5cad0bc..8cf8fb9ae71ff0718761654a6f7dd9fa1bfbb8bf 100644 (file)
--- a/vm/cpu-x86.64.S
+++ b/vm/cpu-x86.64.S
@@ -61,7 +61,7 @@
 
 #endif
 
-#define QUOT_XT_OFFSET 21
+#define QUOT_XT_OFFSET 37
 
 /* We pass a function pointer to memcpy to work around a Mac OS X
 ABI limitation which would otherwise require us to do a bizzaro PC-relative

diff --git a/vm/errors.c b/vm/errors.c
index 7c06ec1310568a98a7058e1ff2bfa7a244a3e67e..9b7b7843d247fa4aac507490d269c37a1a006f73 100755 (executable)
--- a/vm/errors.c
+++ b/vm/errors.c
@@ -144,12 +144,6 @@ void misc_signal_handler_impl(void)
        signal_error(signal_number,signal_callstack_top);
 }
 
-void primitive_throw(void)
-{
-       dpop();
-       throw_impl(dpop(),stack_chain->callstack_top);
-}
-
 void primitive_call_clear(void)
 {
        throw_impl(dpop(),stack_chain->callstack_bottom);

diff --git a/vm/errors.h b/vm/errors.h
index c7f8bc8712a5a918235c5199f7dbd9f91949cd41..da3ee8bbe04bf04c3136acdb7799f8599925dabb 100755 (executable)
--- a/vm/errors.h
+++ b/vm/errors.h
@@ -32,7 +32,6 @@ void signal_error(int signal, F_STACK_FRAME *native_stack);
 void type_error(CELL type, CELL tagged);
 void not_implemented_error(void);
 
-void primitive_throw(void);
 void primitive_call_clear(void);
 
 INLINE void type_check(CELL type, CELL tagged)

diff --git a/vm/layouts.h b/vm/layouts.h
index 94e2f623a3190443d0c770be06197d9791a17e90..5b417f92ddd4306a0fd28d9968e0bf66d5c19e84 100755 (executable)
--- a/vm/layouts.h
+++ b/vm/layouts.h
@@ -172,6 +172,10 @@ typedef struct {
        CELL array;
        /* tagged */
        CELL compiledp;
+       /* tagged */
+       CELL cached_effect;
+       /* tagged */
+       CELL cache_counter;
        /* UNTAGGED */
        XT xt;
        /* UNTAGGED compiled code block */

diff --git a/vm/primitives.c b/vm/primitives.c
index 82b05558942b5bf1b8f24f9657ffaf9967eab776..00103ac0471c6bc31e2a369a2b5f8dc88271a53c 100755 (executable)
--- a/vm/primitives.c
+++ b/vm/primitives.c
@@ -102,7 +102,6 @@ void *primitives[] = {
        primitive_set_alien_double,
        primitive_alien_cell,
        primitive_set_alien_cell,
-       primitive_throw,
        primitive_alien_address,
        primitive_set_slot,
        primitive_string_nth,

diff --git a/vm/quotations.c b/vm/quotations.c
index ca1a8bb3b56eefc291a13253a6734247f291432c..8ea2d5839bb94876db2b3178e7557d6a5fc3eaa5 100755 (executable)
--- a/vm/quotations.c
+++ b/vm/quotations.c
@@ -514,6 +514,8 @@ void primitive_array_to_quotation(void)
        quot->array = dpeek();
        quot->xt = lazy_jit_compile;
        quot->compiledp = F;
+       quot->cached_effect = F;
+       quot->cache_counter = F;
        drepl(tag_object(quot));
 }