duskos

dusk os fork
git clone git://git.alexwennerberg.com/duskos
Log | Files | Refs | README | LICENSE

commit 6b970f0b122323c9c9f5c276e7c324f262d2722d
parent 0e0c75cda82220d0fbdb5c412cf92ce133b4e4f8
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Sat, 28 Jan 2023 21:16:10 -0500

lib/context: make them actually work as intended

Diffstat:
Mfs/doc/lib/context.txt | 8+++++---
Mfs/lib/context.fs | 17++++++++++++++---
Mfs/tests/lib/context.fs | 5+++++
3 files changed, 24 insertions(+), 6 deletions(-)

diff --git a/fs/doc/lib/context.txt b/fs/doc/lib/context.txt @@ -4,9 +4,11 @@ Contexts are a way to avoid namespaces clashes in different word contexts. Some units have words with name that are intentionally short because they're intended to be often called by the user, but short names easily clash. -A context is a fork of the system dictionary. When you call its name, you -activate it and when you define words in it, they're only in that context. You -can then easily switch contexts by calling their names. Example: +A context is a fork of the system dictionary and "floaded" LL (the LL that +remembers which unit files are loaded). When you call its name, you activate it. +When you define words in it, they're only in that context. When you load a unit +in it, it's only flagged as "loaded" in that context. You can then easily switch +contexts by calling their names. Example: context editor f<< /text/ed.fs diff --git a/fs/lib/context.fs b/fs/lib/context.fs @@ -1,11 +1,22 @@ +struct[ Ctx + sfield sysdict + sfield floaded +]struct + 0 value _current \ currently active context, 0=system create _system 0 , 0 c, \ this is a dict link +0 value _floaded : system ( -- ) 0 to@! _current ?dup if ( ctx ) - _system @ sysdict @! ( ctx ctxdict ) swap ! then ; + _system @ sysdict @! ( ctx dict ) over to Ctx sysdict ( cxt ) + _floaded to@! floaded ( ctx floaded ) swap to Ctx floaded then ; : context ( "name" -- ) - system doer here to _current 0 , + system doer here to _current Ctx SZ allot0 + floaded to _floaded \ right after the context word, we need to add a dictionary indirection point. sysdict @ _system ! _system sysdict ! sysdict S" _" entry exit, - does> ( 'does ) system dup to _current @ sysdict ! ; +does> ( 'does ) + system dup to _current ( ctx ) + dup Ctx sysdict sysdict ! ( ctx ) + Ctx floaded to@! floaded to _floaded ; diff --git a/fs/tests/lib/context.fs b/fs/tests/lib/context.fs @@ -2,14 +2,19 @@ ?f<< /lib/context.fs testbegin \ Context tests +p" /xcomp/tools.fs" Path :floaded? not # : foo 42 ; context ctx1 +f<< /xcomp/tools.fs : foo 54 ; context ctx2 : foo 88 ; +p" /xcomp/tools.fs" Path :floaded? not # system foo 42 #eq +p" /xcomp/tools.fs" Path :floaded? not # ctx2 foo 88 #eq ctx1 foo 54 #eq +p" /xcomp/tools.fs" Path :floaded? # : foo 111 ; \ don't override ctx2 ctx2 foo 88 #eq testend