From 8c31cbd69428acb132d694991a82492f2b2abd93 Mon Sep 17 00:00:00 2001 From: Brad Nelson Date: Wed, 24 May 2023 21:00:40 -0700 Subject: [PATCH] Adding Oofda & Poke, fix copyright notice. Adding an experimental Object Sytem (Oofda). Adding an experimental DI Framework (Poke). --- attic/circleforth/circle.fs | 10 +-- attic/circleforth/compound.fs | 10 +-- attic/oofda/README.md | 5 ++ attic/oofda/examples/coffee.fs | 99 ++++++++++++++++++++++++ attic/oofda/examples/simple_coffee.fs | 43 +++++++++++ attic/oofda/lib/array.fs | 31 ++++++++ attic/oofda/lib/logging.fs | 37 +++++++++ attic/oofda/lib/queue.fs | 28 +++++++ attic/oofda/lib/stack.fs | 25 ++++++ attic/oofda/lib/string.fs | 25 ++++++ attic/oofda/oofda.fs | 107 ++++++++++++++++++++++++++ attic/oofda/poke.fs | 59 ++++++++++++++ attic/oofda/run_tests.sh | 26 +++++++ attic/oofda/tests/test1.fs | 44 +++++++++++ attic/oofda/tests/test2.fs | 38 +++++++++ attic/oofda/tests/test3.fs | 58 ++++++++++++++ attic/oofda/tests/test4.fs | 39 ++++++++++ attic/oofda/tests/test5.fs | 39 ++++++++++ attic/oofda/tests/test6.fs | 28 +++++++ attic/oofda/tests/test7.fs | 55 +++++++++++++ 20 files changed, 796 insertions(+), 10 deletions(-) create mode 100644 attic/oofda/README.md create mode 100644 attic/oofda/examples/coffee.fs create mode 100644 attic/oofda/examples/simple_coffee.fs create mode 100644 attic/oofda/lib/array.fs create mode 100644 attic/oofda/lib/logging.fs create mode 100644 attic/oofda/lib/queue.fs create mode 100644 attic/oofda/lib/stack.fs create mode 100644 attic/oofda/lib/string.fs create mode 100644 attic/oofda/oofda.fs create mode 100644 attic/oofda/poke.fs create mode 100644 attic/oofda/run_tests.sh create mode 100644 attic/oofda/tests/test1.fs create mode 100644 attic/oofda/tests/test2.fs create mode 100644 attic/oofda/tests/test3.fs create mode 100644 attic/oofda/tests/test4.fs create mode 100644 attic/oofda/tests/test5.fs create mode 100644 attic/oofda/tests/test6.fs create mode 100644 attic/oofda/tests/test7.fs diff --git a/attic/circleforth/circle.fs b/attic/circleforth/circle.fs index 3a9fc16..451ab96 100755 --- a/attic/circleforth/circle.fs +++ b/attic/circleforth/circle.fs @@ -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 diff --git a/attic/circleforth/compound.fs b/attic/circleforth/compound.fs index 9573137..e7b248b 100644 --- a/attic/circleforth/compound.fs +++ b/attic/circleforth/compound.fs @@ -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 ; diff --git a/attic/oofda/README.md b/attic/oofda/README.md new file mode 100644 index 0000000..12cb1ca --- /dev/null +++ b/attic/oofda/README.md @@ -0,0 +1,5 @@ +# Oofda & Poke + +An experimental Object system and Dependency injection framework for uEforth. + +Vaguely inspired by Dagger, includes the CoffeeMaker example. diff --git a/attic/oofda/examples/coffee.fs b/attic/oofda/examples/coffee.fs new file mode 100644 index 0000000..75793ef --- /dev/null +++ b/attic/oofda/examples/coffee.fs @@ -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 diff --git a/attic/oofda/examples/simple_coffee.fs b/attic/oofda/examples/simple_coffee.fs new file mode 100644 index 0000000..59fdf4e --- /dev/null +++ b/attic/oofda/examples/simple_coffee.fs @@ -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 diff --git a/attic/oofda/lib/array.fs b/attic/oofda/lib/array.fs new file mode 100644 index 0000000..107c8a7 --- /dev/null +++ b/attic/oofda/lib/array.fs @@ -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 diff --git a/attic/oofda/lib/logging.fs b/attic/oofda/lib/logging.fs new file mode 100644 index 0000000..aacd830 --- /dev/null +++ b/attic/oofda/lib/logging.fs @@ -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 diff --git a/attic/oofda/lib/queue.fs b/attic/oofda/lib/queue.fs new file mode 100644 index 0000000..6f58523 --- /dev/null +++ b/attic/oofda/lib/queue.fs @@ -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 diff --git a/attic/oofda/lib/stack.fs b/attic/oofda/lib/stack.fs new file mode 100644 index 0000000..1454662 --- /dev/null +++ b/attic/oofda/lib/stack.fs @@ -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 diff --git a/attic/oofda/lib/string.fs b/attic/oofda/lib/string.fs new file mode 100644 index 0000000..9786275 --- /dev/null +++ b/attic/oofda/lib/string.fs @@ -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 diff --git a/attic/oofda/oofda.fs b/attic/oofda/oofda.fs new file mode 100644 index 0000000..f297a0a --- /dev/null +++ b/attic/oofda/oofda.fs @@ -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 diff --git a/attic/oofda/poke.fs b/attic/oofda/poke.fs new file mode 100644 index 0000000..8df2319 --- /dev/null +++ b/attic/oofda/poke.fs @@ -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 diff --git a/attic/oofda/run_tests.sh b/attic/oofda/run_tests.sh new file mode 100644 index 0000000..fda0974 --- /dev/null +++ b/attic/oofda/run_tests.sh @@ -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 diff --git a/attic/oofda/tests/test1.fs b/attic/oofda/tests/test1.fs new file mode 100644 index 0000000..31eaab2 --- /dev/null +++ b/attic/oofda/tests/test1.fs @@ -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 diff --git a/attic/oofda/tests/test2.fs b/attic/oofda/tests/test2.fs new file mode 100644 index 0000000..1bf83d5 --- /dev/null +++ b/attic/oofda/tests/test2.fs @@ -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 diff --git a/attic/oofda/tests/test3.fs b/attic/oofda/tests/test3.fs new file mode 100644 index 0000000..f40112e --- /dev/null +++ b/attic/oofda/tests/test3.fs @@ -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 diff --git a/attic/oofda/tests/test4.fs b/attic/oofda/tests/test4.fs new file mode 100644 index 0000000..f2319d2 --- /dev/null +++ b/attic/oofda/tests/test4.fs @@ -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 diff --git a/attic/oofda/tests/test5.fs b/attic/oofda/tests/test5.fs new file mode 100644 index 0000000..fbc5598 --- /dev/null +++ b/attic/oofda/tests/test5.fs @@ -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 diff --git a/attic/oofda/tests/test6.fs b/attic/oofda/tests/test6.fs new file mode 100644 index 0000000..fb8b5fc --- /dev/null +++ b/attic/oofda/tests/test6.fs @@ -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 diff --git a/attic/oofda/tests/test7.fs b/attic/oofda/tests/test7.fs new file mode 100644 index 0000000..8bafcbf --- /dev/null +++ b/attic/oofda/tests/test7.fs @@ -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