First commit

5 files changed, 329 insertions, 0 deletions

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 ∇