X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=scheme.4th;h=1f0211464f792819dcdc204d71295e33ce4527c3;hb=4f600fd1014c0684aad06ec8fdbc8d3ee9c324a4;hp=e2162be192dc2a34d7c714339f180ba1f75b3449;hpb=613a9d60145361cec8ed96e49193f730e113a53a;p=scheme.forth.jl.git

diff --git a/scheme.4th b/scheme.4th
index e2162be..1f02114 100644
--- a/scheme.4th
+++ b/scheme.4th
@@ -82,6 +82,20 @@ variable nextfree
 : objeq? ( obj obj -- bool )
     rot = -rot = and ;
 
+: 2rot ( a1 a2 b1 b2 c1 c2 -- b1 b2 c1 c2 a1 a2 )
+    >R >R ( a1 a2 b1 b2 )
+    2swap ( b1 b2 a1 a2 )
+    R> R> ( b1 b2 a1 a2 c1 c2 )
+    2swap
+;
+
+: -2rot ( a1 a2 b1 b2 c1 c2 -- c1 c2 a1 a2 b1 b2 )
+    2swap ( a1 a2 c1 c2 b1 b2 )
+    >R >R ( a1 a2 c1 c2 )
+    2swap ( c1 c2 a1 a2 )
+    R> R>
+;
+
 \ }}}
 
 \ ---- Pre-defined symbols ---- {{{
@@ -725,7 +739,7 @@ defer eval
     
     2swap definition-var 2swap ( env var val )
 
-    >R >R 2swap R> R> 2swap ( var val env )
+    2rot ( var val env )
     define-var
 
     ok-symbol
@@ -739,7 +753,7 @@ defer eval
     
     2swap assignment-var 2swap ( env var val )
 
-    >R >R 2swap R> R> 2swap ( var val env )
+    2rot ( var val env )
     set-var
 
     ok-symbol