]> gitweb.factorcode.org Git - factor.git/commitdiff
Fixing libraries for stack checker changes
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Thu, 28 Aug 2008 00:27:06 +0000 (19:27 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Thu, 28 Aug 2008 00:27:06 +0000 (19:27 -0500)
basis/xml/data/.data.factor.swo [deleted file]
extra/db/db.factor
extra/db/queries/queries.factor
extra/html/templates/chloe/chloe.factor
extra/namespaces/lib/lib-tests.factor
extra/namespaces/lib/lib.factor
extra/xmode/loader/syntax/syntax.factor
extra/xmode/marker/context/context.factor
extra/xmode/rules/rules.factor
extra/xmode/utilities/utilities-tests.factor
extra/xmode/utilities/utilities.factor

diff --git a/basis/xml/data/.data.factor.swo b/basis/xml/data/.data.factor.swo
deleted file mode 100644 (file)
index 223c747..0000000
Binary files a/basis/xml/data/.data.factor.swo and /dev/null differ
index 889eff196cc9d19ccd5ffbc15fd9720fb2b56022..c52d1db148609124e6bcd0e7332dedc3a75dea95 100755 (executable)
@@ -96,12 +96,12 @@ M: object execute-statement* ( statement type -- )
 : sql-row-typed ( result-set -- seq )
     dup #columns [ row-column-typed ] with map ;
 
-: query-each ( statement quot -- )
+: query-each ( statement quot: ( statement -- ) -- )
     over more-rows? [
         [ call ] 2keep over advance-row query-each
     ] [
         2drop
-    ] if ; inline
+    ] if ; inline recursive
 
 : query-map ( statement quot -- seq )
     accumulator >r query-each r> { } like ; inline
index 7960eecee5089f35533391b6a9d9f56e5b04e486..3a751a9736a786520e9a70f584d0cf1a3fe5ae8a 100644 (file)
@@ -14,7 +14,7 @@ GENERIC: where ( specs obj -- )
 
 : query-make ( class quot -- )
     >r sql-props r>
-    [ 0 sql-counter rot with-variable ] { "" { } { } } nmake
+    [ 0 sql-counter rot with-variable ] curry { "" { } { } } nmake
     <simple-statement> maybe-make-retryable ; inline
 
 M: db begin-transaction ( -- ) "BEGIN" sql-command ;
index 103020ee0ff1e33dbe9729356b8a8ec7bf4c1f91..67a7dc2045002cfa02891e93240d38fb811c6789 100644 (file)
@@ -28,6 +28,7 @@ DEFER: process-template
     [ drop name-url chloe-ns = not ] assoc-filter ;
 
 : chloe-tag? ( tag -- ? )
+    dup xml? [ body>> ] when
     {
         { [ dup tag? not ] [ f ] }
         { [ dup url>> chloe-ns = not ] [ f ] }
@@ -112,12 +113,12 @@ CHLOE-TUPLE: checkbox
 CHLOE-TUPLE: code
 
 : process-chloe-tag ( tag -- )
-    dup name-tag dup tags get at
+    dup main>> dup tags get at
     [ call ] [ "Unknown chloe tag: " prepend throw ] ?if ;
 
 : process-tag ( tag -- )
     {
-        [ name-tag >lower tag-stack get push ]
+        [ main>> >lower tag-stack get push ]
         [ write-start-tag ]
         [ process-tag-children ]
         [ write-end-tag ]
@@ -125,7 +126,7 @@ CHLOE-TUPLE: code
     } cleave ;
 
 : expand-attrs ( tag -- tag )
-    dup [ tag? ] is? [
+    dup [ tag? ] [ xml? ] bi or [
         clone [
             [ "@" ?head [ value present ] when ] assoc-map
         ] change-attrs
@@ -134,8 +135,8 @@ CHLOE-TUPLE: code
 : process-template ( xml -- )
     expand-attrs
     {
-        { [ dup [ chloe-tag? ] is? ] [ process-chloe-tag ] }
-        { [ dup [ tag? ] is? ] [ process-tag ] }
+        { [ dup chloe-tag? ] [ process-chloe-tag ] }
+        { [ dup [ tag? ] [ xml? ] bi or ] [ process-tag ] }
         { [ t ] [ write-item ] }
     } cond ;
 
index 20769e161c16e9bce61566088cfc90710b405bcc..0bc2e6311a433ba0c03f98f2423e2ea3de55c579 100755 (executable)
@@ -1,6 +1,8 @@
 IN: namespaces.lib.tests\r
-USING: namespaces.lib tools.test ;\r
+USING: namespaces.lib kernel tools.test ;\r
 \r
 [ ] [ [ ] { } nmake ] unit-test\r
 \r
 [ { 1 } { 2 } ] [ [ 1 0, 2 1, ] { { } { } } nmake ] unit-test\r
+\r
+[ [ ] [ call ] curry { { } } nmake ] must-infer\r
index 4da3935727ec56f04ec612c71715a9f24686ee36..da9fde9d791033060a973da5b21aafbff60f28d5 100755 (executable)
@@ -1,8 +1,6 @@
-
-! USING: kernel quotations namespaces sequences assocs.lib ;
-
 USING: kernel namespaces namespaces.private quotations sequences
-       assocs.lib math.parser math generalizations locals mirrors ;
+       assocs.lib math.parser math generalizations locals mirrors
+       macros ;
 
 IN: namespaces.lib
 
@@ -42,22 +40,20 @@ SYMBOL: building-seq
 : 4% ( seq -- ) 4 n% ;
 : 4# ( num -- ) 4 n# ;
 
-MACRO:: nmake ( quot exemplars -- )
-    [let | n [ exemplars length ] |
-        [
-            [
-                exemplars
-                [ 0 swap new-resizable ] map
-                building-seq set
-
-                quot call
-
-                building-seq get
-                exemplars [ like ] 2map
-                n firstn
-            ] with-scope
-        ]
-    ] ;
+MACRO: finish-nmake ( exemplars -- )
+    length [ firstn ] curry ;
+
+:: nmake ( quot exemplars -- )
+    [
+        exemplars
+        [ 0 swap new-resizable ] map
+        building-seq set
+
+        quot call
+
+        building-seq get
+        exemplars [ [ like ] 2map ] [ finish-nmake ] bi
+    ] with-scope ; inline
 
 : make-object ( quot class -- object )
     new [ <mirror> swap bind ] keep ; inline
index 4c95a45832e45382fd924c3ce468d199460b163e..8b66774d7feb9c13f134b9239388be84fa1cb063 100644 (file)
@@ -1,4 +1,4 @@
-USING: xmode.tokens xmode.rules xmode.keyword-map xml.data
+USING: accessors xmode.tokens xmode.rules xmode.keyword-map xml.data
 xml.utilities xml assocs kernel combinators sequences
 math.parser namespaces parser lexer xmode.utilities regexp io.files ;
 IN: xmode.loader.syntax
@@ -7,7 +7,7 @@ SYMBOL: ignore-case?
 
 ! Rule tag parsing utilities
 : (parse-rule-tag) ( rule-set tag specs class -- )
-    construct-rule swap init-from-tag swap add-rule ; inline
+    new swap init-from-tag swap add-rule ; inline
 
 : RULE:
     scan scan-word
@@ -98,4 +98,4 @@ TAGS>
 : init-eol-span-tag ( -- ) [ drop init-eol-span ] , ;
 
 : parse-keyword-tag ( tag keyword-map -- )
-    >r dup name-tag string>token swap children>string r> set-at ;
+    >r dup main>> string>token swap children>string r> set-at ;
index 72ac3f2a3f7dc6a19e7cc3e5212c2a442935df70..da20503fcbacc371c69fc42e1c6885d0b4da4b60 100644 (file)
@@ -1,4 +1,4 @@
-USING: kernel ;
+USING: accessors kernel ;
 IN: xmode.marker.context
 
 ! Based on org.gjt.sp.jedit.syntax.TokenMarker.LineContext
@@ -11,10 +11,9 @@ end
 
 : <line-context> ( ruleset parent -- line-context )
     over [ "no context" throw ] unless
-    { set-line-context-in-rule-set set-line-context-parent }
-    line-context construct ;
+    line-context new
+        swap >>parent
+        swap >>in-rule-set ;
 
 M: line-context clone
-    (clone)
-    dup line-context-parent clone
-    over set-line-context-parent ;
+    call-next-method [ clone ] change-parent ;
index 3fcae02a546614254a541c3c9bbe0d9c1181c5b1..50d2924b615ce064828c67b9298ee6dd0c0fe317 100755 (executable)
@@ -66,14 +66,11 @@ delegate
 chars
 ;
 
-: construct-rule ( class -- rule )
-    >r rule new r> construct-delegate ; inline
+TUPLE: seq-rule < rule ;
 
-TUPLE: seq-rule ;
+TUPLE: span-rule < rule ;
 
-TUPLE: span-rule ;
-
-TUPLE: eol-span-rule ;
+TUPLE: eol-span-rule < rule ;
 
 : init-span ( rule -- )
     dup rule-delegate [ drop ] [
@@ -85,16 +82,15 @@ TUPLE: eol-span-rule ;
     dup init-span
     t swap set-rule-no-line-break? ;
 
-TUPLE: mark-following-rule ;
+TUPLE: mark-following-rule < rule ;
 
-TUPLE: mark-previous-rule ;
+TUPLE: mark-previous-rule < rule ;
 
-TUPLE: escape-rule ;
+TUPLE: escape-rule < rule ;
 
 : <escape-rule> ( string -- rule )
     f <string-matcher> f f f <matcher>
-    escape-rule construct-rule
-    [ set-rule-start ] keep ;
+    escape-rule new swap >>start ;
 
 GENERIC: text-hash-char ( text -- ch )
 
index 55b6bbe26a945c87a288834b28cdca063383d66b..49a1265b09172114af8adf9955f410acecaa9160 100755 (executable)
@@ -1,7 +1,7 @@
 IN: xmode.utilities.tests
-USING: xmode.utilities tools.test xml xml.data kernel strings
-vectors sequences io.files prettyprint assocs unicode.case ;
-
+USING: accessors xmode.utilities tools.test xml xml.data kernel
+strings vectors sequences io.files prettyprint assocs
+unicode.case ;
 [ "hi" 3 ] [
     { 1 2 3 4 5 6 7 8 } [ H{ { 3 "hi" } } at ] map-find
 ] unit-test
@@ -35,7 +35,7 @@ TAGS>
         { { "type" >upper set-company-type } }
         init-from-tag dup
     ] keep
-    tag-children [ tag? ] filter
+    children>> [ tag? ] filter
     [ parse-employee-tag ] with each ;
 
 [
index d6f9c427997f1618259f622e696588d586ff4153..8f1a6184e84c7658d72bf9e9ea629ae9c82bc004 100644 (file)
@@ -1,10 +1,10 @@
-USING: sequences assocs kernel quotations namespaces xml.data
-xml.utilities combinators macros parser lexer words ;
+USING: accessors sequences assocs kernel quotations namespaces
+xml.data xml.utilities combinators macros parser lexer words ;
 IN: xmode.utilities
 
 : implies >r not r> or ; inline
 
-: child-tags ( tag -- seq ) tag-children [ tag? ] filter ;
+: child-tags ( tag -- seq ) children>> [ tag? ] filter ;
 
 : map-find ( seq quot -- result elt )
     f -rot
@@ -53,5 +53,5 @@ SYMBOL: tag-handler-word
 
 : TAGS>
     tag-handler-word get
-    tag-handlers get >alist [ >r dup name-tag r> case ] curry
+    tag-handlers get >alist [ >r dup main>> r> case ] curry
     define ; parsing