From f1f104259426dc77ec46ae1ac3bda65fcc19a034 Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Wed, 1 Aug 2018 16:40:04 +0200 Subject: [PATCH] call/cc seems to be working! --- src/scheme-primitives.4th | 14 +++++++++++--- src/scheme.4th | 11 ++++++++++- 2 files changed, 21 insertions(+), 4 deletions(-) diff --git a/src/scheme-primitives.4th b/src/scheme-primitives.4th index f6bb92d..a9b4741 100644 --- a/src/scheme-primitives.4th +++ b/src/scheme-primitives.4th @@ -607,9 +607,17 @@ defer display 2swap apply ; make-primitive apply -:noname ( args -- result ) - make-continuation nil cons - 2swap apply +:noname ( proc -- result ) + make-continuation + + drop if + nil cons + 2swap apply + else + 2swap 2drop + then + + trace ; 1 make-fa-primitive call-with-current-continuation diff --git a/src/scheme.4th b/src/scheme.4th index 36a8106..9d64667 100644 --- a/src/scheme.4th +++ b/src/scheme.4th @@ -551,11 +551,16 @@ global-env obj! depth 2- 2/ fixnum-type 2swap cons ; -: make-continuation +: make-continuation ( -- continuation true-obj ) + \ true-obj allows calling code to detect whether + \ it is being called immediately following make-continuation + \ or by a restore-continuation. cons-param-stack cons-return-stack cons drop continuation-type + + true boolean-type ; : continuation->pstack-list @@ -627,6 +632,10 @@ global-env obj! 2swap + false boolean-type \ Add flag signifying continuation restore + + 2swap + restore-return-stack ; -- 2.20.1