Adding Oofda & Poke, fix copyright notice.
Adding an experimental Object Sytem (Oofda). Adding an experimental DI Framework (Poke).
This commit is contained in:
5
attic/oofda/README.md
Normal file
5
attic/oofda/README.md
Normal 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
99
attic/oofda/examples/coffee.fs
Normal 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
43
attic/oofda/examples/simple_coffee.fs
Normal 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
31
attic/oofda/lib/array.fs
Normal 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
37
attic/oofda/lib/logging.fs
Normal 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
28
attic/oofda/lib/queue.fs
Normal 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
25
attic/oofda/lib/stack.fs
Normal 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
25
attic/oofda/lib/string.fs
Normal 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
107
attic/oofda/oofda.fs
Normal 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
59
attic/oofda/poke.fs
Normal 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
26
attic/oofda/run_tests.sh
Normal 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
44
attic/oofda/tests/test1.fs
Normal 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
38
attic/oofda/tests/test2.fs
Normal 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
58
attic/oofda/tests/test3.fs
Normal 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
39
attic/oofda/tests/test4.fs
Normal 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
39
attic/oofda/tests/test5.fs
Normal 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
28
attic/oofda/tests/test6.fs
Normal 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
55
attic/oofda/tests/test7.fs
Normal 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
|
||||||
Reference in New Issue
Block a user