X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=src%2Flib.4th;h=ea4e7dea202350178b613bb5f70423de06fedf9f;hb=91c9ee133605d4d8871b897b109a60f401b3aa79;hp=ff46f5f6d7b4dc06767eef9be7a896a1ac7aac8a;hpb=5328ad90af9699b87b0beee70aa7a7ee6a98e8a9;p=forth.jl.git

diff --git a/src/lib.4th b/src/lib.4th
index ff46f5f..ea4e7de 100644
--- a/src/lib.4th
+++ b/src/lib.4th
@@ -1,6 +1,6 @@
 : / /MOD SWAP DROP ;
 : MOD /MOD DROP ;
-: */ * / ;
+: */ -ROT * SWAP / ;
 
 : NEGATE 0 SWAP - ;
 
@@ -116,15 +116,23 @@
 
 : I RSP@ 3 - @ ;
 
-: LEAVE IMMEDIATE
+: J RSP@ 6 - @ ;
+
+: ?LEAVE IMMEDIATE
+        ' 0BRANCH , 13 ,
         ' R> , ' RDROP , ' RDROP ,
-        ' LIT ,  HERE @ 7 + , ' DUP , ' ROT , ' - , ' SWAP , ' ! ,
+        ' LIT ,  HERE @ 7 + , ' DUP , ' -ROT , ' - , ' SWAP , ' ! ,
         ' BRANCH ,
         0 ,
 ;
 
-: LOOP IMMEDIATE
-        ' R> , ' R> , ' R> , ' 1+ , ' 2DUP , ' - ,
+: LEAVE IMMEDIATE
+        ' LIT , -1 ,
+        [COMPILE] ?LEAVE
+;
+
+: +LOOP IMMEDIATE
+        ' R> , ' SWAP , ' R> , ' SWAP , ' R> , ' SWAP , ' + , ' 2DUP , ' - ,
         ' SWAP , ' >R , ' SWAP , ' >R , ' SWAP , ' >R ,
         ' 0<= , ' 0BRANCH ,
         HERE @ - ,
@@ -132,8 +140,10 @@
         HERE @ SWAP !
 ;
 
-: lt 10 0 do leave loop ;
-
+: LOOP IMMEDIATE
+        ' LIT , 1 ,
+        [COMPILE] +LOOP
+;
 
 \ COMMENTS ----------------------------------------------------------------------
 
@@ -155,23 +165,18 @@
 
 ( Some more complicated stack examples, showing the stack notation. )
 : NIP ( x y -- y ) SWAP DROP ;
-: TUCK ( x y -- y x y ) DUP ROT ;
+: TUCK ( x y -- y x y ) DUP -ROT ;
 : PICK ( x_u ... x_1 x_0 u -- x_u ... x_1 x_0 x_u )
         1+              ( add one because of 'u' on the stack )
         PSP@ SWAP -     ( add to the stack pointer )
         @               ( and fetch )
 ;
 
-
 ( With the looping constructs, we can now write SPACES, which writes n spaces to stdout. )
 : SPACES        ( n -- )
-        BEGIN
-                DUP 0>          ( while n > 0 )
-        WHILE
-                SPACE           ( print a space )
-                1-              ( until we count down to 0 )
-        REPEAT
-        DROP
+        0 DO
+            SPACE
+        LOOP
 ;
 
 ( Standard words for manipulating BASE. )
@@ -235,7 +240,7 @@
         SWAP            ( width u )
         DUP             ( width u u )
         UWIDTH          ( width u uwidth )
-        -ROT            ( u uwidth width )
+        ROT            ( u uwidth width )
         SWAP -          ( u width-uwidth )
         ( At this point if the requested width is narrower, we'll have a negative number on the stack.
           Otherwise the number on the stack is the number of spaces to print.  But SPACES won't print
@@ -250,18 +255,18 @@
         DUP 0< IF
                 NEGATE          ( width u )
                 1               ( save a flag to remember that it was negative | width n 1 )
-                ROT             ( 1 width u )
+                -ROT             ( 1 width u )
                 SWAP            ( 1 u width )
                 1-              ( 1 u width-1 )
         ELSE
                 0               ( width u 0 )
-                ROT             ( 0 width u )
+                -ROT             ( 0 width u )
                 SWAP            ( 0 u width )
         THEN
         SWAP            ( flag width u )
         DUP             ( flag width u u )
         UWIDTH          ( flag width u uwidth )
-        -ROT            ( flag u uwidth width )
+        ROT            ( flag u uwidth width )
         SWAP -          ( flag u width-uwidth )
 
         SPACES          ( flag u )
@@ -295,7 +300,7 @@
 
 ( c a b WITHIN returns true if a <= c and c < b )
 : WITHIN
-        ROT             ( b c a )
+        -ROT             ( b c a )
         OVER            ( b c a c )
         <= IF
                 > IF            ( b c -- )
@@ -309,3 +314,13 @@
         THEN
 ;
 
+: ROLL ( x_u x_u-1... x_0 u -- x_u-1 ... x_0 x_u )
+        1+ DUP PICK SWAP    ( x_u x_u-1 ... x_0 x_u u+1 )
+        PSP@ 1- SWAP - PSP@ 2- SWAP
+        DO
+            i 1+ @ i !
+        LOOP
+        SWAP DROP
+;
+
+include ../examples/mandelbrot.4th