alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Adding Oofda & Poke, fix copyright notice.

Browse Source 
Adding an experimental Object Sytem (Oofda).
Adding an experimental DI Framework (Poke).
This commit is contained in:
Brad Nelson
2023-05-24 21:00:40 -07:00
parent 8e46c227ac
commit 8c31cbd694
20 changed files with 796 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
attic/circleforth/circle.fs
View File

@ -8,11 +8,11 @@
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
( CircleForth )
vocabulary circleforth circleforth definitions

10
attic/circleforth/compound.fs
View File

@ -8,11 +8,11 @@
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
( Useful basic compound words )
: 2drop ( n n -- ) drop drop ;

5
attic/oofda/README.md Normal file
View File

@ -0,0 +1,5 @@
# Oofda & Poke
An experimental Object system and Dependency injection framework for uEforth.
Vaguely inspired by Dagger, includes the CoffeeMaker example.

99
attic/oofda/examples/coffee.fs Normal file
View File

@ -0,0 +1,99 @@
#! /usr/bin/env ueforth
\ Copyright 2023 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
needs ../poke.fs
needs ../lib/array.fs
needs ../lib/string.fs
( A logger to log steps while brewing coffee. )
class CoffeeLogger
value logs
: .construct 30 Array .new to logs ;
: .log ( a n -- ) String .new logs .append ;
: .dump logs .length 0 ?do
i logs .get .get type cr
loop cr ;
end-class
class LoggerModule
: .provideCoffeeLogger @Singleton CoffeeLogger .new ;
end-class
( A coffee maker to brew the coffee. )
class CoffeeMaker
value logger
value heater
value pump
m: .provideCoffeeLogger
m: .provideHeater m: .providePump
m: .on m: .off m: .pump m: .isHot?
: .construct @Inject CoffeeLogger to logger
@Inject Heater to heater
@Inject Pump to pump ;
: .brew heater .on
pump .pump
s" [_]P coffee! [_]P " logger .log
heater .off ;
end-class
class CoffeeMakerModule
: .provideCoffeeMaker CoffeeMaker .new ;
end-class
( An electric heater to heat the coffee. )
class ElectricHeater
value logger
value heating
: .construct @Inject CoffeeLogger to logger
0 to heating ;
: .on -1 to heating
s" ~ ~ ~ heating ~ ~ ~" logger .log ;
: .off 0 to heating ;
: .isHot? ( -- f ) heating ;
end-class
( A thermosiphon to pump the coffee. )
class Thermosiphon
value logger
value heater
: .construct @Inject CoffeeLogger to logger
@Inject Heater to heater ;
: .pump heater .isHot? if
s" => => pumping => =>" logger .log
then ;
end-class
class HeaterModule
: .provideHeater @Singleton ElectricHeater .new ;
end-class
class PumpModule
: .providePump Thermosiphon .new ;
end-class
( The main app responsible for brewing the coffee and printing the logs. )
class CoffeeApp extends Component
: .construct super .construct
HeaterModule this .include
PumpModule this .include
LoggerModule this .include
CoffeeMakerModule this .include ;
end-class
CoffeeApp .new constant coffeeShop
coffeeShop .provideCoffeeMaker .brew
coffeeShop .provideCoffeeLogger .dump
bye

43
attic/oofda/examples/simple_coffee.fs Normal file
View File

@ -0,0 +1,43 @@
#! /usr/bin/env ueforth
\ Copyright 2023 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
DEFER log
DEFER heater-on
DEFER heater-off
DEFER pump
: brew heater-on
pump
s" [_]P coffee! [_]P " log
heater-off ;
: console-log ( a n -- ) type cr ;
' console-log IS log
DEFER hot?
: thermosiphon
hot? if s" => => pumping => =>" log then ;
' thermosiphon IS pump
0 value switch
: electric-on -1 TO switch
s" ~ ~ ~ heating ~ ~ ~" log ;
: electric-off 0 TO switch ;
' electric-on IS heater-on
' electric-off IS heater-off
' switch IS hot?
brew
bye

31
attic/oofda/lib/array.fs Normal file
View File

@ -0,0 +1,31 @@
\ Copyright 2023 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
needs ../oofda.fs
class Array
value data
value length
value capacity
: .construct ( n -- ) to capacity
here to data capacity cells allot
0 to length ;
: .get ( n -- n ) cells data + @ ;
: .set ( n n -- ) cells data + ! ;
: .length ( -- n ) length ;
: .capacity ( -- n ) capacity ;
: .append ( n -- ) this .length this .capacity >= throw
this .length this .set 1 +to length ;
: .length ( -- n ) length ;
end-class

37
attic/oofda/lib/logging.fs Normal file
View File

@ -0,0 +1,37 @@
\ Copyright 2023 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
needs ../oofda.fs
class Logger
m: .logString
: .cr nl >r rp@ 1 this .logString rdrop ;
: .logNumber ( n -- ) <# #s #> this .logString ;
: .log ( a n -- ) this .logString this .cr ;
end-class
class NullLogger extends Logger
: .logString ( a n -- ) 2drop ;
end-class
class ConsoleLogger extends Logger
: .logString ( a n -- ) type ;
end-class
class FileLogger extends Logger
value handle
: .construct ( a n -- ) w/o create-file throw to handle ;
: .logString ( a n -- ) handle write-file drop ;
: .close handle close-file throw ;
end-class

28
attic/oofda/lib/queue.fs Normal file
View File

@ -0,0 +1,28 @@
\ Copyright 2023 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
needs stack.fs
class Queue
value stack1
value stack2
: .construct ( n -- ) dup Stack .new to stack1
Stack .new to stack2 ;
: .push ( n -- ) stack1 .push ;
: .transfer begin stack1 .empty? 0=
while stack1 .pop stack2 .push repeat ;
: .pop ( -- n ) stack2 .empty? if this .transfer then
stack2 .pop ;
: .empty? ( -- f ) stack1 .empty? stack2 .empty? and ;
end-class

25
attic/oofda/lib/stack.fs Normal file
View File

@ -0,0 +1,25 @@
\ Copyright 2023 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
needs ../oofda.fs
class Stack
variable start
variable sp
: .construct ( n -- ) here start ! here sp ! cells allot ;
: .empty? ( -- f ) sp @ start @ = ;
: .push ( n -- ) sp @ ! cell sp +! ;
: .pop ( -- n ) this .empty? throw
cell negate sp +! sp @ @ ;
end-class

25
attic/oofda/lib/string.fs Normal file
View File

@ -0,0 +1,25 @@
\ Copyright 2023 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
needs ../oofda.fs
class String
value length
value data
: .construct ( a n -- ) dup to length
here to data
here swap cmove
length allot ;
: .get ( -- a n ) data length ;
end-class

107
attic/oofda/oofda.fs Normal file
View File

@ -0,0 +1,107 @@
\ Copyright 2023 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
defined? oofda-max-methods 0= [IF]
100 constant oofda-max-methods
[THEN]
vocabulary classing also classing definitions also forth
variable 'this : this ( -- o ) 'this @ ;
variable methods variable last-method
: new-method ( ".name" -- xt )
methods @ oofda-max-methods >= throw
create methods @ , 1 methods +! latestxt
does> this >r swap ( save this ) 'this ! ( switch it )
dup last-method ! ( save last method )
@ cells this @ + @ execute ( invoke method )
r> 'this ! ( restore this ) ;
: method ( ".name" -- xt )
current @ >r also forth definitions
>in @ bl parse find dup if
nip
else
drop >in ! new-method
then
previous r> current ! ;
: m# ( "name" -- n ) method >body @ ;
: m: ( "name" ) method drop ; m: .construct ( make this 0 )
: m! ( xt n class ) swap 3 + cells + ! ;
: field' ( "name" -- n ) ' >body @ ;
: nop-construct ;
m: .fallback
: undefined last-method @ 2 cells - ( body> ) this .fallback ;
: error-fallback ( xt -- ) ." Undefined method: " >name type cr throw -1 ;
: blank-vtable oofda-max-methods 0 do ['] undefined , loop ;
create ClassClass
here 3 cells + , ( vtable* )
0 , ( parent )
oofda-max-methods 3 + cells , ( size )
blank-vtable ( vtable[] )
m: .size m: .grow m: .vtable m: .parent m: .getClass
:noname ( xt n ) this m! ; m# .setMethod ClassClass m!
: create ( "name" ) create this .size , does> @ this + ;
: variable ( "name" ) create this .size , cell this .grow does> @ this + ;
: value ( "name" ) create this .size , cell this .grow does> @ this + @ ;
: to ( n -- "name" ) field' postpone literal postpone this postpone +
postpone ! ; immediate
: +to ( n -- "name" ) field' postpone literal postpone this postpone +
postpone +! ; immediate
: dosuper ( n -- ) this ClassClass .getClass .parent .vtable + @ execute ;
: super ( "method" ) field' cells postpone literal postpone dosuper ; immediate
: : ( "name" ) m# :noname ;
: ; postpone ; swap this .setMethod ; immediate
: defining ( cls -- ) 'this ! current @ also classing definitions ;
definitions
m: .new m: .inherit
: class create ClassClass .new defining ;
: end-class previous current ! 0 'this ! ;
: extends ' execute this .inherit ;
: extend ' execute defining ;
: ClassClass ( -- cls ) ClassClass ;
previous previous definitions
extend ClassClass
: .parent ( -- a ) this cell+ @ ;
: .setParent ( a -- ) this cell+ ! ;
: .size& ( -- a ) this 2 cells + ;
: .size ( -- n ) this .size& @ ;
: .setSize ( -- n ) this .size& ! ;
: .grow ( n -- ) this .size + this .setSize ;
: .vtable ( -- a ) this 3 cells + ;
: .getClass ( o -- cls ) @ 3 cells - ;
: .allocate ( n -- a ) here swap allot ;
: .getName ( -- a n ) this 2 cells - >name ;
: .getMethod ( n -- xt ) cells this .vtable + @ ;
: .construct 0 this .setParent
cell this .setSize
oofda-max-methods 0 do ['] undefined i this .setMethod loop
['] error-fallback [ m# .fallback ] literal this .setMethod
['] nop-construct [ m# .construct ] literal this .setMethod ;
: .setup ( -- cls ) this .size this .allocate
dup this .size 0 fill
this .vtable over ! ;
: .new ( -- cls ) this .setup
dup >r .construct r> ;
: .inherit ( cls -- ) dup this .setParent
.size& this .size& oofda-max-methods 1+ cells cmove ;
end-class

59
attic/oofda/poke.fs Normal file
View File

@ -0,0 +1,59 @@
\ Copyright 2023 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
needs oofda.fs
needs lib/array.fs
also classing definitions also forth
variable provider
: do@Inject ( xt -- o ) provider @ swap execute ;
create name-buffer 200 allot 0 value name-length
: 0name 0 to name-length ;
: +name ( a n -- ) dup >r name-buffer name-length + swap cmove
r> +to name-length ;
: name ( -- a n ) name-buffer name-length ;
: @Inject ( "name" -- o ) 0name s" [ ' .provide" +name bl parse +name s" ]" +name
name evaluate postpone literal postpone do@Inject ; immediate
: do@Singleton ( n -- n ) this + dup @ if @ rdrop exit then
r> swap [ here 7 cells + ] literal swap >r >r >r exit
r> over >r ! r> ;
: @Singleton this .size postpone literal
cell this .grow
postpone do@Singleton ; immediate
previous previous definitions
class Component
value providers
: .construct 50 Array .new to providers ;
: .include ( m -- ) .new providers .append ;
: .hasMethod ( m n -- f )
providers .get ClassClass .getClass .getMethod ['] undefined <> ;
: .countHasMethod { m -- f }
0 providers .length 0 do
m i this .hasMethod if 1+ then
loop ;
: .pickHasMethod { m -- provider }
0 providers .length 0 do
m i this .hasMethod if i providers .get unloop exit then
loop -1 throw ;
: .fallback { xt } xt >body @ { m }
provider @ { old } this provider !
m this .countHasMethod { matches }
matches 1 > if ." Multiple Providers: " xt >name type cr -1 throw then
matches 1 <> if xt error-fallback then
m this .pickHasMethod xt execute
old provider ! ;
end-class

26
attic/oofda/run_tests.sh Normal file
View File

@ -0,0 +1,26 @@
#! /bin/bash
# Copyright 2023 Bradley D. Nelson
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
set -e
./tests/test1.fs
./tests/test2.fs
./tests/test3.fs
./tests/test4.fs
./tests/test5.fs
./tests/test6.fs
./tests/test7.fs
./examples/coffee.fs
./examples/simple_coffee.fs

44
attic/oofda/tests/test1.fs Normal file
View File

@ -0,0 +1,44 @@
#! /usr/bin/env ueforth
\ Copyright 2023 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
." test1.fs" cr
needs ../oofda.fs
class Foo
variable x
variable y
: .setX x ! ;
: .setY y ! ;
: .getX x @ ;
: .getY y @ ;
: .length2 this .getX dup * this .getY dup * + ;
: .construct 0 x ! 0 y ! ;
: .print ." x: " this .getX . ." y: " this .getY . cr ;
end-class
Foo .new .print
class Bar extends Foo
: .dude this .print this .print ;
end-class
Foo .new .print
Bar .new constant h
h .dude
123 h .setX 456 h .setY
h .dude
bye

38
attic/oofda/tests/test2.fs Normal file
View File

@ -0,0 +1,38 @@
#! /usr/bin/env ueforth
\ Copyright 2023 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
." test2.fs" cr
needs ../oofda.fs
class Foo
variable x
variable y
: .setX x ! ;
: .setY y ! ;
: .getX x @ ;
: .getY y @ ;
: .length2 this .getX dup * this .getY dup * + ;
: .print ." x: " this .getX . ." y: " this .getY . cr ;
end-class
class Bar extends Foo
: .dude this .print this .print ;
end-class
Bar .new constant h
123 h .setX 456 h .setY
h .dude
bye

58
attic/oofda/tests/test3.fs Normal file
View File

@ -0,0 +1,58 @@
#! /usr/bin/env ueforth
\ Copyright 2023 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
." test3.fs" cr
needs ../oofda.fs
class Pair
variable first
variable second
: .construct ( x y -- ) second ! first ! ;
: .unpair first @ second @ ;
end-class
class Coolness extends Pair
variable third
: .construct ( x y z -- ) super .construct third ! ;
: .unpair super .unpair third @ ;
end-class
123 456 Pair .new constant h
h .unpair . . cr
123 456 789 Coolness .new constant h2
h2 .unpair . . . cr
class Stack
variable sp
create start
100 cells this .grow
: .construct start sp ! ;
: .empty? ( -- f ) sp @ start @ = ;
: .push ( n -- ) sp @ ! cell sp +! ;
: .pop ( -- n ) this .empty? throw
cell negate sp +! sp @ @ ;
end-class
100 Stack .new constant s
123 s .push
234 s .push
345 s .push
s .pop . cr
s .pop . cr
s .pop . cr
bye

39
attic/oofda/tests/test4.fs Normal file
View File

@ -0,0 +1,39 @@
#! /usr/bin/env ueforth
\ Copyright 2023 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
." test4.fs" cr
needs ../lib/stack.fs
needs ../lib/queue.fs
100 Stack .new constant s
123 s .push
234 s .push
345 s .push
s .pop . cr
s .pop . cr
s .pop . cr
100 Queue .new constant q
123 q .push
234 q .push
q .pop . cr
345 q .push
q .pop . cr
456 q .push
q .pop . cr
q .pop . cr
bye

39
attic/oofda/tests/test5.fs Normal file
View File

@ -0,0 +1,39 @@
#! /usr/bin/env ueforth
\ Copyright 2023 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
." test5.fs" cr
needs ../lib/logging.fs
: @Inject ( "name" -- x )
bl parse
2dup s" Range" str= if 2drop 10 postpone literal exit then
2dup s" Logger" str= if 2drop postpone ConsoleLogger postpone .new exit then
-1 throw
; immediate
class Counter
value log
value range
: .construct @Inject Range to range
@Inject Logger to log ;
: .doit ( n -- ) s" Counter at: " log .logString log
.logNumber log .cr ;
: .run range 0 do i 1+ this .doit loop ;
end-class
Counter .new .run
bye

28
attic/oofda/tests/test6.fs Normal file
View File

@ -0,0 +1,28 @@
#! /usr/bin/env ueforth
\ Copyright 2023 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
." test6.fs" cr
needs ../lib/array.fs
10 Array .new constant a
1 a .append
2 a .append
3 a .append
1 a .get . cr
bye

55
attic/oofda/tests/test7.fs Normal file
View File

@ -0,0 +1,55 @@
#! /usr/bin/env ueforth
\ Copyright 2023 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
." test7.fs" cr
needs ../poke.fs
needs ../lib/logging.fs
class Counter
value log
value range
m: .provideRange
m: .provideLogger
m: .logString
m: .logNumber
m: .cr
: .construct @Inject Range to range
@Inject Logger to log ;
: .doit ( n -- ) s" Counter at: " log .logString
log .logNumber log .cr ;
: .run range 0 do i 1+ this .doit loop ;
end-class
class CountingModule
: .provideCounter @Singleton Counter .new ;
: .provideRange 10 ;
end-class
class LoggingModule
\ : .provideLogFilename s" log.txt" ;
\ : .provideLogger @Singleton @Inject LogFilename FileLogger .new ;
: .provideLogger @Singleton ConsoleLogger .new ;
end-class
class ProgramComponent extends Component
: .construct super .construct
LoggingModule this .include
CountingModule this .include ;
end-class
ProgramComponent .new .provideCounter .run
bye