From 47ab3e9e83210929097ed400ff29be40895fa586 Mon Sep 17 00:00:00 2001 From: nratan Date: Sun, 3 Nov 2019 18:39:09 +0000 Subject: First commit --- examples/combinators.f | 144 ++++++++++++++++++++++++++++++++++++++++++++++ examples/continuations.f | 98 +++++++++++++++++++++++++++++++ examples/defining_words.f | 37 ++++++++++++ examples/exceptions.f | 11 ++++ examples/sockets.f | 39 +++++++++++++ 5 files changed, 329 insertions(+) create mode 100644 examples/combinators.f create mode 100644 examples/continuations.f create mode 100644 examples/defining_words.f create mode 100644 examples/exceptions.f create mode 100644 examples/sockets.f (limited to 'examples') diff --git a/examples/combinators.f b/examples/combinators.f new file mode 100644 index 0000000..21f75e8 --- /dev/null +++ b/examples/combinators.f @@ -0,0 +1,144 @@ +/ Combinators / +/ Following Brent Kerby's 'The Theory of Concatenative Combinators' (TCC) / + +/ Everything below doubles 3 / + +3 ↑ + / Double 3 / + +3 ⊂ ↑ + ⊃ ⍎ / Push execution token to stack, execute it / + +3 ⊂ ↑ + ⊃ unit ⍎ ⍎ / Push execution token, wrap with unit, unwrap with ⍎, execute with ⍎ / + +3 ⊂ ↑ ⊃ ⊂ + ⊃ cat ⍎ / Push separate execution tokens for ↑ and +, combine with cat, execute with ⍎ / + +3 ⊂ + ⊃ ⊂ ↑ ⊃ ↕ cat ⍎ / Push executions for + and ↑, swap order with ↕, combine with cat, execute / + +/ The examples above illustrate the definitions of the combinators / +/ The combinators also satisfy some interesting identities / +/ For example + + unit ≡ ⊂⊃ cons + +so this also doubles 3: / + +3 ⊂ ↑ + ⊃ ⊂⊃ cons ⍎ ⍎ + +/ We can define a unit' which does this: / + +∇ unit' ⊂⊃ cons ∇ + +3 ⊂ ↑ + ⊃ unit' ⍎ ⍎ + +/ The following also doubles three: / + +3 ⊂ ↑ ⊃ ⊂ + ⊃ ⊂ ⍎ ⊃ ⊂ dip ⍎ ⊃ cons cons cons ⍎ + +/ This is because of the identity + + cat ≡ ⊂ ⍎ ⊃ ⊂ dip ⍎ ⊃ cons cons cons + +We can define a new cat' which does this: +/ + +⊂ dip ⍎ ⊃ ⊂ ⍎ ⊃ ∇ cat' LITERAL LITERAL cons cons cons ∇ + +/ The LITERALs just compile the execution tokens in the definition of cat' / + +3 ⊂ ↑ ⊃ ⊂ + ⊃ cat' ⍎ + +/ Also cons can be written in terms of cat, + + cons ≡ ⊂ unit ⊃ dip cat + +giving / + +⊂ unit ⊃ ∇ cons' LITERAL dip cat ∇ + +3 ⊂ ↑ + ⊃ ⊂⊃ cons' ⍎ ⍎ + +/ swap ≡ unit dip / + +∇ swap' unit dip ∇ + +3 ⊂ + ⊃ ⊂ ↑ ⊃ swap' cat ⍎ + +∇ dip' ↕ unit cat ⍎ ∇ + +3 ⊂ + ⊃ ⊂ ↑ ⊃ unit dip' cat ⍎ + +/ ⍎ ≡ ↑ dip ↓ / ∇ ⍎' ↑ dip ↓ ∇ +/ ⍎ ≡ ⊂⊃ unit dip dip ↓ / ∇ ⍎'' ⊂⊃ unit dip dip ↓ ∇ +/ ⍎ ≡ ⊂⊃ unit dip dip dip / ∇ ⍎''' ⊂⊃ unit dip dip dip ∇ + +3 ⊂ ↑ + ⊃ ⍎' + +3 ⊂ ↑ + ⊃ ⍎'' + +3 ⊂ ↑ + ⊃ ⍎''' + +/ Lambdas / +/ λ (written \ in TCC) can be implemented as a Forth defining word / + +∇ λ ◁ , ▷ @ ⍎ ∇ + +/ dip ≡ λ a λ b a ⊂ b ⊃ / + +3 ⊂ + ⊃ ⊂ ↑ ⊃ unit λ a λ b a ⊂ b ⊃ cat ⍎ + +/ End of scope ($ in TCC) can be done with HIDE a / + +∇ $ HIDE ∇ + +/ An Abstraction Algorithm / +/ TCC gives an algorithm to eliminate λ's from combinators. Applying it / +/ gives the equivalence of / + +/ λ a b a ⊂ c a ⊃ ≡ ⊂ b ⊃ dip ↑ ⊂ ⍎ ⊃ dip ⊂ c ⊃ ⊂ dip ⍎ ⊃ cons cons / +/ ( lambda ) ( no lambda ) / + +/ For example, letting b be ↑ and c be + and trying each of the above / +/ combinators on a stack with 2 ⊂ 1+ ⊃ on ( adding an ⍎ at the end of / +/ both to test the effect of the ⊂ c a ⊃ left on top of the stack) / + +⊂ ↑ ⊃ ⊂ + ⊃ λ c λ b + 2 ⊂ 1+ ⊃ λ a b a ⊂ c a ⊃ ⍎ + 2 ⊂ 1+ ⊃ ⊂ b ⊃ dip ↑ ⊂ ⍎ ⊃ dip ⊂ c ⊃ ⊂ dip ⍎ ⊃ cons cons ⍎ + +/ Both give 6 since in this case both lines are equivalent to 2 ↑ 1+ + 1+ / + +/ The sip Combinator / +/ ⊂ b ⊃ ⊂ a ⊃ sip ≡ ⊂ b ⊃ a ⊂ b ⊃ / + +/ ↑ ≡ ⊂⊃ sip / +3 ⊂⊃ sip + + +/ dip ≡ λ a ⊂ ↓ a ⊃ sip / +3 ⊂ + ⊃ ⊂ ↑ ⊃ unit λ a ⊂ ↓ a ⊃ sip cat ⍎ + +/ dip ≡ ⊂ ↓ ↓ ⊃ ⊂ sip ⍎ ⊃ cons cons sip / +3 ⊂ + ⊃ ⊂ ↑ ⊃ unit ⊂ ↓ ↓ ⊃ ⊂ sip ⍎ ⊃ cons cons sip cat ⍎ + +/ Applicative Combinators / + +∇ w ['] ↑ dip ⍎ ∇ +∇ k ['] ↓ dip ⍎ ∇ +∇ b ['] cons dip ⍎ ∇ +∇ c ['] ↕ dip ⍎ ∇ + +∇ s >R ⊤ ↕ cons ↕ R> ⍎ ∇ + +/ ↑ ≡ ⊂⊃ w / +/ ↓ ≡ ⊂⊃ k / +/ cons ≡ ⊂⊃ b / +/ ↕ ≡ ⊂⊃ c / + +3 ⊂⊃ w + +3 ↑ ↑ ⊂⊃ k + +3 ⊂ ↑ + ⊃ ⊂⊃ ⊂⊃ b ⍎ ⍎ +3 ⊂ + ⊃ ⊂ ↑ ⊃ ⊂⊃ c cat ⍎ + +/ b ≡ ⊂ k ⊃ ⊂ s ⊃ ⊂ k ⊃ cons s / + +⊂ k ⊃ ⊂ s ⊃ ⊂ k ⊃ ∇ b' LITERAL LITERAL LITERAL cons s ∇ + +3 ⊂ ↑ + ⊃ ⊂⊃ ⊂⊃ b' ⍎ ⍎ diff --git a/examples/continuations.f b/examples/continuations.f new file mode 100644 index 0000000..1ea66bf --- /dev/null +++ b/examples/continuations.f @@ -0,0 +1,98 @@ +/ Delimited continuations / +/ +When THROWing an exception we unwind the return stack and ignore all the return +addresses until the marker left by CATCH. But we can instead compile them into a +word which when run will push them onto the return stack - and so do the work we +have skipped by THROWing the exception. This word is called a delimited +continuation. We can leave its execution token on top of the data stack. + +The following four lines all calculate the same thing: +/ + +1 2 3 4 × + - / Initial calculation / + +1 2 3 4 ⊂ × + - ⊃ ⍎ / Push an execution token for the whole calculation and execute it / + +1 2 3 4 ⊂ × ⟦ + - ⊃ ⟧ ⍎ / Do the ×, push an execution token for the + -, execute it / + +1 2 3 4 ⊂ × + ⟦ - ⊃ ⟧ ⍎ / Do the × +, push an execution token for the -, execute it / + +/ +The continuation works even if the [[ is further down +the return stack, e.g. +/ + +∇ new+ + ⟦ 42 EMIT ∇ / Word containing ⟦ / + +1 2 3 4 ⊂ × new+ - ⊃ ⟧ / Do the × and new+ up to ⟦ (so just the +), push xt for rest of work / +⍎ / Execute rest of work, i.e. do rest of new+ (prints B) and the - / + +/ +The continuation is just like any execution token; in particular it can be +manipulated with combinators. For example to execute it twice we can use ↑ cat +/ + +1 2 3 4 5 × + - - / Initial calculation / + +1 2 3 4 5 ⊂ × + ⟦ - ⊃ ⟧ ↑ cat ⍎ / Capture - in continuation, make execution token to do it twice, execute it / + +1 2 3 4 5 ⊂ × new+ - ⊃ ⟧ ↑ cat ⍎ / Prints B twice since continuation executed twice / + + + +/ +Below are some examples illustrating how to execute Forth words by pushing their +corresponding return addresses to the return stack. They're probably unnecessary +but they are the experiments I did before writing [[ and ]] so I have left them +in in case they help anyone else. +/ + +∇ α ↑ ∇ / Example Forth words / +∇ β × ∇ + +3 α β / α β is just ↑ ×, squares 3 / + +∇ ρ find >CFA 8+ ∇ / ρ gets return stack address corresponding to a word / + +ρ α CONST rα / Return stack addresses of α and β / +ρ β CONST rβ + +∇ ψ rβ >R rα >R ∇ / ψ pushes addresses rβ and rα onto return stack / + +3 ψ / ψ does the same thing as α β / + +/ +We can execute a Forth word by directly pushing the corresponding return stack +address onto the return stack. + +We can even jump inside words by adding an offset to their return address. +/ + +∇ γ 8+ NEG ∇ +ρ γ 8+ CONST rγ+ + +∇ ω rγ+ >R ∇ + +3 γ / Gives 3 8+ NEG / +3 ω / Gives 3 NEG / + +/ +If all the addresses are the first in Forth words it is simpler to let DOCOL do +the work. +/ + +rβ 8- rα 8- ∇ ψ' [ , , ] ∇ + +3 ψ' / ψ' does the same thing as ψ / + +/ +This doesn't work trying to jump into a word since in this case there is no +DOCOL 8 bytes before the return address, e.g. +/ + +rγ+ 8- ∇ ω' [ , ] ∇ / ω' doesn't work! / + +∇ ψω rγ+ >R rβ >R rα >R ∇ + +3 ψω / Gives 3 ↑ × NEG / + diff --git a/examples/defining_words.f b/examples/defining_words.f new file mode 100644 index 0000000..f871a58 --- /dev/null +++ b/examples/defining_words.f @@ -0,0 +1,37 @@ +/ Defining words examples / + +∇ VECTOR ◁ CELLS ALLOT ▷ ↕ CELLS + ∇ + +/ +When a vector β is being defined as 'N VECTOR β' all that happens is N cells +are allotted to store its elements. +When it is used as 'i β' it returns the address of its ith element. +/ + +2 VECTOR β / Define a length 2 vector β / + +6 0 β ! / β ≡ 6 7 / +7 1 β ! + +0 β ? CR / Check the elements of β / +1 β ? CR + +∇ ARRAY ◁ ⊤ , × CELLS ALLOT ▷ ↑ @ ⌽ × CELLS + ↕ CELLS + 8+ ∇ + +/ +When an array is being defined as 'N M ARRAY μ' the value of N is stored in the +header and N×M cells are allotted for its elements. +When it is used as 'i j μ' it returns the address of its (i,j) element. +/ + +2 2 ARRAY μ / Define a 2×2 array μ / + +6 0 0 μ ! / μ ≡ 6 7 / +7 0 1 μ ! / 8 9 / +8 1 0 μ ! +9 1 1 μ ! + +0 0 μ ? CR / Check the elements of μ / +0 1 μ ? CR +1 0 μ ? CR +1 1 μ ? CR diff --git a/examples/exceptions.f b/examples/exceptions.f new file mode 100644 index 0000000..3e51316 --- /dev/null +++ b/examples/exceptions.f @@ -0,0 +1,11 @@ +/ Exceptions examples / + +∇ SHOW .S CR CLEAR ∇ / Print then clear stack / + +1 2 ⊂ + ⊃ ⍎ / Just runs + / SHOW + +1 2 ⊂ + 0 THROW ⊃ CATCH / Runs +, no exception thrown → 0 pushed to stack / SHOW + +1 2 ⊂ + ABORT ⊃ CATCH / Exception -1 thrown → Stack rewound, -1 pushed to stack / SHOW + +1 2 ⊂ + ABORT ⊃ ⍎ / Uncaught exception / diff --git a/examples/sockets.f b/examples/sockets.f new file mode 100644 index 0000000..55611db --- /dev/null +++ b/examples/sockets.f @@ -0,0 +1,39 @@ +/ Socket syscalls examples / +/ Based on Beej's Guide to Network Programming / + +/ Socket syscalls / +∇ SOCKET C6 3 SYS ∇ ∇ TSOC 0 1 2 SOCKET ∇ +∇ LISTEN C9 2 SYS ∇ ∇ LIS 0 ↕ LISTEN ↓ ∇ +∇ BIND C8 3 SYS ∇ ∇ BIN 10 ↕ ⌽ BIND ↓ ∇ +∇ CONNECT CB 3 SYS ∇ ∇ CON 10 ↕ ⌽ CONNECT ↓ ∇ +∇ ACCEPT CA 3 SYS ∇ ∇ ACC 0 0 ⌽ ACCEPT ∇ + +/ PORT builds port struct / +/ e.g. FA0 PORT leaves port struct for port 4000 on the stack / +∇ PORT 10⌽ 10 << 2 + ∇ / n→n / + +/ TCP client and server / +/ Try running in separate JonesForth processes as e.g. FA0 PORT SERVER and FA0 PORT CLIENT / + +∇ SERVER / n→ / + H ! TSOC ↑ ↑ H BIN LIS + ( ↑ ACC S" Weasel attack!" ↕ ⌽ ⍈ ." Accepted" CR ∥) ∇ + +∇ CLIENT / n→ / + H ! TSOC ↑ H CON + 10 H ⌽ ⍇ H ↕ TELL ∇ + +/ UDP talker and listener / +∇ USOC 0 2 2 SOCKET ∇ +∇ SENDTO CE 6 SYS ∇ +∇ RECVFROM CF 6 SYS ∇ +VAR &10 +10 &10 ! + +∇ LISTENER +H ! USOC ↑ H BIN +>R &10 H 0 10 H 20 + R> RECVFROM +H 20 + ↕ TELL ∇ + +∇ TALKER +H ! USOC >R 10 H 0 S" Weasel" ↕ R> SENDTO ∇ -- cgit 1.4.1-2-gfad0