Fixing libraries for stack checker changes

extra/db/db.factor

@@ -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

extra/db/queries/queries.factor

@@ -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 ;

extra/html/templates/chloe/chloe.factor

@@ -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 chloe-tag? ] [ process-chloe-tag ] }
-        { [ dup [ tag? ] is? ] [ process-tag ] }
+        { [ dup [ tag? ] [ xml? ] bi or ] [ process-tag ] }
         { [ t ] [ write-item ] }
     } cond ;
 

extra/namespaces/lib/lib-tests.factor

@@ -1,6 +1,8 @@
 IN: namespaces.lib.tests
-USING: namespaces.lib tools.test ;
+USING: namespaces.lib kernel tools.test ;
 
 [ ] [ [ ] { } nmake ] unit-test
 
 [ { 1 } { 2 } ] [ [ 1 0, 2 1, ] { { } { } } nmake ] unit-test
+
+[ [ ] [ call ] curry { { } } nmake ] must-infer

extra/namespaces/lib/lib.factor

@@ -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,9 +40,10 @@ SYMBOL: building-seq
 : 4% ( seq -- ) 4 n% ;
 : 4# ( num -- ) 4 n# ;
 
-MACRO:: nmake ( quot exemplars -- )
+MACRO: finish-nmake ( exemplars -- )
-    [let | n [ exemplars length ] |
+    length [ firstn ] curry ;
-        [
+
+:: nmake ( quot exemplars -- )
     [
         exemplars
         [ 0 swap new-resizable ] map
@@ -53,11 +52,8 @@ MACRO:: nmake ( quot exemplars -- )
         quot call
 
         building-seq get
-                exemplars [ like ] 2map
+        exemplars [ [ like ] 2map ] [ finish-nmake ] bi
-                n firstn
+    ] with-scope ; inline
-            ] with-scope
-        ]
-    ] ;
 
 : make-object ( quot class -- object )
     new [ <mirror> swap bind ] keep ; inline

extra/xmode/loader/syntax/syntax.factor

@@ -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 ;

extra/xmode/marker/context/context.factor

@@ -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 new
-    line-context construct ;
+        swap >>parent
+        swap >>in-rule-set ;
 
 M: line-context clone
-    (clone)
+    call-next-method [ clone ] change-parent ;
-    dup line-context-parent clone
-    over set-line-context-parent ;

extra/xmode/rules/rules.factor

@@ -66,14 +66,11 @@ delegate
 chars
 ;
 
-: construct-rule ( class -- rule )
+TUPLE: seq-rule < rule ;
-    >r rule new r> construct-delegate ; inline
 
-TUPLE: seq-rule ;
+TUPLE: span-rule < rule ;
 
-TUPLE: span-rule ;
+TUPLE: eol-span-rule < rule ;
-
-TUPLE: eol-span-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
+    escape-rule new swap >>start ;
-    [ set-rule-start ] keep ;
 
 GENERIC: text-hash-char ( text -- ch )
 

extra/xmode/utilities/utilities-tests.factor

@@ -1,7 +1,7 @@
 IN: xmode.utilities.tests
-USING: xmode.utilities tools.test xml xml.data kernel strings
+USING: accessors xmode.utilities tools.test xml xml.data kernel
-vectors sequences io.files prettyprint assocs unicode.case ;
+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 ;
 
 [

extra/xmode/utilities/utilities.factor

@@ -1,10 +1,10 @@
-USING: sequences assocs kernel quotations namespaces xml.data
+USING: accessors sequences assocs kernel quotations namespaces
-xml.utilities combinators macros parser lexer words ;
+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