From 28559fc98c9209ae7dfb6b68d378a0e099adb8bb Mon Sep 17 00:00:00 2001 From: Jesse McDonald Date: Tue, 27 Oct 2020 21:18:17 -0500 Subject: [PATCH] =?UTF-8?q?unify=20AGAIN=20and=20REPEAT;=20allow=20multipl?= =?UTF-8?q?e=20WHILEs=20and=20BEGIN=20=E2=80=A6=20WHILE=20=E2=80=A6=20UNTI?= =?UTF-8?q?L?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- startup.4th | 46 +++++++++++++++++++++------------------------- 1 file changed, 21 insertions(+), 25 deletions(-) diff --git a/startup.4th b/startup.4th index f679422..30b4049 100644 --- a/startup.4th +++ b/startup.4th @@ -879,17 +879,16 @@ REPLACE-BOOTSTRAP \ includes no branch. The "orig" value it leaves on the stack (NULL) is ignored \ by THEN and marks the end of the list if consumed by ONWARD-IF or ONWARD-AHEAD. \ This can be used as a base for control structures with zero or more branches. -\ -\ The low-level primitives: -: ALWAYS ( C: -- orig ) IMMEDIATE NULL ; -: ONWARD-IF ( C: orig1 -- orig2 ) IMMEDIATE + +: ALWAYS ( C: -- null-orig ) IMMEDIATE + NULL ; +: ONWARD-IF ( C: orig1 -- orig2 ) ( Runtime: flag -- ) IMMEDIATE POSTPONE 0BRANCH HERE SWAP , ; : ONWARD-AHEAD ( C: orig1 -- orig2 ) IMMEDIATE POSTPONE BRANCH HERE SWAP , ; : THEN ( C: orig -- ) IMMEDIATE BEGIN ?DUP WHILE HERE OVER - SWAP XCHG REPEAT ; -\ The derived control structures: -: IF ( C: -- orig ) ( Runtime S: flag -- ) IMMEDIATE +: IF ( C: -- orig ) ( Runtime: flag -- ) IMMEDIATE POSTPONE ALWAYS POSTPONE ONWARD-IF ; : AHEAD ( C: -- orig ) IMMEDIATE POSTPONE ALWAYS POSTPONE ONWARD-AHEAD ; @@ -900,29 +899,26 @@ REPLACE-BOOTSTRAP \ Examples: \ AND-THEN THEN \ OR-ELSE THEN -: AND-THEN ( C: -- orig ) ( Runtime S: flag -- FALSE | ) IMMEDIATE - POSTPONE DUP POSTPONE IF POSTPONE DROP ; -: OR-ELSE ( C: -- orig ) ( Runtime S: flag -- nonzero-flag | ) IMMEDIATE +: AND-THEN ( C: -- orig ) ( Runtime: flag -- FALSE | ) IMMEDIATE + POSTPONE ?0DUP POSTPONE IF ; +: OR-ELSE ( C: -- orig ) ( Runtime: flag -- nonzero-flag | ) IMMEDIATE POSTPONE ?DUP POSTPONE 0= POSTPONE IF ; \ Unbounded loop: BEGIN AGAIN -\ BEGIN places the offset of the start of on the stack. -\ AGAIN creates a relative branch back to the start of . -: BEGIN ( C: -- dest ) IMMEDIATE - HERE ; -: AGAIN ( C: dest -- ) IMMEDIATE - POSTPONE BRANCH HERE - , ; +\ Simple conditional loop: BEGIN UNTIL +\ Mid-loop condition(s): BEGIN WHILE { WHILE}… REPEAT +\ Mixed WHILE/UNTIL loop: BEGIN WHILE UNTIL -\ Simple conditional loop: BEGIN UNTIL -\ UNTIL consumes the top of the stack and branches back to BEGIN if the value was FALSE. -: UNTIL ( C: dest -- ) ( Runtime S: flag -- ) IMMEDIATE - POSTPONE 0BRANCH HERE - , ; - -\ Alternate conditional loop: BEGIN WHILE REPEAT -: WHILE ( C: dest -- orig dest ) ( Runtime S: flag -- ) IMMEDIATE - POSTPONE IF SWAP ; -: REPEAT ( C: orig dest -- ) IMMEDIATE - POSTPONE AGAIN POSTPONE THEN ; +: BEGIN ( C: -- null-orig dest ) IMMEDIATE + POSTPONE ALWAYS ▪ HERE ; +: AGAIN ( C: orig dest -- ) IMMEDIATE + POSTPONE BRANCH ▪ HERE - , ▪ POSTPONE THEN ; +: UNTIL ( C: orig dest -- ) ( Runtime: flag -- ) IMMEDIATE + POSTPONE 0BRANCH HERE - , POSTPONE THEN ; +: WHILE ( C: orig1 dest -- orig2 dest ) ( Runtime: flag -- ) IMMEDIATE + SWAP POSTPONE ONWARD-IF SWAP ; +: REPEAT ( C: orig dest -- ) IMMEDIATE + POSTPONE AGAIN ; \ Sequential equality tests: \ CASE