Minor performance improvements

basis/stack-checker/backend/backend-tests.factor

@@ -0,0 +1,22 @@
+USING: stack-checker.backend tools.test kernel namespaces
+stack-checker.state sequences ;
+IN: stack-checker.backend.tests
+
+[ ] [
+    V{ } clone meta-d set
+    V{ } clone meta-r set
+    0 d-in set
+] unit-test
+
+[ 0 ] [ 0 ensure-d length ] unit-test
+
+[ 2 ] [ 2 ensure-d length ] unit-test
+[ 2 ] [ meta-d get length ] unit-test
+
+[ 3 ] [ 3 ensure-d length ] unit-test
+[ 3 ] [ meta-d get length ] unit-test
+
+[ 1 ] [ 1 ensure-d length ] unit-test
+[ 3 ] [ meta-d get length ] unit-test
+
+[ ] [ 1 consume-d drop ] unit-test

basis/stack-checker/backend/backend.factor

@@ -17,15 +17,25 @@ IN: stack-checker.backend
 
 : peek-d ( -- obj ) pop-d dup push-d ;
 
-: consume-d ( n -- seq ) [ pop-d ] replicate reverse ;
-
-: output-d ( values -- ) meta-d get push-all ;
-
-: ensure-d ( n -- values ) consume-d dup output-d ;
-
 : make-values ( n -- values )
     [ <value> ] replicate ;
 
+: ensure-d ( n -- values )
+    meta-d get 2dup length > [
+        2dup
+        [ nip >array ] [ length - make-values ] [ nip delete-all ] 2tri
+        [ length d-in +@ ] [ #introduce, ] [ meta-d get push-all ] tri
+        meta-d get push-all
+    ] when swap tail* ;
+
+: shorten-by ( n seq -- )
+    [ length swap - ] keep shorten ; inline
+
+: consume-d ( n -- seq )
+    [ ensure-d ] [ meta-d get shorten-by ] bi ;
+
+: output-d ( values -- ) meta-d get push-all ;
+
 : produce-d ( n -- values )
     make-values dup meta-d get push-all ;
 
@@ -35,7 +45,10 @@ IN: stack-checker.backend
     meta-r get dup empty?
     [ too-many-r> inference-error ] [ pop ] if ;
 
-: consume-r ( n -- seq ) [ pop-r ] replicate reverse ;
+: consume-r ( n -- seq )
+    meta-r get 2dup length >
+    [ too-many-r> inference-error ] when
+    [ swap tail* ] [ shorten-by ] 2bi ;
 
 : output-r ( seq -- ) meta-r get push-all ;