Re: Factor

Migrating...

2023-04-27T14:28:00.001-07:00

I am migrating this blog to a new site available on the domain re.factorcode.org.

While I do joke a lot about all of the Killed by Google apps, products, and features... it seems inevitable that at some point Google will kill the Blogger product and I wanted more control of this website.

For anyone curious, the new Re: Factor is built currently on Hugo the "world’s fastest framework for building websites" and water.css semantic CSS framework. It is a lot simpler to use than the Blogger interface, plus a bit faster since it's just a simple static website.

This blog will remain as a historical archive, but new posts will be on the new website...

OpenAI

2023-04-25T20:51:00.002-07:00

It’s been pretty hard to avoid all of the incredible stories about artificial intelligence over the past few months. There seem to be incredible applications to the area of generative AI occurring on a daily basis. Image generation with Midjourney is pretty next-level. Code generation using GitHub Copilot seems pretty amazing. Interacting with large language models like GPT-4 or Bard or Bing Chat or Facebook LLaMA or StableLM and so many others seems like science fiction. Audio models like Whisper used for audio transcription even make popular audio assistants look pretty dated.

With all of the hype, it seemed inevitable that Factor would gain some kind of AI functionality.

Despite the non-profit vs for-profit controversy of OpenAI, they do seem to have a momentary lead in the race to make tools that others can build upon. One of those tools is the OpenAI API, which is made available using JSON and HTTP. Besides the OpenAI API Reference, there is an OpenAI Cookbook and popular libraries such as OpenAI Python for building systems using it.

Recently, I contributed the openai vocabulary which allows using all the methods currently made available by OpenAI. You will need an OpenAI API Key.

Once you obtain that, you can set it in the listener.

IN: scratchpad USE: openai

IN: scratchpad "sk-....................." openai-api-key set-global

And now you have enough to try it out…

IN: scratchpad "text-davinci-003"
               "what is the factor programming language"
               <completion> 100 >>max_tokens create-completion
               "choices" of first "text" of print

Factor is a stack-oriented programming language, designed for creating
flexible, reusable software components. It combines elements from both
object-oriented and functional programming, and provides powerful features,
including static typing and static type checking, an interactive program
development environment, built-in automated testing, and a wide range of
built-in data types. The language is designed to be easy to use, yet provide
a high degree of flexibility.

Cool!

We even have a Discord bot using OpenAI that answers on the Factor Discord server.

ASCII Table PDF

2023-03-07T16:58:00.003-08:00

Vasudev Ram has a blog with many different posts about various programming topics including Python, Linux, SQL, and PDFs. On the topic of PDF generation, they have a blog post about making an ASCII Table to PDF with xtopdf.

Recently, I had the need for an ASCII table lookup, which I searched for and found, thanks to the folks here:

www.ascii-code.com

That gave me the idea of writing a simple program to generate an ASCII table in PDF. Here is the code for a part of that table - the first 32 (0 to 31) ASCII characters, which are the control characters:

It might not be widely known, but Factor has built-in support for writing to PDF Streams using the formatted output protocol. This supports text styles including changing font names, bold and italic styles, foreground and background colors, etc.

We start by defining the symbols and descriptions of the first 32 ASCII characters. These are all non-printable control character, which is why we use this array of strings to render them in a table.

CONSTANT: ASCII {
    "NUL Null char"
    "SOH Start of Heading"
    "STX Start of Text"
    "ETX End of Text"
    "EOT End of Transmission"
    "ENQ Enquiry"
    "ACK Acknowledgment"
    "BEL Bell"
    "BS Back Space"
    "HT Horizontal Tab"
    "LF Line Feed"
    "VT Vertical Tab"
    "FF Form Feed"
    "CR Carriage Return"
    "SO Shift Out / X-On"
    "SI Shift In / X-Off"
    "DLE Data Line Escape"
    "DC1 Device Control 1 (oft. XON)"
    "DC2 Device Control 2"
    "DC3 Device Control 3 (oft. XOFF)"
    "DC4 Device Control 4"
    "NAK Negative Acknowledgement"
    "SYN Synchronous Idle"
    "ETB End of Transmit Block"
    "CAN Cancel"
    "EM End of Medium"
    "SUB Substitute"
    "ESC Escape"
    "FS File Separator"
    "GS Group Separator"
    "RS Record Separator"
    "US Unit Separator"
}

The core printing logic is a header, followed by rows for each character, formatted into a table of decimal, octal, hexadecimal, and binary values along with their symbol and description from the array above:

: ascii. ( -- )
    "ASCII Control Characters - 0 to 31" print nl
    ASCII [
        1 + swap [
            {
                [ >dec ]
                [ >oct 3 CHAR: 0 pad-head ]
                [ >hex 2 CHAR: 0 pad-head ]
                [ >bin 8 CHAR: 0 pad-head ]
            } cleave
        ] dip " " split1 6 narray
    ] map-index {
        "DEC" "OCT" "HEX" "BIN" "Symbol" "Description"
    } prefix format-table unclip
    H{ { font-style bold } } format nl
    [ print ] each ;

Since the UI listener supports formatted streams, you can see it from the listener:

Outputting this to a PDF file is now easy. We make sure to set the font to monospace and then run ascii. with our PDF writer, saving the generated PDF output into a file.

: ascii-pdf ( path -- )
    [
        H{ { font-name "monospace" } } [ ascii. ] with-style
    ] with-pdf-writer pdf>string swap utf8 set-file-contents ;

We also support writing to HTML streams in a similar manner, so it would be pretty easy to create an ascii-html word to output an HTML file with the same printing logic above but instead using our HTML writer.

Short UUID

2023-03-03T15:14:00.002-08:00

The shortuuid project is a “simple python library that generates concise, unambiguous, URL-safe UUIDs”. I thought it would be a fun exercise to implement this in Factor.

What is a “short UUID”?

You can read the original announcement, but basically it is a string representation of a number using a reduced alphabet that can be used in places like URLs where conciseness is desirable. The author mentions that it provides security by “not divulging information (such as how many rows there are in that particular table, the time difference between one item and the next, etc.)”. However, I think it is more security through obscurity than real security.

In any event, the alphabet used are these 57 characters:

CONSTANT: alphabet
"23456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"

We encode a numeric input by repeatedly “divmod”, indexing into an alphabet, until exhausted.

: encode-uuid ( uuid -- shortuuid )
    [ dup 0 > ] [
        alphabet [ length /mod ] [ nth ] bi
    ] "" produce-as nip reverse ;

We decode using a reverse process, looking up the position of each character in the alphabet, re-assembling the numeric input for each character in the shortuuid.

: decode-uuid ( shortuuid -- uuid )
    0 [
        alphabet index [ alphabet length * ] dip +
    ] reduce ;

This is available on my GitHub, including features to deal with legacy values generated before version 1.0.0 as well as supporting different alphabets being used.

Geo Timezones

2023-03-01T09:43:00.004-08:00

Brad Fitzpatrick wrote a Go package called latlong which efficiently maps a latitude/longitude to a timezone. The original post describing it was on Google+ and is likely lost forever — unless it made it into the Google+ archive before Google+ joined the Google Graveyard.

It tries to have a small binary size (~360 KB), low memory footprint (~1 MB), and incredibly fast lookups (~0.5 microseconds). It does not try to be perfectly accurate when very close to borders.

It’s available in other languages, too!

Huon Wilson ported the library to the Rust Programming Language, making the code available on GitHub and installable via Cargo. There is even a wrapper made for NodeJs that is installable via NPM that uses a command-line executable written in Go.

When it was announced in 2015, I had ported the library to Factor, but missed the opportunity to blog about it. Below we discuss some details about the implementation, starting with its use of a shapefile of the TZ timezones of the world to divide the world into zones that are assigned timezone values — looking something like this:

The world is divided into 6 zoom levels of tiles (represented by a key and an index value) that allow us to search from a very large area first, then down to the more specific geographic area. Note: we represent the struct as a big endian struct with structure packing to minimize wasted space in the files.

The zoom levels are then cached using literal syntax into a zoom-levels constant.

BE-PACKED-STRUCT: tile
    { key uint }
    { idx ushort } ;

SPECIALIZED-ARRAY: tile

CONSTANT: zoom-levels $[
    6 <iota> [
        number>string
        "vocab:geo-tz/zoom" ".dat" surround
        binary file-contents tile cast-array
    ] map
]

Each of the zoom levels reference indexes into a leaves data structure that contains 14,110 items — each represented by one of three data types:

Type S is a string.
Type 2 is a one bit tile.
Type P is a pixmap thats 128 bytes long.

These we load and cache into a unique-leaves constant.

CONSTANT: #leaves 14110

BE-PACKED-STRUCT: one-bit-tile
    { idx0 ushort }
    { idx1 ushort }
    { bits ulonglong } ;

CONSTANT: unique-leaves $[
    "vocab:geo-tz/leaves.dat" binary [
        #leaves [
            read1 {
                { CHAR: S [ { 0 } read-until drop utf8 decode ] }
                { CHAR: 2 [ one-bit-tile read-struct ] }
                { CHAR: P [ 128 read ] }
            } case
        ] replicate
    ] with-file-reader
]

The core logic involves looking up a leaf (which is one of three types, loaded above), given an (x, y) coordinate. If it is a string type, we are done. If it is a one-bit-tile, we defer to the appropriate leaf specified by idx0 or idx1. And if it is pixmap, we have a smidge more logic to detect oceans or defer again to a different leaf.

CONSTANT: ocean-index 0xffff

GENERIC#: lookup-leaf 2 ( leaf x y -- zone/f )

M: string lookup-leaf 2drop ;

M:: one-bit-tile lookup-leaf ( leaf x y -- zone/f )
    leaf bits>> y 3 bits 3 shift x 3 bits bitor bit?
    [ leaf idx1>> ] [ leaf idx0>> ] if
    unique-leaves nth x y lookup-leaf ;

M:: byte-array lookup-leaf ( leaf x y -- zone/f )
    y 3 bits 3 shift x 3 bits bitor 2 * :> i
    i leaf nth 8 shift i 1 + leaf nth +
    dup ocean-index = [ drop f ] [
        unique-leaves nth x y lookup-leaf
    ] if ;

We’re almost done! Given a zoom level, a tile-key helps us find a specific tile that we then can lookup the leaf for, hopefully finding the timezone associated with the coordinate.

:: lookup-zoom-level ( zoom-level x y tile-key -- zone/f )
    zoom-level [ key>> tile-key >=< ] search swap [
        dup key>> tile-key = [
            idx>> unique-leaves nth x y lookup-leaf
        ] [ drop f ] if
    ] [ drop f ] if ;

Each coordinate is effectively a pixel in the image, so our logic searches from the outermost zoom level to the innermost, trying to lookup a timezone in each one using the coordinate and level as a tile-key.

:: tile-key ( x y level -- tile-key )
    level dup 3 + neg :> n
    y x [ n shift 14 bits ] bi@
    { 0 14 28 } bitfield ;

:: lookup-pixel ( x y -- zone )
    6 <iota> [| level |
        level zoom-levels nth
        x y 2dup level tile-key
        lookup-zoom-level
    ] map-find-last drop ;

Finally, we have enough to implement our public API, converting a given latitude/longitude coordinate to a pixel value, deferring to the word we just defined above.

CONSTANT: deg-pixels 32

:: lookup-zone ( lat lon -- zone )
    lon 180 + deg-pixels * 0 360 deg-pixels * 1 - clamp
    90 lat - deg-pixels * 0 180 deg-pixels * 1 - clamp
    [ >integer ] bi@ lookup-pixel ;

And then a couple of test cases to show it’s working:

{ "America/Los_Angeles" } [ 37.7833 -122.4167 lookup-zone ] unit-test

{ "Australia/Sydney" } [ -33.8885 151.1908 lookup-zone ] unit-test

Performance is pretty good, we can generate over 3 million lookups per second, putting our cost per lookup around 0.33 microseconds. And all of that in less than 70 lines of code.

This is available on my GitHub.

Reference Server

2023-02-28T07:28:00.002-08:00

Phil Eaton made a repository of Barebones UNIX socket servers with this description:

I find myself writing this server in some language every few months. Each time I have to scour the web for a good reference. Use this as a reference to write your own bare server in C or other languages with a UNIX API (Python, OCaml, etc).

Many developers learning network programming will encounter Beej's Guide to Network Programming which uses the sockets API, has been ported to many platforms, and explains the intricacies of making computers talk to each other in this manner.

C

We can take a look at his C implementation of a server that listens on port 15000, accepts client connections, reads up to 1024 bytes which are printed to the screen, then writes hello world back to the client and disconnects them:

#include <netinet/in.h>
#include <stdio.h>
#include <stdlib.h>
#include <sys/socket.h>
#include <unistd.h>

int main() {
    int server, client;
    socklen_t addrlen;

    int bufsize = 1024;
    char *buffer = malloc(bufsize);
    struct sockaddr_in address;

    server = socket(AF_INET, SOCK_STREAM, 0);

    address.sin_family = AF_INET;
    address.sin_addr.s_addr = INADDR_ANY;
    address.sin_port = htons(15000);

    bind(server, (struct sockaddr *) &address, sizeof(address));

    while (1) {
        listen(server, 10);
        client = accept(server, (struct sockaddr *) &address, &addrlen);
        recv(client, buffer, bufsize, 0);
        printf("%s\n", buffer);
        write(client, "hello world\n", 12);
        close(client);
    }

    close(server);
    return 0;
}

Factor

A direct Factor translation — without any error checking, like in the original example — using the C library interface might look something like this:

USING: accessors alien.c-types alien.data byte-arrays
classes.struct io io.encodings.string io.encodings.utf8 kernel
sequences unix.ffi unix.types ;

:: reference-server ( -- )
    1024 <byte-array> :> buffer
    AF_INET SOCK_STREAM 0 socket :> server
    sockaddr-in malloc-struct
        AF_INET >>family
        0 >>addr
        15000 htons >>port :> address

    server address sockaddr-in heap-size bind drop

    [
        server 10 listen drop
        server address 0 socklen_t <ref> accept :> client
        client buffer 1024 0 recv
        buffer swap head-slice utf8 decode print flush
        client $[ "hello world\n" >byte-array ]
        dup length unix.ffi:write drop
        client close drop
        t
    ] loop

    server close drop ;

I noticed that some of his examples are more idiomatic to the language, so we could rewrite this using threaded servers — gaining the benefit of working on Windows as well as error handling and logging — using a handler quotation to implement the read/print/write/disconnect logic.

USING: accessors io io.encodings.binary io.encodings.string
io.encodings.utf8 io.servers kernel namespaces ;

: reference-server ( -- )
    binary <threaded-server>
        15000 >>insecure
        [
            1024 read-partial [
                [ utf8 decode print flush ] with-global
                $[ "hello world\n" >byte-array ] io:write flush
            ] when*
        ] >>handler
    start-server wait-for-server ;

This is available on my GitHub.

Weighted Random

2023-02-26T14:38:00.005-08:00

Some time ago, I implemented a way to generate weighted random values from a discrete distribution in Factor. It ended up being a pretty satisfyingly simple word that builds a cumulative probability table, generates a random probability, then searches the table to find which value to return:

: weighted-random ( histogram -- obj )
    unzip cum-sum [ last >float random ] keep bisect-left swap nth ;

Is It Fast?

We can define a simple discrete distribution of values:

CONSTANT: dist H{ { "A" 1 } { "B" 2 } { "C" 3 } { "D" 4 } }

And it seems to work — we can make a few random values from it:

IN: scratchpad dist weighted-random .
"C"
IN: scratchpad dist weighted-random .
"C"
IN: scratchpad dist weighted-random .
"D"
IN: scratchpad dist weighted-random .
"B"

After generating a lot of random values, we can see the histogram matches our distribution:

IN: scratchpad 10,000,000 [ dist weighted-random ] replicate histogram .
H{
    { "A" 998403 }
    { "B" 2000400 }
    { "C" 3001528 }
    { "D" 3999669 }
}

But, how fast is it?

IN: scratchpad [ 10,000,000 [ dist weighted-random ] replicate ] time 
Running time: 3.02998325 seconds

Okay, so it's not that fast... generating around 3.3 million per second on one of my computers.

Improvements

We can make two quick improvements to this:

First, we can factor out the initial step from the random number generation.
Second, we can take advantage of a recent improvement to the random vocabulary, mainly to change the random word that was previously implemented for different types to instead get the current random-generator and then pass it to the random* implementation instead. This allows a few speedups where we can lookup the dynamic variable once and then use it many times.

That results in this definition:

: weighted-randoms ( length histogram -- seq )
    unzip cum-sum swap
    [ [ last >float random-generator get ] keep ] dip
    '[ _ _ random* _ bisect-left _ nth ] replicate ;

That gives us a nice speedup, just over 10 million per second:

IN: scratchpad [ 10,000,000 dist weighted-randoms ] time histogram .
Running time: 0.989039625 seconds

H{
    { "A" 1000088 }
    { "B" 1999445 }
    { "C" 3000688 }
    { "D" 3999779 }
}

That's pretty nice, but it turns out that we can do better.

Vose Alias Method

Keith Schwarz wrote a fascinating blog post about some better algorithms for sampling from a discrete distribution. One of those algorithms is the Vose Alias Method which creates a data structure of items, probabilities, and an alias table that is used to return an alternate choice:

TUPLE: vose
    { n integer }
    { items array }
    { probs array }
    { alias array } ;

We construct a vose tuple by splitting the distribution into items and their probabilities, and then processing the probabilities into lists of small (less than 1) or large (greater than or equal to 1), iteratively aliasing the index of smaller items to larger items.

:: <vose> ( dist -- vose )
    V{ } clone :> small
    V{ } clone :> large
    dist assoc-size :> n
    n f <array> :> alias

    dist unzip dup [ length ] [ sum ] bi / v*n :> ( items probs )
    probs [ swap 1 < small large ? push ] each-index

    [ small empty? not large empty? not and ] [
        small pop :> s
        large pop :> l
        l s alias set-nth
        l dup probs [ s probs nth + 1 - dup ] change-nth
        1 < small large ? push
    ] while

    1 large [ probs set-nth ] with each
    1 small [ probs set-nth ] with each

    n items probs alias vose boa ;

We can implement the random* generic to select a random item from the vose tuple — choosing a random item index, check it's probability against a random number between 0.0 and 1.0, and if it is over a threshold we return the aliased item instead:

M:: vose random* ( obj rnd -- elt )
    obj n>> rnd random*
    dup obj probs>> nth rnd (random-unit) >=
    [ obj alias>> nth ] unless
    obj items>> nth ;

It's much faster, over 14.4 million per second:

IN: scratchpad [ 10,000,000 dist <vose> randoms ] time 
Running time: 0.693588458 seconds

This is available now in the math.extras vocabulary in the current development version, along with a few tweaks that brings the performance over 21.7 million per second...

DuckDuckGo

2023-02-15T09:18:00.000-08:00

The conversation around the current quality of web search engines, the doomsday prediction about various incumbents, and the equal parts inspiring and challenging rollout of large language models to improve search has been fascinating to watch. There are many challengers in the search engine space including companies like Kagi and Neeva among many search engine startups. One privacy-focused startup that has been fun to follow for awhile has been DuckDuckGo.

You can see an example of the DuckDuckGo API that is available on api.duckduckgo.com. This does not provide access to their full search results, but instead provides access to their instant answers. Regardless, I thought it would be neat if we could use this from Factor.

We can take a search query and turn it into a URL object:

: duckduckgo-url ( query -- url )
    URL" http://api.duckduckgo.com"
        swap "q" set-query-param
        "json" "format" set-query-param
        "1" "pretty" set-query-param
        "1" "no_redirect" set-query-param
        "1" "no_html" set-query-param
        "1" "skip_disambig" set-query-param ;

Using the http.client vocabulary and the json vocabulary we can retrieve a result set:

: duckduckgo ( query -- results )
    duckduckgo-url http-get nip utf8 decode json> ;

We can make a word that prints out the abstract response with clickable links:

: abstract. ( results -- )
    dup "Heading" of [ drop ] [
        swap {
            [ "AbstractURL" of >url write-object nl ]
            [ "AbstractText" of print ]
            [ "AbstractSource" of "- " write print ]
        } cleave nl
    ] if-empty ;

And then a word that prints out a result response, parsing the HTML using the html.parser vocabulary and output as text using the html.parser.printer vocabulary:

: result. ( result -- )
    "Result" of [
        "<a href=\"" ?head drop "\">" split1 "</a>" split1
        [ swap >url write-object ]
        [ parse-html html-text. nl ] bi*
    ] when* ;

There are more aspects to the response from the API, but we can initially print out the abstract, the results, and the related topics:

: duckduckgo. ( query -- )
    duckduckgo {
        [ abstract. ]
        [ "Results" of [ result. ] each ]
        [ "RelatedTopics" of [ result. ] each ]
    } cleave ;

We can try it out on a topic that this particular blog likes to discuss:

IN: scratchpad "factorcode" duckduckgo.
Factor (programming language)
Factor is a stack-oriented programming language created by Slava
Pestov. Factor is dynamically typed and has automatic memory
management, as well as powerful metaprogramming features. The
language has a single implementation featuring a self-hosted
optimizing compiler and an interactive development environment.
The Factor distribution includes a large standard library.
- Wikipedia

Official site - Factor (programming language)
Concatenative programming languages
Stack-oriented programming languages
Extensible syntax programming languages
Function-level languages
High-level programming languages
Programming languages
Software using the BSD license

This is available on my GitHub.

Magic

2023-02-12T16:42:00.011-08:00

Ever wonder what the type of a particular binary file is? Or wonder how a program knows that a particular binary file is in a compatible file format? One way is to look at the magic number used by the file format in question. You can see some examples in a list of file signatures.

The libmagic library commonly supports the file command on Unix systems, other than Apple macOS which has its own implementation, and uses magic numbers and other techniques to identify file types. You can see how it works through a few examples:

$ file vm/factor.hpp
vm/factor.hpp: C++ source text, ASCII text

$ file Factor.app/Contents/Info.plist 
Factor.app/Contents/Info.plist: XML  document text

$ file factor
factor: Mach-O 64-bit executable x86_64

$ file factor.image
factor.image: data

Wrapping the C library

I am going to show how to wrap a C library using the alien vocabulary which provides an FFI capability in Factor. The man pages for libmagic show us some of the functions available in magic.h.

The libmagic library needs to be made available to the Factor instance:

"magic" {
    { [ os macosx? ] [ "libmagic.dylib" ] }
    { [ os unix? ] [ "libmagic.so" ] }
} cond cdecl add-library

We start by defining an opaque type for magic_t:

TYPEDEF: void* magic_t

Some functions are available for opening, loading, and then closing the magic_t:

FUNCTION: magic_t magic_open ( int flags )

FUNCTION: int magic_load ( magic_t magic, c-string path )

FUNCTION: void magic_close ( magic_t magic )

It is convenient to wrap the close function as a destructor for use in a with-destructors form.

DESTRUCTOR: magic_close

A function that "returns a textual description of the contents of the filename argument", which gives us the file command ability above:

FUNCTION: c-string magic_file ( magic_t magic, c-string path )

That should be everything we need to continue...

Using the C library

Now that we have the raw C library made available as Factor words, we can create a simpler interface by wrapping some of the words into a simple word that guesses the type of a file:

: guess-file ( path -- result )
    [
        normalize-path
        0 magic_open &magic_close
        [ f magic_load drop ]
        [ swap magic_file ] bi
    ] with-destructors ;

And we can then try it on a few files:

IN: scratchpad "vm/factor.hpp" guess-file .
"C++ source, ASCII text"

IN: scratchpad "Factor.app/Contents/Info.plist" guess-file .
"XML 1.0 document, Unicode text, UTF-8 text"

IN: scratchpad "factor" guess-file .
"symbolic link to Factor.app/Contents/MacOS/factor"

IN: scratchpad "factor.image" guess-file .
"data"

This has been available for awhile in the magic vocabulary with improved error checking and some options to guess the MIME type of files.

Hipku

2023-02-08T08:38:00.001-08:00

Once upon a time, there was a Javascript project called Hipku. The original post that described it was lost somewhere in the series of tubes, but thankfully the "full documentation and a working demo" was saved by the Wayback Machine. It is also still available on npm for installation.

Hipku is a small javascript library to encode IP addresses as haiku. It can express any IPv4 or IPv6 address as a Western-style 5/7/5 syllable haiku.

An implementation in Python was created called PyHipku. It is still available on PyPi for installation, but the website associated with it was also lost to history and not even the Great Wayback Machine seems able to recover it. I think of programming as aspiring to a kind of poetic result — and wonder what kind of language could run Waka Waka Bang Splat — well, the haiku style caught my interest, so I ported the hipku algorithm to the Factor programming language.

At it's core, we encode an IPv4 address or IPv6 address into a series of numerical values and then make a poem by looking up each word from a word list. Some symbols are defined to help us know to start a sentence with an uppercase letter or end a sentence with a period:

SYMBOLS: Octet octet octet. ;

For example, an IPv4 key specifies the word lists to use for each octet and an IPv4 schema specify how the octets form into a hipku — an f indicates a newline:

CONSTANT: ipv4-key ${
    animal-adjectives animal-colors animal-nouns animal-verbs
    nature-adjectives nature-nouns plant-nouns plant-verbs
}

CONSTANT: ipv4-schema ${
    "The" octet octet octet f
    octet "in the" octet octet. f
    Octet octet.
}

To create the hipku, we iterate across the key, choosing words numerically by looking up the octet value, and then composing them into the ordering specified by the schema.

You can see a couple examples below:

IN: scratchpad "127.0.0.1" >hipku print
The hungry white ape
aches in the ancient canyon.
Autumn colors crunch.

IN: scratchpad "2001:db8:3333:4444:5555:6666:7777:8888" >hipku print
Chilled apes and blunt seas
clap dear firm firm grim grim gnomes.
Large holes grasp pained mares.

We support both encoding into a hipku as well as decoding back into an IPv4/IPv6 address. This is available as the hipku vocabulary in a recent nightly build.

Proquint

2023-02-07T09:56:00.002-08:00

A few days ago, Ciprian Dorin Craciun wrote a binary to text encoding blog post about the "state of the art and missed opportunities" in various encoding schemes. In that post, I was introduced to the Proquint encoding which stands for "PRO-nouncable QUINT-uplets".

In the Factor programming language, we have enjoyed implementing many encoding/decoding methods including: base16, base24, base32, base32hex, base32-crockford, base36, base58, base62, base64, base85, base91, uu, and many others. I thought it would be fun to add a quick implementation of Proquint.

Like other encodings, it makes use of an alphabet — grouped as consonants and vowels:

CONSTANT: consonant "bdfghjklmnprstvz"

CONSTANT: vowel "aiou"

Numbers are grouped into 5-character blocks representing a 16-bit number, with alternating consonants representing 4 bits and vowels representing 2 bits:

: >quint16 ( m -- str )
    5 [
        even? [
            [ -4 shift ] [ 4 bits consonant nth ] bi
        ] [
            [ -2 shift ] [ 2 bits vowel nth ] bi
        ] if
    ] "" map-integers-as reverse nip ;

Encoding a 32-bit number is made by joining two 16-bit blocks:

: >quint32 ( m -- str )
    [ -16 shift ] keep [ 16 bits >quint16 ] bi@ "-" glue ;

Decoding numbers looks up each consonant or vowel, skipping separators:

: quint> ( str -- m )
    0 [
        dup $[ consonant alphabet-inverse ] nth [
            nip [ 4 shift ] [ + ] bi*
        ] [
            dup $[ vowel alphabet-inverse ] nth [
                nip [ 2 shift ] [ + ] bi*
            ] [
                CHAR: - assert=
            ] if*
        ] if*
    ] reduce ;

We can use this to make a random password that might be more memorable — but perhaps more secure if using more random-bits:

: quint-password ( -- quint )
    32 random-bits >quint32 ;

And we could use our ip-parser vocabulary to make IPv4 addresses more memorable:

: ipv4>quint ( ipv4 -- str )
    ipv4-aton >quint32 ;

: quint>ipv4 ( str -- ipv4 )
    quint> ipv4-ntoa ;

You can see how this might work by building a test suite to show roundtrips work:

{ t } [
    {
        { "127.0.0.1"       "lusab-babad" }
        { "63.84.220.193"   "gutih-tugad" }
        { "63.118.7.35"     "gutuk-bisog" }
        { "140.98.193.141"  "mudof-sakat" }
        { "64.255.6.200"    "haguz-biram" }
        { "128.30.52.45"    "mabiv-gibot" }
        { "147.67.119.2"    "natag-lisaf" }
        { "212.58.253.68"   "tibup-zujah" }
        { "216.35.68.215"   "tobog-higil" }
        { "216.68.232.21"   "todah-vobij" }
        { "198.81.129.136"  "sinid-makam" }
        { "12.110.110.204"  "budov-kuras" }
    } [
        [ quint>ipv4 = ] [ swap ipv4>quint = ] 2bi and
    ] assoc-all?
] unit-test

This is now available as the proquint vocabulary in a recent nightly build.

Semantic Versioning

2023-01-24T19:29:00.004-08:00

Semantic Versioning (or "semver" for short) is a specification for handling version numbers, and providing a way to sort and specify compatibility using a MAJOR.MINOR.PATCH structure with optional "pre-release" and "build" information.

Some examples of semantic version numbers:

1.0.0-alpha
1.0.0-beta+win32
1.0.0-rc.1
1.0.0

For a long time, I thought it might be funny to follow the upcoming release of Factor version 0.99 with version 0.100. Well, if we wanted to be consistent with "semver", it might instead have to be something like 0.100.0-joke+haha.

There is now a semver vocabulary that provides some words for sorting and working with semantic version numbers. Here's an example using it:

IN: scratchpad USE: semver

IN: scratchpad "0.99.0" >semver bump-alpha semver.
0.99.1-alpha.0

IN: scratchpad "0.99.0" >semver bump-preminor bump-rc semver.
0.100.0-rc.0

IN: scratchpad "0.99.0" "0.100.0" semver<=> .
+lt+

IN: scratchpad "0.100.0-joke+haha" >semver bump-major semver.
1.0.0

Reading the Semantic Versioning 2.0.0 specification, it suggests using the version numbers to represent compatibility with previous versions. And many languages have package managers that use these compatibility guarantees with "semver ranges" to manage project dependencies.

Five Questions

2023-01-21T11:51:00.024-08:00

Many years ago, there was a blog post containing five programming problems every software engineer should be able to solve in less than 1 hour. I had bookmarked it at the time and didn't notice the controversy it created on Reddit. The original link seems to be down — you can view a copy of it on the Wayback Machine — but there are various solutions posted online, including a solution in Python.

I finally got around to looking at it and writing up some solutions to the problems listed. Apparently, instead of solving this in 1 hour in Factor, it took me almost 8 years:

IN: scratchpad 2015 05 09 <date> days-since >integer .
2814

Problem 1

Write three functions that compute the sum of the numbers in a given list using a for-loop, a while-loop, and recursion.

In idiomatic Factor, this is just sum, and we would typically use sequence combinators, but instead here are a few solutions using lexical variables.

Using a for-loop, iterating forwards:

:: solve-1 ( seq -- n )
    0 seq length [ seq nth-unsafe + ] each-integer ;

Using a while-loop, iterating forwards:

:: solve-1 ( seq -- n )
    0 0 seq length :> n
    [ dup n < ] [
        [ seq nth-unsafe + ] [ 1 + ] bi
    ] while drop ;

Using recursion, iterating backwards:

:: (solve-1) ( accum i seq -- accum' )
    accum i [
        1 - seq [ nth-unsafe + ] 2keep (solve-1)
    ] unless-zero ;

: solve-1 ( seq -- n )
    0 swap [ length ] keep (solve-1) ;

Some test cases to confirm behavior:

{ 0 } [ { } solve-1 ] unit-test

{ 1 } [ { 1 } solve-1 ] unit-test

{ 6 } [ { 1 2 3 } solve-1 ] unit-test

Problem 2

Write a function that combines two lists by alternatively taking elements. For example: given the two lists [a, b, c] and [1, 2, 3], the function should return [a, 1, b, 2, c, 3].

We can alternately choose items from each list:

: solve-2 ( seq1 seq2 -- newseq )
    [ min-length 2 * ] 2keep '[
        [ 2/ ] [ even? ] bi _ _ ? nth-unsafe
    ] { } map-integers-as ;

Some test cases to confirm behavior:

{ { "a" 1 "b" 2 "c" 3 } } [
    { "a" "b" "c" } { 1 2 3 } solve-2
] unit-test

{ { "a" 1 "b" 2 "c" 3 } } [
    { "a" "b" "c" "d" } { 1 2 3 } solve-2
] unit-test

Problem 3

Write a function that computes the list of the first 100 Fibonacci numbers. By definition, the first two numbers in the Fibonacci sequence are 0 and 1, and each subsequent number is the sum of the previous two.

There are many approaches, including using memoization, but instead we'll just iterate from the starting values and use replicate to build up an output array.

: solve-3 ( n -- seq )
    [ 0 1 ] dip [ dup rot [ + ] keep ] replicate 2nip ;

Some test cases to confirm behavior:

{ { } } [ 0 solve-3 ] unit-test

{ { 0 } } [ 1 solve-3 ] unit-test

{ { 0 1 } } [ 2 solve-3 ] unit-test

{ { 0 1 1 2 3 5 8 13 21 34 } } [ 10 solve-3 ] unit-test

{ 573147844013817084100 } [ 100 solve-3 sum ] unit-test

Problem 4

Write a function that given a list of non negative integers, arranges them such that they form the largest possible number. For example, given [50, 2, 1, 9], the largest formed number is 95021.

We can try each-permutation of the input numbers, looking for their largest numerical value when the digits are concatenated.

: solve-4 ( seq -- n )
    0 swap [ number>string ] map
    [ concat string>number max ] each-permutation ;

Some test cases to confirm behavior:

{ 95021 } [ { 50 2 1 9 } solve-4 ] unit-test

{ 5523 } [ { 52 5 3 } solve-4 ] unit-test

Problem 5

Write a program that outputs all possibilities to put + or - or nothing between the numbers 1, 2, ..., 9 (in this order) such that the result is always 100. For example: 1 + 2 + 34 – 5 + 67 – 8 + 9 = 100.

This one is more complicated than the previous ones, but we can build it up piece by piece, using a test-case on each step to show how it works.

First, we want a word to interleave numbers amongst operators using solve-2.

: insert-numbers ( operators -- seq )
    [ length [1..b] ] [ solve-2 ] [ length 1 + suffix ] tri ;

{ { 1 f 2 + 3 f 4 } } [ { f + f } insert-numbers ] unit-test

Next, we want a word that will join adjacent digits — separated by f:

GENERIC: digits, ( prev intermediate -- next )
M: number digits, [ 10 * ] [ + ] bi* ;
M: object digits, [ [ , 0 ] dip , ] when* ;

: join-digits ( seq -- seq )
    [ [ ] [ digits, ] map-reduce , ] { } make ;

{ { 12 + 34 } } [ { 1 f 2 + 3 f 4 } join-digits ] unit-test

Since Factor is a kind of Reverse Polish notation, we'll want to swap from infix to postfix:

: swap-operators ( seq -- seq )
    dup rest-slice 2 <groups> [ 0 1 rot exchange ] each ;

{ { 12 34 + } } [ { 12 + 34 } swap-operators ] unit-test

The solution, then, is to use all-selections of addition, subtraction, and adjacency — interleaving the numbers, joining adjacent digits, swapping operators, and then calling each sequence as a quotation, filtering for the ones that return 100:

: solve-5 ( -- solutions )
    { + - f } 8 all-selections
    [ insert-numbers join-digits swap-operators ] map
    [ >quotation call( -- x ) 100 = ] filter ;

We can print the formula out by swapping the operators back to infix and printing them out:

: print-formula ( solutions -- )
    [ present ] map swap-operators " " join print ;

: solve-5. ( -- )
    solve-5 [ print-formula ] each ;

Spoilers! The printed solutions:

IN: scratchpad solve-5.
1 + 2 + 3 - 4 + 5 + 6 + 78 + 9
1 + 2 + 34 - 5 + 67 - 8 + 9
1 + 23 - 4 + 5 + 6 + 78 - 9
1 + 23 - 4 + 56 + 7 + 8 + 9
12 + 3 + 4 + 5 - 6 - 7 + 89
12 + 3 - 4 + 5 + 67 + 8 + 9
12 - 3 - 4 + 5 - 6 + 7 + 89
123 + 4 - 5 + 67 - 89
123 + 45 - 67 + 8 - 9
123 - 4 - 5 - 6 - 7 + 8 - 9
123 - 45 - 67 + 89

GetPercentageRounds

2023-01-19T11:21:00.002-08:00

There was a funny post on Twitter a couple of days ago about a recent event where the "Dutch government was forced to release the source code of their DigiD digital authentication iOS app" with this piece of C# code:

Some very funny discussions continued, with comments about how good or bad this code is, and how one might rewrite it in various ways. I thought it would be a fun opportunity to show a few variations of this simple function in Factor.

Implementations

A direct translation of this code, might use cond which is basically a sequence of if statements:

: get-percentage-rounds ( percentage -- str )
    {
        { [ dup 0.0 <= ] [ drop "⚪⚪⚪⚪⚪⚪⚪⚪⚪⚪" ] }
        { [ dup 0.0 0.1 between? ] [ drop "🔵⚪⚪⚪⚪⚪⚪⚪⚪⚪" ] }
        { [ dup 0.1 0.2 between? ] [ drop "🔵🔵⚪⚪⚪⚪⚪⚪⚪⚪" ] }
        { [ dup 0.2 0.3 between? ] [ drop "🔵🔵🔵⚪⚪⚪⚪⚪⚪⚪" ] }
        { [ dup 0.3 0.4 between? ] [ drop "🔵🔵🔵🔵⚪⚪⚪⚪⚪⚪" ] }
        { [ dup 0.4 0.5 between? ] [ drop "🔵🔵🔵🔵🔵⚪⚪⚪⚪⚪" ] }
        { [ dup 0.5 0.6 between? ] [ drop "🔵🔵🔵🔵🔵🔵⚪⚪⚪⚪" ] }
        { [ dup 0.6 0.7 between? ] [ drop "🔵🔵🔵🔵🔵🔵🔵⚪⚪⚪" ] }
        { [ dup 0.7 0.8 between? ] [ drop "🔵🔵🔵🔵🔵🔵🔵🔵⚪⚪" ] }
        { [ dup 0.8 0.9 between? ] [ drop "🔵🔵🔵🔵🔵🔵🔵🔵🔵⚪" ] }
        [ drop "🔵🔵🔵🔵🔵🔵🔵🔵🔵🔵" ]
    } cond ;

But since this is a series of if statements checked sequentially, you can just check the upper bounds. And since we only care about the argument for the comparison, we can use cond-case:

: get-percentage-rounds ( percentage -- str )
    {
        { [ 0.0 <= ] [ "⚪⚪⚪⚪⚪⚪⚪⚪⚪⚪" ] }
        { [ 0.1 <= ] [ "🔵⚪⚪⚪⚪⚪⚪⚪⚪⚪" ] }
        { [ 0.2 <= ] [ "🔵🔵⚪⚪⚪⚪⚪⚪⚪⚪" ] }
        { [ 0.3 <= ] [ "🔵🔵🔵⚪⚪⚪⚪⚪⚪⚪" ] }
        { [ 0.4 <= ] [ "🔵🔵🔵🔵⚪⚪⚪⚪⚪⚪" ] }
        { [ 0.5 <= ] [ "🔵🔵🔵🔵🔵⚪⚪⚪⚪⚪" ] }
        { [ 0.6 <= ] [ "🔵🔵🔵🔵🔵🔵⚪⚪⚪⚪" ] }
        { [ 0.7 <= ] [ "🔵🔵🔵🔵🔵🔵🔵⚪⚪⚪" ] }
        { [ 0.8 <= ] [ "🔵🔵🔵🔵🔵🔵🔵🔵⚪⚪" ] }
        { [ 0.9 <= ] [ "🔵🔵🔵🔵🔵🔵🔵🔵🔵⚪" ] }
        [ drop "🔵🔵🔵🔵🔵🔵🔵🔵🔵🔵" ]
    } cond-case ;

One suggestion was to generate a substring based on the input — with the somewhat negative aspect that it allocates memory for the returned string when called:

: get-percentage-rounds ( percentage -- str )
    10 * 10 swap - >integer dup 10 +
    "🔵🔵🔵🔵🔵🔵🔵🔵🔵🔵⚪⚪⚪⚪⚪⚪⚪⚪⚪⚪" subseq ;

But another way would be to just index into the possible results, using quoted words to reduce the amount of tokens involved — resulting in this fairly aesthetic result:

: get-percentage-rounds ( percentage -- str )
    10 * ceiling >integer qw{
        ⚪⚪⚪⚪⚪⚪⚪⚪⚪⚪
        🔵⚪⚪⚪⚪⚪⚪⚪⚪⚪
        🔵🔵⚪⚪⚪⚪⚪⚪⚪⚪
        🔵🔵🔵⚪⚪⚪⚪⚪⚪⚪
        🔵🔵🔵🔵⚪⚪⚪⚪⚪⚪
        🔵🔵🔵🔵🔵⚪⚪⚪⚪⚪
        🔵🔵🔵🔵🔵🔵⚪⚪⚪⚪
        🔵🔵🔵🔵🔵🔵🔵⚪⚪⚪
        🔵🔵🔵🔵🔵🔵🔵🔵⚪⚪
        🔵🔵🔵🔵🔵🔵🔵🔵🔵⚪
        🔵🔵🔵🔵🔵🔵🔵🔵🔵🔵
    } nth ;

It's always fun to see different ways to solve problems. In the Twitter thread, that includes using binary search, building the output character-by-character, generating solutions using ChatGPT, one-liners in Python, pattern matching, unit testing, and discussions of edge cases and naming conventions.

Project Gemini

2023-01-16T10:38:00.003-08:00

Project Gemini is a neat modern take on the Gopher protocol. You can read the Gemini FAQ or the Gemini specification to learn more details, but the home page has a nice summary:

Gemini is a new internet protocol which

Is heavier than gopher

Is lighter than the web

Will not replace either

Strives for maximum power to weight ratio

Takes user privacy very seriously

There are some nice Gemini clients implemented in various languages, for both the command-line and with nice user interfaces. I happen to enjoy using AV-98 and Lagrange, but many others are also great.

In a similar manner to my Gopher implementation in Factor, I recently implemented the Gemini protocol as well as a Gemini server and a Gemini user interface:

Instead of going into how the protocol or the user interface is implemented, I wanted to go over the Gemini command-line interface. In the spirit of Python's cmd module, I contributed the command-loop vocabulary to support generic line-oriented command interpreters.

We start by making a sequence of commands that our Gemini interpreter will support:

CONSTANT: COMMANDS {
    T{ command
        { name "back" }
        { quot [ drop gemini-back ] }
        { help "Go back to the previous Gemini URL." }
        { abbrevs { "b" } } }
    T{ command
        { name "forward" }
        { quot [ drop gemini-forward ] }
        { help "Go forward to the next Gemini URL." }
        { abbrevs { "f" } } }
    T{ command
        { name "history" }
        { quot [ drop gemini-history ] }
        { help "Display recently viewed Gemini URLs." }
        { abbrevs { "h" "hist" } } }
    T{ command
        { name "less" }
        { quot [ drop gemini-less ] }
        { help "View the most recent Gemini URL in a pager." }
        { abbrevs { "l" } } }
    T{ command
        { name "ls" }
        { quot [ gemini-ls ] }
        { help "List the currently available links." }
        { abbrevs f } }
    T{ command
        { name "go" }
        { quot [ gemini-go ] }
        { help "Go to a Gemini URL" }
        { abbrevs { "g" } } }
    T{ command
        { name "gus" }
        { quot [ drop "gemini://gus.guru/search" gemini-go ] }
        { help "Submit a query to the GUS search engine." }
        { abbrevs f } }
    T{ command
        { name "up" }
        { quot [ drop gemini-up ] }
        { help "Go up one directory from the recent Gemini URL." }
        { abbrevs { "u" } } }
    T{ command
        { name "url" }
        { quot [ drop gemini-url ] }
        { help "Print the most recent Gemini URL." }
        { abbrevs f } }
    T{ command
        { name "reload" }
        { quot [ drop gemini-reload ] }
        { help "Reload the most recent Gemini URL." }
        { abbrevs { "r" } } }
    T{ command
        { name "root" }
        { quot [ drop gemini-root ] }
        { help "Navigate to the most recent Gemini URL's root." }
        { abbrevs f } }
    T{ command
        { name "shell" }
        { quot [ gemini-shell ] }
        { help "'cat' the most recent Gemini URL through a shell." }
        { abbrevs { "!" } } }
    T{ command
        { name "quit" }
        { quot [ drop gemini-quit ] }
        { help "Quit the program." }
        { abbrevs { "q" "exit" } } }
}

And then we define a custom command-loop that will allow us to number the links on a Gemini page, and then by typing a number we can navigate to one of the links by detecting a "missing command":

TUPLE: gemini-command-loop < command-loop ;

M: gemini-command-loop missing-command
    over string>number [ 1 - LINKS ?nth ] [ f ] if* [
        gemini-go 3drop
    ] [
        call-next-method
    ] if* ;

You can see it in action:

$ ./factor -run=gemini.cli
Welcome to Project Gemini!
GEMINI> go gemini.circumlunar.space/news/

Official Project Gemini news feed

[1] Atom feed

2023 News

[2] 2023-01-14 - Tidying up gemini.circumlunar.space user capsules
[3] 2023-01-08 - Changing DNS server

2022 News

[4] 2022-06-20 - Three years of Gemini!
[5] 2022-01-30 - Minor specification update (0.16.1)
[6] 2022-01-22 - Mailing list archives, Atom feed for official news
[7] 2022-01-16 - Mailing list downtime, official news feed

Guided Tour of Factor

2023-01-15T19:28:00.002-08:00

Many years ago, Andrea Ferretti created a Factor tutorial which I had written about at the time.

One of our new core developers, Raghu Ranganathan, got permission to include the tutorial in the main Factor repository, and has reformatted it and updated it for the not-yet-released version 0.99 as the Guided tour of Factor.

You can access it in a recent nightly build by doing:

IN: scratchpad "tour" help

Check it out!

Speedrun Feedback

2022-02-04T08:10:00.002-08:00

Recently, Tomasz Wegrzanowski chose Factor for his 100 Languages Speedrun: Episode 71: Factor and it encouraged us to make some improvements that I wanted to describe.

Many of our users use the Factor environment through the UI developer tools or on the command-line with the listener. Another important use case is being able to eval and run scripts -- and this is where much of Tomasz' criticism was focused.

We now do command-line eval and run scripts with auto-use? enabled. This will be available in the nightly builds and as part of an upcoming 0.99 release.

So this works now:

$ ./factor -e="1 2 + ."
3

$ cat foo.factor
USE: io
"Hello World" print
12

$ ./factor foo.factor
Hello World

--- Data stack:
12

Previously, the first example would error with a "No word named “+” found in current vocabulary search path" and the second example would complain that the "Quotation's stack effect does not match call site" because the script did not have a ( -- ) stack effect.

I appreciate that some users approach Factor differently than I do, and we love getting feedback. I wish we could solve the name conflict with factor(1), but that is more challenging.

We may adjust this slightly as it just landed last night, and if anyone has further suggestions, please keep them coming!

Factor 0.98 now available

2018-07-31T10:09:00.002-07:00

“Even though you're growing up, you should never stop having fun.” - Nina Dobrev

I'm very pleased to announce the release of Factor 0.98!

OS/CPU Windows Mac OS X Linux

x86
0.98
0.98
0.98
x86-64
0.98
0.98
0.98

Source code: 0.98

OS/CPU	Windows	Mac OS X	Linux
x86	0.98	0.98	0.98
x86-64	0.98	0.98	0.98

This release is brought to you with almost 4,300 commits by the following individuals:

Alexander Ilin, Arkady Rost, Benjamin Pollack, Björn Lindqvist, Cat Stevens, Chris Double, Dimage Sapelkin, Doug Coleman, Friedrich von Never, John Benediktsson, Jon Harper, Mark Green, Mark Sweeney, Nicolas Pénet, Philip Dexter, Robert Vollmert, Samuel Tardieu, Sankaranarayanan Viswanathan, Shane Pelletier, @catb0t, @hyphz, @thron7, @xzenf

Besides several years of bug fixes and library improvements, I want to highlight the following changes:

Improved user interface with light and dark themes and new icons
Fix GTK library issue affecting some Linux installations
Support Cocoa TouchBar on MacOS
Factor REPL version banner includes build information.
Bindings for ForestDB
New graphical demos including Minesweeper, Game of Life, Bubble Chamber, etc.
Better handling of "out of memory" errors
Improved VM and compiler documentation, test fixtures, and bug fixes
Much faster Heaps and Heapsort
Support for Adobe Brackets, CotEditor, and Microsoft Visual Studio Code editors
On Mac OS X, allow use of symlinks to factor binary
Lots of improvements to FUEL (Factor's emacs mode)

Some possible backwards compatibility issues:

Flattened unicode namespace (either USE: ascii or USE: unicode).
Unified CONSTRUCTOR: syntax to include generated word name
Returning a struct by value with two register-sized values on 64bit now works correctly
Since shutdown hooks run first, calling exit will now unconditionally exit even if there is an error
On Windows, don't call cd to change directory when launching processes; there is another mechanism for that
In libc, renamed (io-error) to throw-errno
In match, renamed ?1-tail to ?rest
In sequences, renamed iota to <iota>
In sequences, renamed start/start* to subseq-start/subseq-start-from
In syntax, renamed GENERIC# to GENERIC#:
Improve command-line argument parsing of "executable"
Make buffered-port not have a length, because of problem with Linux virtual files and TCP sockets
Fix broken optimization that made floats work for integer keys in case statements
Growable sequences expand by factor of 2 (instead of 3) when growing
Removed support for "triple-quote" strings

What is Factor

Factor is a concatenative, stack-based programming language with high-level features including dynamic types, extensible syntax, macros, and garbage collection. On a practical side, Factor has a full-featured library, supports many different platforms, and has been extensively documented.

The implementation is fully compiled for performance, while still supporting interactive development. Factor applications are portable between all common platforms. Factor can deploy stand-alone applications on all platforms. Full source code for the Factor project is available under a BSD license.

New Libraries:

backticks: process backtick syntax for processes
bencode: support for bencoding
boolean-expr: simple boolean expression evaluator and simplifier
bubble-chamber: variation of Jared Tarbell's Bubble Chamber
calendar.elapsed: rendering elapsed time to text
calendar.english: separated out English localization
checksums.crc16: CRC16 checksum implementation
checksums.metrohash: MetroHash checksum implementation
checksums.multi: support multiple checksums in one pass
checksums.process: support for using command-line checksums
checksums.ripemd: RIPEMD checksum implementation
checksums.sodium: Sodium crypto library checksum implementation
cocoa.touchbar: support for the Apple Touchbar
colors.flex-hex: implement "flex hex" color algorithm
crontab: parsing the cron format
cuckoo-filters: implementation of Cuckoo Filter data structure
dbf: parsers for DBase file format
editors.brackets: support for Adobe Brackets
editors.cot: support for CotEditor
editors.visual-studio-code: support for Microsoft Visual Studio Code
emojify: add emoji's to text ("I :heart: Factor :+1:")
english: tools for English language words
enigma: implementation of Enigma cipher machine
escape-strings: minimal string escaping algorithm
etc-hosts: cross-platform /etc/hosts file parser
file-monitor: cross-platform file change event monitor
file-picker: cross-platform file picker user interface
file-server: cross-platform file server web interface
flip-text: fun with "uʍop ǝpᴉsdn" text flipping
forestdb: bindings for ForestDB
game-of-life: implementation of John Conway's Game of Life
google.gmail: adding Google GMail API support
gopher: library for querying Gopher servers
gopher.server: cross-platform Gopher file server
gopher.ui: interface for viewing Gopher servers
ifaddrs: list network interfaces
ip-parser: parsing IPv4 and IPv6 addresses
ldcache: parsing /etc/ld.so.cache file
libtls: wrapper for using libtls functions
linked-sets: sets that yield items in insertion order
lru-cache: least recently used cache algorithm
machine-learning: experiments with some machine learning algorithms
math.factorials: adding reverse-factorial
math.functions.integer-logs: support for integer log2 and log10
math.primes.erato.fast: faster Sieve of Eratosthenes
metar: parsers for METAR and TAF weather reports
midi: reading MIDI files and writing MIDI files
minesweeper: playing the classic game of Minesweeper
named-tuples: using tuples as a sequence and assoc
oauth1: support OAuth 1.0
oauth2: support OAuth 2.0
odbc: support ODBC database query
picomath: implement picomath.org small math words
robohash: adding a robot-based hashing tool
sequences.frozen: virtual "frozen" sequence
sequences.interleaved: virtual "interleaved" sequence
shapefiles: parser for ESRI Shapefiles
shell.parser: parser for shell expressions
snake-game: implementation of the snake video game
sodium: wrapper for libsodium
sorting.bubble: adding Bubblesort
stream.extras: few helper words
subrip-subtitles: parser for SubRip .SRT files
successor: algorithm to find successor to a given string
text-analysis: analyze the complexity of English text
text-to-pdf: simple "Text to PDF" utility
text-to-speech: cross-platform "Text to Speech" utility
tools.cal: command-line "cal" tool
tools.cat: command-line "cat" tool
tools.copy: command-line "copy" tool
tools.echo: command-line"echo" tool
tools.grep: command-line"grep" tool
tools.image-analyzer: examine Factor image files
tools.move: command-line "move" tool
tools.seq: command-line "seq" tool
tools.tree: command-line "tree" tool
tools.uniq: command-line "uniq" tool
tools.wc: command-line "wc" tool
ui.gadgets.charts: UI gadget for rendering line charts
ui.gadgets.frame-buffer: UI gadget that supports a couple games
ui.theme: support for light and dark themes
windows.comdlg32: using comdlg32.dll functions
windows.crypt32: using crypt32.dll functions
windows.dragdrop-listener: allow dropping files into the Listener
windows.dropfiles: implementing "file drop" gesture on Windows
windows.surface-dial: support for Microsoft Surface Dial
xdg: support for XDG Base Directory Specification
zealot: continuous build and testing library

Improved Libraries:

boids: adding Cocoa TouchBar buttons
cap: support for screenshot on retina displays
checksums: cleanup and improved checksum API
color-table: add columns for filled color and hex code
cpu.architecture: adding Bit Test primitive
cpu.x86.64: fix for return register on x86.64
colors.hex: support varying length hex notations
combinators.extras: adding swap-when
compiler.cfg: fix scheduling issue
concurrency.distributed: fix serializing of remote threads
elf: cleanup and performance improvements
formatting: support "space" prefix for numbers
furnace.utilities: improve template path resolution
heaps: performance improvements to the heap algorithm
help: default word help (if not provided)
html.parser.printer: improved plain text printer
http.client: support HTTP proxies and bug fixes
http.server: fix use of port remapping
http.server.static: support sorting by columns
images.png: support reading color profiles
images.tiff: fix bugs exposed by AFL test suite
interpolate: simplify and some minor improvements
io.directories.search: simplify interface and allow BFS and DFS searches
io.encodings.8-bit: more encodings and simplify hierarchy
io.files.info.windows: fix file-readable? to check current user's permissions
io.files.unique: create multiple unique files at same time
io.launcher: cleanup interface and support hidden processes on Windows
io.streams.c: faster M\ c-reader stream-read-until
json.writer: better support for non-string keys, unicode and special floats
lexer: support universal comments
logging.server: simplify code
macho: updated structures and tests
mason.release: code signing on macOS and Windows
math.binpack: faster binpack and map-binpack
math.combinatorics: performance improvements
math.extras: adding Möbius function and Kelly criterion
math.functions: adding logn
math.parser: faster format-float for known format strings
math.primes.erato: performance improvements
math.primes.factors: command-line support
math.primes.solovay-strassen: adding Solovay-Strassen primality test
math.statistics: fixes and new words
math.text.french: more proper use of French
math.transforms.bwt: performance improvements
math.vectors: adding v>integer
mime.types: update for new mime types
multiline: support "Lua-style" strings
peg.ebnf: handle escapes in strings better
pong: bug fixes and a bit fancier graphics
readline-listener: adding vocab word completions
reddit: fix for Reddit API changes
sequences.extras: some possibly useful new words
simple-tokenizer: consider TAB, CR, LF as spaces
smalltalk: cleanup grammar and fix underscore bug
splitting.monotonic: faster monotonic-split.
sorting: faster sort-keys and sort-values on hashtables
sorting.extras: faster map-sort
strings.parser: allow both \u{snowman} and \u{2603}
terminfo: look in multiple directories for terminfo files
tools.disassembler: allow disassemble of compose and curry
tools.dns: enable use from command-line
tools.hexdump: support stdin hexdump
tools.scaffold: Better examples scaffold. Add more types.
tools.test: adding with-test-file and with-test-directory helper words
tools.which: enable use from command-line
ui.tools.browser: adding Cocoa TouchBar buttons
ui.tools.inspector: improved performance with large arrays and hashtables
ui.tools.listener: adding Cocoa TouchBar buttons, Ctrl-Break support on Windows, and vocab word completions
unicode: simplified hierarchy
urls: improved parsing of scheme component
wrap: performance improvements using better algorithm
xkcd: fix mouseover text.
xml.data: make tags support assoc protocol
z-algorithm: faster z-values

Minesweeper

2018-02-12T13:39:00.001-08:00

Minesweeper is a fun game that was probably made most popular by its inclusion in various Microsoft Windows versions since the early 1990's.

I thought it would be fun to build a simple Minesweeper clone using Factor.

You can run this by updating to the latest code and running:

IN: scratchpad "minesweeper" run

Game Engine

We are going to represent our game grid as a two-dimensional array of "cells".

Each cell contains the number of mines contained in the (up to eight) adjacent cells, whether the cell contains a mine, and a "state" flag showing whether the cell was +clicked+, +flagged+, or marked with a +question+ mark.

SYMBOLS: +clicked+ +flagged+ +question+ ;

TUPLE: cell #adjacent mined? state ;

Making a (rows, cols) grid of cells:

: make-cells ( rows cols -- cells )
    '[ _ [ cell new ] replicate ] replicate ;

We can lookup a particular cell using its (row, col) index:

:: cell-at ( cells row col -- cell/f )
    row cells ?nth [ col swap ?nth ] [ f ] if* ;

Placing a number of mines into cells, just looks for a certain number of unmined cells at random, and then marks them as mined:

: unmined-cell ( cells -- cell )
    f [ dup mined?>> ] [ drop dup random random ] do while nip ;

: place-mines ( cells n -- cells )
    [ dup unmined-cell t >>mined? drop ] times ;

We can count the number of adjacent mines for each cell, by looking at its neighbors:

CONSTANT: neighbors {
    { -1 -1 } { -1  0 } { -1  1 }
    {  0 -1 }           {  0  1 }
    {  1 -1 } {  1  0 } {  1  1 }
}

: adjacent-mines ( cells row col -- #mines )
    neighbors [
        first2 [ + ] bi-curry@ bi* cell-at
        [ mined?>> ] [ f ] if*
    ] with with with count ;

The each-cell word looks at all the cells, helping us update the "adjacent mines" counts:

:: each-cell ( ... cells quot: ( ... row col cell -- ... ) -- ... )
    cells [| row |
        [| cell col | row col cell quot call ] each-index
    ] each-index ; inline

:: update-counts ( cells -- cells )
    cells [| row col cell |
        cells row col adjacent-mines cell #adjacent<<
    ] each-cell cells ;

Since we aren't storing the number of rows and columns, we can get it from the array of cells:

: cells-dim ( cells -- rows cols )
    [ length ] [ first length ] bi ;

We can get the number of mines contained in the grid by counting them up:

: #mines ( cells -- n )
    [ [ mined?>> ] count ] map-sum ;

We can reset the game by making new cells and then placing the same number of mines in them:

: reset-cells ( cells -- cells )
    [ cells-dim make-cells ] [ #mines place-mines ] bi update-counts ;

The player wins if they click on all cells that aren't mines:

: won? ( cells -- ? )
    [ [ { [ state>> +clicked+ = ] [ mined?>> ] } 1|| ] all? ] all? ;

The player loses if they click on any cell that's a mine:

: lost? ( cells -- ? )
    [ [ { [ state>> +clicked+ = ] [ mined?>> ] } 1&& ] any? ] any? ;

And then the game is over if the player either wins or loses:

: game-over? ( cells -- ? )
    { [ lost? ] [ won? ] } 1|| ;

We can tell this is a new game if no cells are clicked on:

: new-game? ( cells -- ? )
    [ [ state>> +clicked+ = ] any? ] any? not ;

When we click on a cell, if it is not adjacent to any mines, we click on all the "clickable" (non-mined) cells around it:

DEFER: click-cell-at

:: click-cells-around ( cells row col -- )
    neighbors [
        first2 [ row + ] [ col + ] bi* :> ( row' col' )
        cells row' col' cell-at [
            mined?>> [
                cells row' col' click-cell-at
            ] unless
        ] when*
    ] each ;

Handle clicking a cell. If it's the first click and the cell is mined, we move it to another random cell, then continue with the click. The click is ignored if the cell was already clicked or flagged. Continue clicking around any cells that have no adjacent mines and are not themselves mined.

:: click-cell-at ( cells row col -- )
    cells row col cell-at [
        cells new-game? [
            ! first click shouldn't be a mine
            dup mined?>> [
                cells unmined-cell t >>mined? drop f >>mined?
                cells update-counts drop
            ] when
        ] when
        dup state>> { +clicked+ +flagged+ } member? [ drop ] [
            +clicked+ >>state
            { [ mined?>> not ] [ #adjacent>> 0 = ] } 1&& [
                cells row col click-cells-around
            ] when
        ] if
    ] when* ;

Handle marking a cell. First by flagging it as a likely mine, or marking with a question mark to come back to later. If the cell is not clicked, we just cycle through flagging, question, or not clicked.

:: mark-cell-at ( cells row col -- )
    cells row col cell-at [
        dup state>> {
            { +clicked+ [ +clicked+ ] }
            { +flagged+ [ +question+ ] }
            { +question+ [ f ] }
            { f [ +flagged+ ] }
        } case >>state drop
    ] when* ;

Graphical Interface

Our graphical interface is going to consist of a gadget with an array of cells and a cache of OpenGL texture objects that can be easily drawn on the screen.

TUPLE: grid-gadget < gadget cells textures ;

When you make a new grid-gadget, it initializes the game to a specified number of rows, columns, and number of mines:

:: <grid-gadget> ( rows cols mines -- gadget )
    grid-gadget new
        rows cols make-cells
        mines place-mines update-counts >>cells
        H{ } clone >>textures
        COLOR: gray <solid> >>interior ;

When ungraft* is called to indicate the gadget is no longer visible on the screen, we clean up the cached textures:

M: grid-gadget ungraft*
    dup find-gl-context
    [ values dispose-each H{ } clone ] change-textures
    call-next-method ;

Our images are going to be 32 x 32 squares, so the preferred dimension is number of rows and columns times 32 pixels for each square.

M: grid-gadget pref-dim*
    cells>> cells-dim [ 32 * ] bi@ swap 2array ;

Some slightly complex logic to decide which image to display for each cell, taking into account whether the game is over so we can show the positions of all the mines and whether the player was correct in flagging a cell as mined, etc:

:: cell-image-path ( cell game-over? -- image-path )
    game-over? cell mined?>> and [
        cell state>> +clicked+ = "mineclicked.gif" "mine.gif" ?
    ] [
        cell state>>
        {
            { +question+ [ "question.gif" ] }
            { +flagged+ [ game-over? "misflagged.gif" "flagged.gif" ? ] }
            { +clicked+ [
                cell mined?>> [
                    "mine.gif"
                ] [
                    cell #adjacent>> 0 or number>string
                    "open" ".gif" surround
                ] if ] }
            { f [ "blank.gif" ] }
        } case
    ] if "vocab:minesweeper/_resources/" prepend ;

Drawing a cached texture is a matter of looking up the image in our texture cache and then rendering to the screen:

: draw-cached-texture ( path gadget -- )
    textures>> [ load-image { 0 0 } <texture> ] cache
    [ dim>> ] [ draw-scaled-texture ] bi ;

Drawing our gadget, is basically drawing all of the cells at their proper locations on the screen:

M:: grid-gadget draw-gadget* ( gadget -- )
    gadget cells>> game-over? :> game-over?
    gadget cells>> [| row col cell |
        col row [ 32 * ] bi@ 2array [
            cell game-over? cell-image-path
            gadget draw-cached-texture
        ] with-translation
    ] each-cell ;

Basic handling for the gadget being left-clicked on:

:: on-click ( gadget -- )
    gadget hand-rel first2 :> ( w h )
    h w [ 32 /i ] bi@ :> ( row col )
    gadget cells>> :> cells
    cells game-over? [
        cells row col click-cell-at
    ] unless gadget relayout-1 ;

Basic handling for the gadget being right-clicked on:

:: on-mark ( gadget -- )
    gadget hand-rel first2 :> ( w h )
    h w [ 32 /i ] bi@ :> ( row col )
    gadget cells>> :> cells
    cells game-over? [
        cells row col mark-cell-at
    ] unless gadget relayout-1 ;

Logic for creating new games of varying difficulties: easy, medium, and hard:

: new-game ( gadget rows cols mines -- )
    [ make-cells ] dip place-mines update-counts >>cells
    relayout-window ;

: com-easy ( gadget -- ) 7 7 10 new-game ;

: com-medium ( gadget -- ) 15 15 40 new-game ;

: com-hard ( gadget -- ) 15 30 99 new-game ;

We set our gesture handlers for keyboard and mouse inputs:

grid-gadget {
    { T{ key-down { sym "1" } } [ com-easy ] }
    { T{ key-down { sym "2" } } [ com-medium ] }
    { T{ key-down { sym "3" } } [ com-hard ] }
    { T{ button-up { # 1 } } [ on-click ] }
    { T{ button-up { # 3 } } [ on-mark ] }
    { T{ key-down { sym " " } } [ on-mark ] }
} set-gestures

And a main word that creates an easy game in our grid-gadget and opens it in a new window:

MAIN-WINDOW: run-minesweeper {
        { title "Minesweeper" }
        { window-controls
            { normal-title-bar close-button minimize-button } }
    } 7 7 10 <grid-gadget> >>gadgets ;

The implementation above is about 200 lines of code and contains the full game logic. The final version is just under 300 lines of code, and adds:

support for a toolbar to easily start new games
the traditional counter of the number of mines remaining
display of the number of seconds elapsed
a smiley face showing a funny "uh-oh!" face when you are about to click as well as winning and losing smileys
support for retina displays using 2x images

$7.11

2017-02-11T14:05:00.000-08:00

Today, someone blogged about a fun problem:

“A mathematician purchased four items in a grocery store. He noticed that when he added the prices of the four items, the sum came to $7.11, and when he multiplied the prices of the four items, the product came to $7.11.”

In some ways, this is similar to the SEND + MORE = MONEY problem that I blogged about awhile ago. You can always approach this problem with an direct and iterative solution, but instead we will use the backtrack vocabulary to solve this problem with less code.

We'll be solving this exactly, using integer "numbers of cents", progressively restricting the options, and then calling fail if the solution is not found, so we check the next. The first valid solution will be returned:

:: solve-711 ( -- seq )
    711 <iota> amb-lazy :> w
    711 w - <iota> amb-lazy :> x
    711 w - x - <iota> amb-lazy :> y
    711 w - x - y - :> z

    w x * y * z * 711,000,000 = [ fail ] unless

    { w x y z } ;

Using it, we get our answer:

IN: scratchpad solve-711 .
{ 120 125 150 316 }

And that is: $1.20, $1.25, $1.50, and $3.16.

Dirty Money: Code Challenge

2017-02-05T15:59:00.000-08:00

There's a fun coding challenge to follow the dirty money that I discovered recently.

A shady Internet business has been discovered.

The website has been made public by a whistle blower. We have enough evidence about the dirty deals they did. But to charge them we need to get hands on precise numbers about the transactions that happened on their platform.

Unfortunately no record of the transactions could be seized so far. The only hint we have is this one transaction:
fd0d929f-966f-4d1a-89cd-feee5a1c5347.json
What we need is the total of all transactions in Dollar. Can you trace down all other transactions and get the total?

Be careful to count each transaction only once, even if it is linked multiple times. You can use whatever tool works best.

We need a way to extract the dollar amount from the transaction text. The dollars might be specified with period or a comma to represent the decimal point. We use regular expressions to look for the dollar amount and then convert to a number.

: dollars ( str -- $ )
    R/ \$\d*[,.]\d+/ first-match rest
    "," "." replace string>number ;

We will use a hash-set of visited links, and only if the link has not been visited will we http-get the contents of the URL, parse the JSON, and extract the dollar amount of both the transaction and any links it contains. The set of visited links will tell us how many total transactions we traced.

:: transaction ( url visited -- dollars )
    url visited ?adjoin [
        url http-get nip json> :> data
        data "content" of dollars
        data "links" of [ visited transaction ] map-sum +
    ] [ 0 ] if ;

: transactions ( url -- dollars #transactions )
    HS{ } clone [ transaction ] [ cardinality ] bi ;

That's all we need to solve the problem. We can run this with the initial URL and get the answer:

$9064.79 in 50 transactions.

The Twelve Days of Christmas

2016-12-24T11:21:00.000-08:00

Programming Praxis posted a task to write a program to print the words to The Twelve Days of Christmas song. We are going to solve it in Factor.

We start off by defining all the gifts received on each day:

CONSTANT: gifts {
    { "first" "a partridge in a pear tree" }
    { "second" "two turtle doves and " }
    { "third" "three French hens, " }
    { "fourth" "four calling birds, " }
    { "fifth" "five golden rings, " }
    { "sixth" "six geese a-laying, " }
    { "seventh" "seven swans a-swimming, " }
    { "eighth" "eight maids a-milking, " }
    { "ninth" "nine ladies dancing, " }
    { "tenth" "ten lords a-leaping, " }
    { "eleventh" "eleven pipers piping, " }
    { "twelfth" "twelve drummers drumming, " }
}

Then we iterate through the days, gathering all the gifts in reverse for each day, and formatting them, and wrapping to 72 columns of text for display.

gifts [
    [ first ] [ 1 + gifts swap head values reverse concat ] bi*
    "On the %s day of Christmas my true love gave to me %s." sprintf
    72 wrap-string print nl
] each-index

Which gives us these words:

On the first day of Christmas my true love gave to me a partridge in a pear tree.

On the second day of Christmas my true love gave to me two turtle doves and a partridge in a pear tree.

On the third day of Christmas my true love gave to me three French hens, two turtle doves and a partridge in a pear tree.

On the fourth day of Christmas my true love gave to me four calling birds, three French hens, two turtle doves and a partridge in a pear tree.

On the fifth day of Christmas my true love gave to me five golden rings, four calling birds, three French hens, two turtle doves and a partridge in a pear tree.

On the sixth day of Christmas my true love gave to me six geese a-laying, five golden rings, four calling birds, three French hens, two turtle doves and a partridge in a pear tree.

On the seventh day of Christmas my true love gave to me seven swans a-swimming, six geese a-laying, five golden rings, four calling birds, three French hens, two turtle doves and a partridge in a pear tree.

On the eighth day of Christmas my true love gave to me eight maids a-milking, seven swans a-swimming, six geese a-laying, five golden rings, four calling birds, three French hens, two turtle doves and a partridge in a pear tree.

On the ninth day of Christmas my true love gave to me nine ladies dancing, eight maids a-milking, seven swans a-swimming, six geese a-laying, five golden rings, four calling birds, three French hens, two turtle doves and a partridge in a pear tree.

On the tenth day of Christmas my true love gave to me ten lords a-leaping, nine ladies dancing, eight maids a-milking, seven swans a-swimming, six geese a-laying, five golden rings, four calling birds, three French hens, two turtle doves and a partridge in a pear tree.

On the eleventh day of Christmas my true love gave to me eleven pipers piping, ten lords a-leaping, nine ladies dancing, eight maids a-milking, seven swans a-swimming, six geese a-laying, five golden rings, four calling birds, three French hens, two turtle doves and a partridge in a pear tree.

On the twelfth day of Christmas my true love gave to me twelve drummers drumming, eleven pipers piping, ten lords a-leaping, nine ladies dancing, eight maids a-milking, seven swans a-swimming, six geese a-laying, five golden rings, four calling birds, three French hens, two turtle doves and a partridge in a pear tree.

AnyBar

2016-11-28T12:58:00.000-08:00

AnyBar is a macOS status indicator that displays a "colored dot" in the menu bar that can be changed programatically. What it means and when it changes is entirely up to the user.

You can easily install it with Homebrew-cask:

$ brew cask install anybar

The README lists a number of alternative clients in different programming languages. I thought it would be fun to show how to use it from Factor. Since AnyBar responds to AppleScript (and I added support for AppleScript a few years ago), we could do this:

USE: cocoa.apple-script

"tell application \"AnyBar\" to set image name to \"blue\""
run-apple-script

The AnyBar application also listens to a UDP port (default: 1738) and can be instructed to change from a Terminal using a simple echo | nc command:

$ echo -n "blue" | nc -4u -w0 localhost 1738

Using our networking words similarly is pretty simple:

"blue" >byte-array "127.0.0.1" 1738 <inet4> send-once

But if we wanted to get more fancy, we could use symbols to configure which AnyBar instance to send to, with default values to make it easy to use, and resolve-host to lookup hostnames:

SYMBOL: anybar-host
"localhost" anybar-host set-global

SYMBOL: anybar-port
1738 anybar-port set-global

: anybar ( str -- )
    ascii encode
    anybar-host get resolve-host first
    anybar-port get with-port send-once ;

AnyBar is a neat little program!

Reverse Factorial

2016-11-26T22:28:00.000-08:00

A few years ago, I wrote about implementing various factorials using Factor. Recently, I came across a programming challenge to implement a "reverse factorial" function to determine what factorial produces a number, or none if it is not a factorial.

To do this, we examine each factorial in order, checking against the number being tested:

: reverse-factorial ( m -- n )
    1 1 [ 2over > ] [ 1 + [ * ] keep ] while [ = ] dip and ;

And some unit tests:

{ 10 } [ 3628800 reverse-factorial ] unit-test
{ 12 } [ 479001600 reverse-factorial ] unit-test
{ 3 } [ 6 reverse-factorial ] unit-test
{ f } [ 18 reverse-factorial ] unit-test

Gopher Server

2016-10-27T14:14:00.000-07:00

A few days ago, I noticed a post about building a Gopher Server in Perl 6. I had already implemented a Gopher Client in Factor, and thought it might be fun to show a simple Gopher Server in Factor in around 50 lines of code.

Using the io.servers vocabulary, we will define a new multi-threaded server that has a directory to serve content from and hostname that it can be accessed at:

TUPLE: gopher-server < threaded-server
    { serving-hostname string }
    { serving-directory string } ;

When a file is requested, it can be streamed back to clients:

: send-file ( path -- )
    binary [ [ write ] each-block ] with-file-reader ;

The Gopher protocol is defined in RFC 1436 and lists a few differentiated file types. We use the mime.types vocabulary to return the correct one.

: gopher-type ( entry -- type )
    dup directory? [
        drop "1"
    ] [
        name>> mime-type {
            { [ dup "text/" head? ] [ drop "0" ] }
            { [ dup "image/gif" = ] [ drop "g" ] }
            { [ dup "image/" head? ] [ drop "I" ] }
            [ drop "9" ]
        } cond
    ] if ;

When a directory is requested, we can send a listing of all the sub-directories and files it contains, sending their relative path to the root directory being served so they can be requested properly by the client:

:: send-directory ( server path -- )
    path [
        [
            [ gopher-type ] [ name>> ] bi
            dup path prepend-path
            server serving-directory>> ?head drop
            server serving-hostname>>
            server insecure>>
            "%s%s\t%s\t%s\t%d\r\n" sprintf utf8 encode write
        ] each
    ] with-directory-entries ;

To know which path was requested, we read the line, split on the first tab, carriage return, or newline character we see:

: read-gopher-path ( -- path )
    readln [ "\t\r\n" member? ] split1-when drop ;

With all of that built, we can now implement a word to handle a client request:

M: gopher-server handle-client*
    dup serving-directory>> read-gopher-path append-path
    dup file-info directory? [
        send-directory
    ] [
        send-file drop
    ] if flush ;

Initializing a gopher-server instance and providing a convenience word to start one:

: <gopher-server> ( directory port -- server )
    utf8 gopher-server new-threaded-server
        "gopher.server" >>name
        swap >>insecure
        binary >>encoding
        "localhost" >>serving-hostname
        swap resolve-symlinks >>serving-directory ;

: start-gopher-server ( directory port -- server )
    <gopher-server> start-server ;

This is available in the gopher.server vocabulary with a few improvements such as:

Support for .gophermap files for alternate results when content is requested.
Support for .gopherhead files to print headers above directory listings.
Navigation to parent directories using .. links.
Display file modified timestamp and file sizes.
Improved error handling.