: REFACTOR TRIM BUILD ;


[The third in a series of posts on the evolution of TransForth]

Now that we have Forth hobbling along, we can start to peel away the scaffolding. Some of the things we’ve defined in F# can now be redefined in Forth instead. As we go along, I think you’ll be amazed by just how little it takes to bootstrap a Forth system. Also, with just a few more primitives we can really start to build things up.

 

Trimming Fat

 

To start with a silly one, we don’t strictly need to define subtraction:

 

dyadic (-) |> define “-“

 

In the last post we defined : NEGATE   -1 * ; and we can define subtraction as adding the negative : –   NEGATE + ;

 

We had also defined a bunch of stack manipulation primitives:

 

let stk fn () = stack <- fn stack

define “DUP” (stk (function x :: t -> x :: x :: t | _ -> underflow ()))

define “SWAP” (stk (function x :: y :: t -> y :: x :: t | _ -> underflow ()))

define “OVER” (stk (function (x :: y :: _ as t) -> y :: t | _ -> underflow ()))

define “ROT” (stk (function x::y::z::t -> z::x::y::t | _ -> underflow ()))

 

… but really these (and more) can all be defined in terms of PICK and ROLL:

 

: DUP    0 PICK ;

: OVER   1 PICK ;

: SWAP   1 ROLL ;

: ROT    2 ROLL ;

: 2DROP  DROP DROP ;

: 2DUP   OVER OVER ;

: 2OVER  3 PICK 3 PICK ;

: 3DUP   DUP 2OVER ROT ;

 

One NAND To Rule Them All

 

Just as NAND gates can serve as the basis for all other types of logic gates (so can NOR), we really only need one primitive to build up all the bitwise operators:

 

dyadic (fun a b -> ~~~(a &&& b)) |> define “NAND” // basis of NOT, OR, XOR, …

 

From this we can get:

 

: NOT  DUP NAND ;

: AND  NAND NOT ;

: OR   NOT SWAP NOT NAND ;

: NOR  OR NOT ;

: XOR  2DUP AND -ROT NOR NOR ;

: XNOR XOR NOT ;

 

Interesting also, is that Forth represents truth as -1 (all bits on – as opposed to using any ol’ non-zero), so the above also serve as logical operators.

 

Comparison Primitives

 

We have yet to build conditional operators (next post), but we can go ahead and define comparison:

 

let comp fn = dyadic (fun a b -> if fn a b then -1 else 0)

comp (>) |> define “>”

comp (=) |> define “=”

 

From this we can build more of the standard Forth words:

 

: <     2DUP > -ROT = OR NOT ;
: <=    2DUP < -ROT = OR ;
: >=    2DUP > -ROT = OR ;
: <>     = NOT ;

: 0>    0 > ;

: 0=    0 = ;

: 0<    0 < ;

: 0<>   0 <> ;

 

Comments

 

It’s been bugging me that we don’t have comment, so let’s throw that in too. They can be in the form ( this is a comment ) or can \ run to the end of the line

 

let comment term () = source <- Seq.skipWhile ((<>) term) source |> Seq.skip 1

comment ‘\n’ |> define “\\”; immediate ()

comment ‘)’ |> define “(“; immediate ()

 

Library

 

Here’s the latest library all together. A few other things have been added such as /MOD and a bunch of increment/decrement and shift words: 1+ 1- 2+ 2- 2* 2/. The reason for these simple words is not just to save typing a space. It’s because once we target real hardware they may be defined in terms of efficient machine-level instructions. For example 2* and 2/ really are bit shifts.

 

rep

: NEGATE   -1 * ; 

: SQUARE  ( a — a^2)  DUP * ;

: CUBE  ( a — a^3)  DUP DUP * * ;

: /MOD  ( a b — rem quot)  2DUP MOD -ROT / ;

 

: DUP  ( a — a a)  0 PICK ;

: OVER  ( a b — a b a)  1 PICK ;

: SWAP  ( a b — b a)  1 ROLL ;

: ROT  ( a b c — b c a)  2 ROLL ;

: -ROT  ( a b c — c a b)  ROT ROT ;

: NIP  ( a b — b)  SWAP DROP ;

: TUCK  ( a b — b a b)  SWAP OVER ;

 

: 2DROP  ( a b — )  DROP DROP ;

: 2DUP  ( a b — a b a b)  OVER OVER ;

: 2OVER  ( a b c d — a b c d a b)  3 PICK 3 PICK ;

: 3DUP  ( a b c — a b c a b c)  DUP 2OVER ROT ;

 

: –  ( a b — diff)  NEGATE + ;

 

: 1+ 1 + ;

: 1- 1 – ;

: 2+ 2 + ;

: 2- 2 – ;

: 2* 2 * ;

: 2/ 2 / ;

 

: TRUE  ( — t)  -1 ; \ normally constant

: FALSE  ( — f)  0 ; \ normally constant

: NOT  ( a — ~a)  DUP NAND ;

: AND  ( a b — a&b)  NAND NOT ;

: OR  ( a b — a|b)  NOT SWAP NOT NAND ;

: NOR  ( a b — ~a|b)  OR NOT ;

: XOR  ( a b — a^b)  2DUP AND -ROT NOR NOR ;

: XNOR ( a b — ~a^b)  XOR NOT ;

 

: <  ( a b — a<b)  2DUP > -ROT = OR NOT ;

: <= ( a b — a<=b) 2DUP < -ROT = OR ;

: >= ( a b — a>=b) 2DUP > -ROT = OR ;

: <>  ( a b — ?)  = NOT ;

: 0>   0 > ;

: 0=   0 = ;

: 0<   0 < ;

: 0<>   0 <> ;

 

New Tests

 

case “22 4 /MOD . .” “5 2 “ // quotient and remainder

case “7 \ comment\n 8 .S” “7 8 “ // comment skipped

case “7 ( comment ) 8 .S” “7 8 “ // comment skipped

case “1 2 3 2DROP .S” “1 “ // drop pair

case “1 2 3 2DUP .S” “1 2 3 2 3 “ // dup pair

case “1 2 3 4 2OVER .S” “1 2 3 4 1 2 “ // over pairs

case “1 2 3 3DUP .S” “1 2 3 1 2 3 “ // dup tripple

case “42 1+ .” “43 “ // increment

case “42 1- .” “41 “ // decrement

case “42 2+ .” “44 “ // double inc

case “42 2- .” “40 “ // double dec

case “42 2* .” “84 “ // left shift

case “42 2/ .” “21 “ // right shift

case “TRUE .” “-1 “ // true constant

case “FALSE .” “0 “ // false constant

case “0 0 NAND .” “-1 “ // nand

case “0 -1 NAND .” “-1 “ // nand

case “-1 0 NAND .” “-1 “ // nand

case “-1 -1 NAND .” “0 “ // nand

case “0 NOT .” “-1 “ // not

case “-1 NOT .” “0 “ // not

case “0 0 AND .” “0 “ // and

case “0 -1 AND .” “0 “ // and

case “-1 0 AND .” “0 “ // and

case “-1 -1 AND .” “-1 “ // and

case “0 0 OR .” “0 “ // or

case “0 -1 OR .” “-1 “ // or

case “-1 0 OR .” “-1 “ // or

case “-1 -1 OR .” “-1 “ // or

case “0 0 NOR .” “-1 “ // nor

case “0 -1 NOR .” “0 “ // nor

case “-1 0 NOR .” “0 “ // nor

case “-1 -1 NOR .” “0 “ // nor

case “0 0 XOR .” “0 “ // xor

case “0 -1 XOR .” “-1 “ // xor

case “-1 0 XOR .” “-1 “ // xor

case “-1 -1 XOR .” “0 “ // xor

case “0 0 XNOR .” “-1 “ // xnor

case “0 -1 XNOR .” “0 “ // xnor

case “-1 0 XNOR .” “0 “ // xnor

case “-1 -1 XNOR .” “-1 “ // xnor

case “42 6 > .” “-1 “ // greater

case “6 42 > .” “0 “ // greater

case “6 6 > .” “0 “ // greater

case “-1 0> .” “0 “ // greater than zero

case “0 0> .” “0 “ // greater than zero

case “1 0> .” “-1 “ // greater than zero

case “6 42 = .” “0 “ // equal

case “6 6 = .” “-1 “ // equal

case “42 6 < .” “0 “ // less

case “6 42 < .” “-1 “ // less

case “6 6 < .” “0 “ // less

case “42 6 <= .” “0 “ // less or equal

case “6 42 <= .” “-1 “ // less or equal

case “6 6 <= .” “-1 “ // less or equal

case “42 6 <> .” “-1 “ // not equal

case “6 42 <> .” “-1 “ // not equal

case “6 6 <> .” “0 “ // not equal

case “-1 0> .” “0 “ // greater than zero

case “0 0> .” “0 “ // greater than zero

case “1 0> .” “-1 “ // greater than zero

case “42 0= .” “0 “ // equal to zero

case “0 0= .” “-1 “ // equal to zero

case “-1 0< .” “-1 “ // less than zero

case “0 0< .” “0 “ // less than zero

case “1 0< .” “0 “ // less than zero

case “0 0<> .” “0 “ // not equal to zero

case “42 0<> .” “-1 “ // not equal to zero

 

Next>

Comments (2)

  1. Anonymous says:

    Hi Ashley,

    I've translated the F# code to Python because I don't F# well, and all seems to work quiet fine here (modulo the end of line comments, it's because of the way I'm lexing the input) .

    I also wanted to give F# a try, because I found it very readable and powerful, but failed to compile the first given script. Here's what I've got from F# Interactive:

     define "WORDS" (fun () -> List.iter (fun w -> print w.Name) dict)

     —————————————————-^^^^^^

    stdin(148,53): error FS0072: Lookup on object of indeterminate type based on inf

    ormation prior to this program point. A type annotation may be needed prior to t

    his program point to constrain the type of the object. This may allow the lookup

    to be resolved.

    Seems like F# needs more infos on type. Any idea on how to fix it ?

    Thanks a lot; I just hope you'll end up the series as you told it: by writting a Lisp with it :).

  2. @kib2, Not everything on the blog will necessarily work without the surrounding context (for type inference to make sense of everything). All of the code, in a complete working form, is available at my github: github.com/…/TransForth Also, when I originally made these posts I checked into CodePlex which might be useful to see the intermediate check-ins corresponding to each post (though I'm working out of Github these days): http://transforth.codeplex.com

    Hope that helps. Have fun!