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