[ planet-factor ]

John Benediktsson: What can you get from 1, 2, 3, 4, +, -, *, /, and ^?

Recently, a Haskell program was posted that computed all possible combinations of the numbers "1, 2, 3, and 4" and the operators "+, -, *, /, and ^" (allowing the operators to be repeated, but not the numbers). It's a fun little problem, and I thought it might be a good example for iterative development in Factor using the listener.

First, some vocabularies that we'll be using.

( scratchpad ) USING: arrays continuations kernel math 
               math.combinatorics math.statistics sequences ;

We can calculate all-permutations of the numbers (for a total of 4!, or 24):

( scratchpad ) { 1 2 3 4 } all-permutations

And, similarly, we can find all possible selections of three operations (for a total of 5³, or 125):

( scratchpad ) { + - * / ^ } 3 selections

Now, we can compute the cartesian-product to produce all possible pairings of the two sequences (for a total of 24 × 125, or 3000):

( scratchpad ) cartesian-product concat

You can inspect the list by clicking on it in the listener, printing it out (e.g., "dup .", or showing what the first result looks like:

( scratchpad ) dup first .
{ { 1 2 3 4 } { + + + } }

Use concat-as to make all the entries quotations (so they can be called).

( scratchpad ) [ [ ] concat-as ] map

We can then try calling the first element to make sure it produces the right result:

( scratchpad ) dup first dup . call .
[ 1 2 3 4 + + + ]
10

Let's call each quotation, creating an association list where the key is the quotation and the value is the result:

( scratchpad ) [ dup call 2array ] map
Division by zero
x 2

Whoops, some of the formulas produce division-by-zero errors. We can use continuations to recover (storing a f result when there is an error) and continue:

( scratchpad ) [ [ dup call ] [ drop f ] recover 2array ] map

Each element of the resulting sequence is a pairing of a quotation and a result:

( scratchpad ) dup first .
{ [ 1 2 3 4 + + + ] 10 }

We can see how many unique results (including f) are found:

( scratchpad ) dup values unique assoc-size .
430

You could calculate the 10 most common results using sorted-histogram. It turns out "1" is the most common result:

( scratchpad ) dup values sorted-histogram reverse 10 head .
{
    { 1 200 }
    { 4 116 }
    { 2 116 }
    { 3 96 }
    { 6 82 }
    { 9 65 }
    { 5 60 }
    { -2 57 }
    { 24 56 }
    { 1+1/2 53 }
}

Some other things you might try:

• Count how many "divide-by-zero" errors are produced, perhaps using assoc-filter to examine the "bad" formulas.
• Create an association between each unique value and the list of all quotations that produced it.
• Print each quotation and result out, sorted by numerical result.
• Define a word that, given a sequence of numbers and a sequence of operations, produces all the result pairings (using call( to make it compile properly).
• Find the most positive and most negative result, and output the quotations that produced them.

Thu, 2 Sep 2010 17:57:00

Chris Double: Dependent Types in ATS

Dependent types are types that depend on the values of expressions. ATS uses dependent types and in this post I hope to go through some basic usage that I’ve learnt as I worked my way through the documentation, examples and various papers.

While learning about dependent types in ATS I used the following resources:

• Tutorial on ATS datatypes
• Tutorial on Parametric Polymorphism and Templates
• Dependently Typed Datastructures
• Eliminating Array Bound Checking Through Dependent Types

Most of the examples that follow are based on examples in those resources.

Sorts and Types

Some dependently typed languages allow types to depend on values expressed in the language itself. ATS provides a restricted form of dependent types. The expressions that types can depend on are in a restricted constraint language rather than the full language of ATS. This constraint language is itself typed and to prevent confusion they call the types in that language ‘sorts’. References to ‘sort’ in this post refer to types in that constraint language. References to ‘type’ refers to types in the core ATS language itself.

Here is an example of the difference. The following is an example of a function that takes two numbers and returns the result of them added together. This is in a hypothetical dependently typed language where types can depend on language values itself:

fun add(a: int, b: int): int (a+b) = a + b

Here the result type is the exact integer type of the two numbers added together. A mistake in the body of the code that resulted in anything but the sum of the two numbers would be a type error. In ATS this function would look like:

fun add {m,n:int} (a: int m, b: int n): int (m+n) = a + b

Notice here the introduction of {m,n:int}. This is the ‘constraint language’ used for values that the types in ATS can depend on. Here we declare two values, m and n, of sort int. The two arguments to add are a and b and they are of type int m and int n respectively. They are the type of the exact integer represented by the m and n. The result type is an integer which is the sum of these two values. Note that the dependent type in ATS (the m, n and m+n) are variables and computations expressed in the constraint language, not variables in ATS (the a, b, and a+b).

Having a restricted constraint language for type values simplifies the type checking process. All computations in this language are pure and have no effects. Sorts and functions in the language must terminate. This avoids infinite loops and exceptions during typechecking.

For more information on the reasoning behind restricted dependent types see Dependent Types in Practical Programming and other papers at the ATS website.

In ATS documentation the restricted constrainted language is called the ‘statics’ of ATS and is documented in chapter 5 of the ATS user guide.

Simple Lists

Before I get into datatypes that use dependent types, I’ll do a quick overview of non-dependent types for those not familiar with ATS syntax. A basic ‘list’ type that can contain integers can be defined in ATS as:

datatype list =
  | nil
  | cons of (int, list)

With this type defined a list of integers can be created using the following syntax:

val a = cons(1, cons(2, cons(3, cons(4, nil))))

Functions that operate over lists can use pattern matching to deconstruct the list:

fun list_length(xs: list): int = 
  case+ xs of
  | nil () => 0
  | cons (_, xs) => 1 + list_length(xs)

fun list_append(xs: list, ys:list): list =
  case+ xs of
  | nil () => ys
  | cons (x, xs) => cons(x, list_append(xs, ys))

A complete example program is in dt1.dats (html). This can be built with the command:

atscc -o dt1 -D_ATS_GCATS dt1.dats

Note the -D_ATS_GCATS. This tells the ATS compiler to link against the garbage collector. This is needed as types defined with datatype are allocated on the heap and require the garbage collector to be released.

Polymorphic Lists

Instead of a list of integers we might want lists of different types. A list that is polymorphic can be defined using:

datatype list (a:t@ype) =
  | nil (a)
  | cons (a) of (a, list a)

Here the list can hold elements that are of any size. This is what the t@ype refers to. The functions that operate on these polymorphic lists are similar to the non-polymorphic list versions. The difference is they are ‘template’ functions and are parameterized by the template type:

fun{a:t@ype} list_length (xs: list a): int = 
  case+ xs of
  | nil () => 0
  | cons (_, xs) => 1 + list_length(xs)

fun{a:t@ype} list_append(xs: list a, ys: list a): list a =
  case+ xs of
  | nil () => ys
  | cons (x, xs) => cons(x, list_append(xs, ys))

fun{a,b:t@ype} list_zip(xs: list a, ys: list b): list ('(a,b)) =
  case+ (xs, ys) of
  | (nil (), nil ()) => nil ()
  | (cons (x, xs), cons (y, ys)) => cons('(x,y), list_zip(xs, ys))
  | (_, _) => nil ()

The {a:t@ype} immediately after the fun keyword identifies the function as a template function. These are very similar to C++ style templates. See the ATS Parametric Polymorphism and Templates tutorial for more details.

This example adds a definition for list_zip now that lists of things other than integers can be created. In this example we return a list of tuples. Each tuple contains the elements from the original source lists.

The complete example program is in dt2.dats (html). The example program has the following code:

val a = cons(1, cons(2, cons(3, cons(4, nil))))
val b = cons(5, cons(6, cons(7, cons(8, nil))))
val lena = list_length(a)
val lenb = list_length(b)
val c = list_append(a, b)
val d = list_zip(a, c) // <== different lengths!
val lend = list_length(d)

Note that the length of list a is 4, whereas the length of list d is 8. Calling list_zip with these two different lengthed lists results in a list of length 4 being returned.

We can encode the length of a list as part of the type to get a compile error if an attempt is made to zip two lists with different lengths. The length that is part of the type would be a dependent type (as the length is the value of an expression - the integer length of the list).

Dependently Typed Lists

The following datatype definition defines a polymorphic list of length n, where n is an integer:

datatype list (a:t@ype, int) =
  | nil (a, 0)
  | {n:nat} cons (a, n+1) of (a, list (a, n))

It is very similar to the previous polymorphic list definition except for the additional int. The type constructor for nil has this set to 0. A nil list is a list of length 0. The cons type constructor shows that the cons of a list of length n will be a list of length n+1. The {n:nat} constrains the type of n to be natural numbers (non-negative integers).

The implementation of the functions shown previous for this new list type are function templates as they were in the previous example. They also have the additional parameter for the length value:

fun{a:t@ype} list_length {n:nat} (xs: list (a, n)): int n = 
  case+ xs of
  | nil () => 0
  | cons (_, xs) => 1 + list_length(xs)

fun{a:t@ype} list_append {n1,n2:nat} (xs: list (a, n1), ys: list (a, n2)): list (a, n1+n2) =
  case+ xs of
  | nil () => ys
  | cons (x, xs) => cons(x, list_append(xs, ys))

fun{a,b:t@ype} list_zip {n:nat} (xs: list (a, n), ys: list (b, n)): list ('(a,b), n) =
  case+ (xs, ys) of
  | (nil (), nil ()) => nil ()
  | (cons (x, xs), cons (y, ys)) => cons('(x,y), list_zip(xs, ys))

Notice the type of the return value of list_length is the type for the specific integer value of n - which is the length of the list. This means that any error in the implementation that would result in a different value being returned is a compile time error. For example, this won’t typecheck:

fun{a:t@ype} list_length {n:nat} (xs: list (a, n)): int n = 
  case+ xs of
  | nil () => 1
  | cons (_, xs) => 1 + list_length(xs)

Similarly the type of the return value of list_append is defined as being a list of length n1+n2. That is, the sum of the length of the two input lists. The following will fail with a compile error:

fun{a:t@ype} list_append {n1,n2:nat} (xs: list (a, n1), ys: list (a, n2)): list (a, n1+n2) =
  case+ xs of
  | nil () =>  nil
  | cons (x, xs) => cons(x, list_append(xs, ys))

It is now a compile error to pass lists of different lengths to list_zip. This is because both input arguments are defined to be of the same length n. This list_zip usage from the previous polymorphic list example is now a compile error.

The complete example program is in dt3.dats (html).

Filter

It is not always possible to know the exact length of a result list which could make encoding the type problematic. A filter function that takes a list and returns a result list containing only those elements that return true when passed to a predicate function for example. In this case the typechecker would need to be able to call the predicate function to be able to determine the length of the result list. The following does not type check:

fun{a:t@ype} list_filter {m:nat} (
  xs: list (a, m),
  f: a -<> bool
  ): list (a, m) =
  case+ xs of
  | nil () => nil ()
  | cons (x, xs) => if f(x) then cons(x, list_filter(xs, f)) else list_filter(xs, f)

In this erroneous example the result is defined as a list of length m. But it won’t be of length m if the result of the predicate function means elements are skipped. A definition that typechecks uses an existential type definition (the [n:nat]) to define the result length as being a different value:

fun{a:t@ype} list_filter {m:nat} (
  xs: list (a, m),
  f: a -<> bool
  ): [n:nat] list (a, n) =
  case+ xs of
  | nil () => nil ()
  | cons (x, xs) => if f(x) then cons(x, list_filter(xs, f)) else list_filter(xs, f)

This unfortunately means that the typechecker won’t detect some examples of erroneous code. We’d like this to fail to compile if it results in a result list which is larger than the original list which should be impossible:

fun{a:t@ype} list_filter {m:nat} (
  xs: list (a, m),
  f: a -<> bool
  ): [n:nat] list (a, n) =
  case+ xs of
  | nil () => nil ()
  | cons (x, xs) => if f(x) then cons(x, cons(x, list_filter(xs, f))) else list_filter(xs, f)

The solution to this is to limit the existential type in the result to be all natural numbers less than or equal to the length of the input list:

fun{a:t@ype} list_filter {m:nat} (
  xs: list (a, m),
  f: a -<> bool
  ): [n:nat | n <= m] list (a, n) =
  case+ xs of
  | nil () => nil ()
  | cons (x, xs) => if f(x) then cons(x, list_filter(xs, f)) else list_filter(xs, f)

Note the [n:nat | n <= m] which defines the limit. This will now fail to compile the erroneous code but sucessfully compile the correct code. It won’t catch all possible errors but is better at catching some errors that the previous version.

The complete example program is in dt4.dats (html).

Drop

The implementation of a list_drop function, which removes the first n items from a list, also has a similar problem to that of list_filter. This definition won’t typecheck:

fun{a:t@ype} list_drop {m:nat} (
  xs: list (a, m),
  count: int
  ): list (a, m) =
  case+ xs of
  | nil () => nil ()
  | cons (x, xs2) => if count > 0 then list_drop(xs2, count - 1) else xs

Like list_filter this is due to the wrong size being used in the result list. We could use the same solution as list_filter which is to set the size using an existential type definition but in this case we actually know the result size. It is based on the count that is passed as an argument. The result list size should be the same as the input list, less the count. Here’s the new definition:

fun{a:t@ype} list_drop {m,n:nat | n <= m} (
  xs: list (a, m),
  count: int n
  ): list (a, m - n) =
  case+ xs of
  | nil () => nil ()
  | cons (x, xs2) => if count > 0 then list_drop(xs2, count - 1) else xs

This version will typecheck correctly. It will give a compile time error if the implementation incorrectly produces a list that is not exactly the expected size. It will also be a compile time error if the given count of items to drop is greater than the size of the list.

This is done by making count a singleton integer. Its type is an integer of a specific value, called n. When n is declared we state that it must be less than the size of the list, m, as seen by the definition {m,n:nat | n <= m}. The result list is required to be of size m-n.

The complete example program is in dt5.dats (html).

Lists that depend on their values

The previous list examples were datatypes that were dependant on the size of the list. It’s also possible to depend on the value stored in the list itself. The following is the definition for a list that can only hold even numbers:

datatype list =
  | nil of ()
  | {x:int | (x mod 2) == 0 } cons of (int x, list)

The cons constructor takes an int and a list. It is dependant on the value of the int with the constraint that the value of the int must be divisible by 2. It is now a compile error to put an odd number into the list. This won’t typecheck due to the attempt to pass the odd number 3 to cons:

val a = cons(2, cons(3, cons(10, cons(6, nil))))

The complete example program is in dt6.dats (html).

Another example of a list that depends on its values might be a list where all elements must be less than 100 and in order. It should be a type error to construct an unordered list.

datatype olist (int) =
  | nil (100) of ()
  | {x,y:int | x <= y} cons (x) of (int x, olist (y))

An olist is dependent on an int. This int is an integer value that all elements consed to the list must be less than. The nil constructor uses 100 for the value to show that all items must be less than 100. Like the previous example, the cons constructor depends on the first argument. It uses this in the constraint to ensure it is less than the dependant value of the tail list (the y).

Out of order construction like the following will be a type error:

val a = cons(1, cons(12, cons(10, cons(12, nil))))

Whereas this is fine:

val a = cons(1, cons(2, cons(10, cons(12, nil))))

The complete example program is in dt7.dats (html).

Red-Black Trees

The paper Dependently Typed Datastructures has an example of using dependently typed datatypes to implement red-black trees. The paper uses the language DML. I’ve translated this to ATS in the example that follows.

A red-black tree is a balanced binary tree which satisfies the following conditions:

• All nodes are marked with a colour, red or black.
• All leaves are marked black and all other nodes are either red or black.
• For every node there are the same number of black nodes on every path connecting the node to a leaf. This is called the black height of the node.
• The two sons of every red node must be black.

These constraints can be defined in the red-black tree datatype ensuring that the tree is always balanced and correct as per the conditions above. It becomes impossible to implement functions that produce a tree that is not a correct red-black tree since it won’t typecheck. This can be defined as:

sortdef color = {c:nat | 0 <= c; c <= 1}
#define red 1
#define black 0

datatype rbtree(int, int, int) =
  | E(black, 0, 0)
  | {cl,cr:color} {bh:nat}
     B(black, bh+1, 0)
       of (rbtree(cl, bh, 0), int, rbtree(cr, bh, 0))
  | {cl,cr:color} {bh:nat}
     R(red, bh, cl+cr)
       of (rbtree(cl, bh, 0), int, rbtree(cr, bh, 0))

The type rbtree is indexed by (int, int, int). These are the color of the node, the black height of the tree and the number of color violations respectively. The later is a count of the number of times a red node is followed by another red node. From the conditions given earlier it can be seen than a correct rbtree should always have a color violation number of zero.

The constructor, E, is a leaf node. This node is black, has a height of zero and no color violations. It is a valid rbtree.

The constructor B is a black node. It takes 3 arguments. The left child node, the integer value stored as the key, and the right child node. The type for a node constructed by B is black, has a height one greater than the child nodes and no color violations. Note that the black height of the two child nodes must be equal.

The constructor R is a red node. It takes 3 arguments, the same as the B constructor. As this is a red node it doesn’t increase the black height so uses the same value of the child nodes. The color violations value is calculated by adding the color values of the two child nodes. If either of those are red then the color violations will be non-zero.

The type for a function that inserts a key into the tree can now be defined as:

fun insert {c:color} {bh:nat} ( 
  key: int, 
  rbt: rbtree(c ,bh, 0)
  ): [c:color] [bh:nat] rbtree(c, bh, 0)

This means our implementation of insert must return a correct rbtree. It cannot have a color violations value that is not zero so it must conform to the conditions we outlined earlier. If it doesn’t, it won’t compile.

When inserting a node into the tree we can end up with a tree where the red-black tree conditions are violated. A function restore is defined below that pattern matches the combinations of invalid nodes and performs the required transformations to return an rbtree with no violations:

fun restore {cl,cr:color} {bh:nat} {vl,vr:nat | vl+vr <= 1} (
  left: rbtree(cl, bh, vl),
  key: int,
  right: rbtree(cr, bh, vr)
  ): [c:color] rbtree(c, bh + 1, 0) =
  case+ (left, key, right) of
    | (R(R(a,x,b),y,c),z,d) => R(B(a,x,b),y,B(c,z,d))
    | (R(a,x,R(b,y,c)),z,d) => R(B(a,x,b),y,B(c,z,d))
    | (a,x,R(R(b,y,c),z,d)) => R(B(a,x,b),y,B(c,z,d))
    | (a,x,R(b,y,R(c,z,d))) => R(B(a,x,b),y,B(c,z,d))
    | (a,x,b) =>> B(a,x,b)

The type of the restore function states that it takes a left and right node, one of which may have a color violation, and returns a correctly formed red-black tree node. It’s time consuming and error prone to look at the code and determine that it covers all the required cases to return a correctly formed tree. However the type checker will do this for us thanks to the constraints that have defined on the function and the rbtree type. It won’t compile if any of the pattern match lines are removed for example.

The use of =>> in the last pattern match line is explained in the tutorial on pattern matching. The ATS typechecker will typecheck each pattern line independently of the others. This can cause a typecheck failure in the last match since it doesn’t take into account the previous patterns and can’t determine that the color violation value of a in the result will be zero. By using =>> we tell ATS to typecheck the clause under the assumption that the other clauses have not been taken. Since they all handle the non-zero color violation case this line will then typecheck.

The insert function itself is implemented as follows:

fun insert {c:color} {bh:nat} (
  x: int,
  t: rbtree(c ,bh, 0)
  ): [c:color] [bh2:nat] rbtree(c, bh2, 0) = let
  fun ins {c:color} {bh:nat} (
    t2: rbtree(c, bh, 0)
  ):<cloptr1> [c2:color] [v:nat | v <= c] rbtree(c2, bh, v) =
    case+ t2 of
    | E () => R(E (), x, E ())
    | B(a, y, b) => if x < y then restore(ins(a), y, b)
                    else if y < x then restore (a, y, ins(b))
                    else B(a, y, b)
    | R(a, y, b) => if x < y then R(ins(a), y, b)
                    else if y < x then R(a, y, ins(b))
                    else R(a, y, b)
  val t = ins(t)
in
  case+ t of
  | R(a, y, b) => B(a, y, b)
  | _ =>> t
end

The complete example program is in dt8.dats (html). For another example of red-black trees in ATS see the funrbtree example from the ATS website.

Linear constraints

The constraints generated by the dependent types must be ‘linear’ constraints. An example of a linear constraint is the definition of ‘list_append’ earlier:

fun{a:t@ype} list_append {n1,n2:nat} (
  xs: list (a, n1), ys: list (a, n2)
  ): list (a, n1+n2)

The result type containing n1+n2 will typecheck fine. However an example that won’t typecheck is the following definition of a list_concat:

fun{a:t@ype} list_concat {n1,n2:nat} (
  xss: list (list (a, n1), n2),
  ): list (a, n1*n2)

The n1*n2 results in a non-linear constraint being generated and the ATS typechecker cannot resolve this. The solution for this is to use theoreom-proving. See chapter 6 in the ATS user guide for details and an example using concat.

Closing notes

Although I create my own list types in these examples, ATS has lists, vectors and many other data structures in the standard library.

There’s a lot more that can be done with ATS and dependent types. For more examples see the papers mentioned at the beginning at throughout this post. The paper Why Dependent Types Matter is also useful reading for more on the topic.

Wed, 1 Sep 2010 03:30:00

John Benediktsson: Floating-point Fractions

Recently, I wanted a way to convert floating-point numbers into fractions using Factor. To do this (with any hope of being correct), I spent some time understanding how floating-point numbers are represented.

Two useful resources about floating-point numbers are an article entitled "What Every Computer Scientist Should Know About Floating-Point Arithmetic" and a website called The Floating-Point Guide.

Basic floating-point numbers are specified using a sign bit, an exponent, and a mantissa. Aside from some special numbers (e.g., +Inf, -Inf, NaN) and denormal numbers, the value of a floating-point can be calculated using the formula:

(-1)^sign × 2^{exponent - exponent bias} × 1.mantissa

We will be working with double precision floating point values (e.g., 64-bit values):

To extract the sign, exponent, and mantissa bits is fairly easy:

USING: kernel math math.bitwise math.functions ;

: sign ( bits -- sign )
    -63 shift ;

: exponent ( bits -- exponent )
    -52 shift 11 on-bits mask ;

: mantissa ( bits -- mantissa )
    52 on-bits mask ;

We are not going to support special values, so we throw an error if we encounter one:

: check-special ( n -- n )
    dup fp-special? [ "cannot be special" throw ] when ;

Converting to a ratio (e.g., numerator and denominator) is just a matter of computing the formula (with some special handling for denormal numbers where the exponent is zero):

: float>ratio ( n -- a/b )
    check-special double>bits
    [ sign zero? 1 -1 ? ] [ mantissa 52 2^ / ] [ exponent ] tri
    dup zero? [ 1 + ] [ [ 1 + ] dip ] if 1023 - 2 swap ^ * * ;

You can see this in action:

( scratchpad ) 0.5 float>ratio .
1/2

( scratchpad ) 12.5 float>ratio .
12+1/2

( scratchpad ) 0.333333333333333 float>ratio .
6004799503160655/18014398509481984

( scratchpad ) USE: math.constants
( scratchpad ) pi float>ratio .
3+39854788871587/281474976710656

Wed, 1 Sep 2010 02:24:00

John Benediktsson: Hello, web!

One thing that surprises many people when they come to Factor, is that a lot of the Factor infrastructure (main site, planet, pastebin, documentation, and wiki) is written in Factor, and runs on a Factor web server.

The Factor web server is very capable, supporting static files, CGI scripts, SSL authentication, session management, and dynamic web pages. Some of the vocabularies that are involved:

• http.server, the web server
• furnace, the web framework
• db, the database support
• html.templates (both chloe and fhtml)
• html.forms and form validators

Hello, world!

This is a simple application that returns a plain text page that says "Hello, world!". Our web application is structured into a dispatcher (our "main responder"), an action, and words to create and run the web server.

USING: accessors furnace.actions html.forms http http.server
http.server.dispatchers http.server.responses namespaces urls ;

IN: webapps.hello

TUPLE: hello < dispatcher ;

: <hello-action> ( -- action )
    <page-action>
        [ "Hello, world!" "text/plain" <content> ] >>display ;

: <hello> ( -- dispatcher )
    hello new-dispatcher
        <hello-action> "" add-responder ;

: run-hello ( -- )
    <hello>
        main-responder set-global
    8080 httpd ;

MAIN: run-hello

Run the code by calling run-hello, then navigate to http://localhost:8080 and you will see the response.

Templates

To begin experimenting with templates, lets change the logic to include a form where a name can be provided. We will create a Chloe template file. Let's create a hello.xml file in the same location as the webapps.hello vocabulary:

<?xml version='1.0' ?>

<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">

    <t:form t:action="$hello">
        <label>What is your name?</label>
        <t:field t:name="name" />
        <input type="submit" />
    </t:form>

</t:chloe>

Now, modify the hello-action to load the template. The default form submission is via POST and can be supported using the submit slot of the action. We respond to a form submission by returning a plain text response saying "Hello, $name!":

USE: formatting

: <hello-action> ( -- action )
    <page-action>
        { hello "hello" } >>template
        [
            "name" param "Hello, %s!" sprintf
            "text/plain" <content>
        ] >>submit ;

When you navigate to http://localhost:8080, you will see a simple form prompting you to type in a name. After submitting the form, you will see a customized response depending on the name provided.

Form Validation

It is frequently useful to validate parameters that are submitted via forms (e.g., for numbers, e-mail addresses, ranges, required or optional, etc.). To support this, we need to add validation logic for every parameter desired (using words from the validators vocabulary). In this case, the name should be a required parameter:

USE: validators

: <hello-action> ( -- action )
    <page-action>
        [
            { { "name" [ v-required ] } } validate-params
        ] >>validate
        { hello "hello" } >>template
        [
            "name" value "Hello, %s!" sprintf
            "text/plain" <content>
        ] >>submit ;

Next, wrap the dispatcher in an <alloy>, which provides support for session-persistence, form validation, and database persistence.

USE: furnace.alloy
USE: db.sqlite

: <hello> ( -- dispatcher )
    hello new-dispatcher
        <hello-action> "" add-responder
     "resource:hello.db" <sqlite-db> <alloy> ;

If you navigate to the website now, and don't provide a name, you'll be redirected back to the form with the validation error specified.

Other tips

There is a development? symbol that can be set to t to make sure the web server is running the latest code from your application and that errors generate nice stack traces.

Malu has a nice tutorial on Github about building a blog application in Factor.

All of the Factor websites (as well as some nice examples like a "counter", "todo list", "tiny url", and "ip address") are in resource:extra/webapps.

Sun, 29 Aug 2010 04:13:00

Jeremy Hughes: Old blog: Map in Java

(map fn lst ...)

;;  ==> list
      

(define squares (list 1 4 9 16))

(define (sqrts nums)
  (map sqrt nums))

(sqrts squares)

;;  ==> (1 2 3 4)
      

/* No generics for clarity.  Assume also the existance of a static
   method `toList' that takes an Array and returns an ArrayList. */

List squares = toList(new Integer[] {1, 4, 9, 16});

List sqrts(List nums) {
    List out = new ArrayList();
    for (Integer i : nums)
        out.add(Math.sqrt(i));
    return out;
}

sqrts(squares);

//  ==> [1, 2, 3, 4]
      

(define even (list 2 4 6 8))
(define odd (list 1 3 5 7))

(define (sums . lists)
  (apply map + lists))

(sums even odd)

;;  ==> (3 7 11 15)
      

/* Assume the existance of a static method `isSameLength' that tests
   whether all Lists in an array are the same length. */

List even = toList(new Integer[] {2, 4, 6, 8});
List odd = toList(new Integer[] {1, 3, 5, 7});

List sums(List... lists) {
    List out = new ArrayList();
    if (!isSameLength(lists))
        throw new RuntimeException("Lists must have same length.");
    int numargs = lists.length;
    int length = lists[0].size();
    for (int i = 0; i < length; i++) {
        int val = 0;
        for (int k = 0; k < numargs; k++)
            val += lists[k].get(i);
        out.add(val);
    }
    return out;
}

sums(even, odd);

//  ==> [3, 7, 11, 15]
      

public interface Proc {

    public Object apply(Object... args);

}
      

public static List map(Proc proc, List... lists) {
    List out = new ArrayList();
    if (!isSameLength(lists))
        throw new RuntimeException("`map' requires lists of identical length");
    int numargs = lists.length;
    int length = lists[0].size();
    for (int i = 0; i < length; i++) {
        Obj[] args = new Obj[numargs];
        for (int k = 0; k < numargs; k++)
            args[k] = lists[k].get(i);
        out.add(proc.apply(args));
    }
    return out;
}
      

List even = toList(new Integer[] {2, 4, 6, 8});
List odd = toList(new Integer[] {1, 3, 5, 7});

Proc sum = new Proc() {
    public Object apply(Object... args) {
        return (Integer)args[0] + (Integer)args[1];
    }
};

List sums(List... lists) {
    return map(sum, lists);
}

sums(even, odd);

//  ==> [3, 7, 11, 15]
      

public interface Proc1<R, A> {

    public R apply(A arg);

}

public interface Proc2<R, A, B> {

    public R apply(A argA, B argB);

}

public interface ProcN<R, A, B,..., N> {

    public R apply(A argA, B argB,..., N argN);

}
      

public static <R, A, X extends List<R>> X map(Proc1<R, A> proc, X out, List<A> list) {
    for (A a : list)
        out.add(proc.apply(a));
    return out;
}

public static <R, A, B, X extends List<R>> X map(Proc2<R, A, B> proc,
        X out, List<A> listA, List<B> listB) {
    if (!isSameLength(listA, listB))
        throw new RuntimeException("`map' requires lists of identical length.");
    int length = listA.size();
    for (int i = 0; i < length; i ++)
        out.add(proc.apply(listA.get(i), listB.get(i));
    return out;

// And so on up to `map<R, A, B,..., N, X>.
      

List even = toList(new Integer[] {2, 4, 6, 8});
List odd = toList(new Integer[] {1, 3, 5, 7});

Proc2<Integer, Integer, Integer> sum = 
    new Proc<Integer, Integer, Integer>() {
        public Integer apply(Integer argA, Integer argB) {
            return argA + argB;
        }
    };

List sums(List listA, List listB) {
    return map(sum, new ArrayList(), listA, listB);
}

sums(even, odd);

//  ==> [3, 7, 11, 15]
      

public static <R, A> R reduce(Proc2<R, R, A> proc, List<A> list, R initial) {
    int size = list.size();
    R out = initial;
    for (A a : list)
        out = fun.apply(out, a);
    return out;
}

List nums = toList(new Integer[] {1, 2, 3, 4});

Integer squareSum(List list) {
    return reduce(new Proc2<Integer, Integer, Integer>() {
        public Integer apply(Integer a, Integer b) {
            return a + (b * b);
        }
    }, list, 0);
}

squareSum(nums);

//  ==> 30
      

Fri, 27 Aug 2010 00:53:00

Chris Double: Experimental Playback Statistics for HTML Video and Audio

Now that HTML video is getting more usage there have been requests for statistics during playback so performance can be measured from JavaScript. This has come up a few times on the WHATWG mailing list.

I raised bug 580531 to add some additional data to media and video DOM elements to provide this information. The patch in that bug adds two attributes to the DOM HTMLVideoElement object, both prefixed by ‘moz’ to prevent name clashes as they are experimental:

interface nsIDOMHTMLVideoElement : nsIDOMHTMLMediaElement
{
   ...
   // A count of the number of frames that have been decoded and ready
   // to be displayed. This can be used for computing the decoding framerate
   readonly attribute unsigned long mozDecodedFrames;
 
   // A count of the number of frames that have been dropped for performance
   // reasons during playback.
   readonly attribute unsigned long mozDroppedFrames;
};

mozDecodedFrames is an incrementing count each time a frame is decoded and ready to be displayed. mozDroppedFrames is incremented each to a frame is dropped to keep playback going at the correct frame rate. These can be used to compute the current framerate that the video is being decoded at, and the framerate that it should be decoding at by combining the two counts. This will give client JavaScript code an indication if the hardware is able to play the video.

Another requested feature is information on the download rate. Currently the Firefox implementation of HTML video and audio uses a non-standard extension to ‘progress’ events. We provide information attached to the event that gives the current byte position in the media file as it downloads, and the total bytes available. This was actually required by the WHATWG spec at one point but it changed a while back and I don’t think any other browser implements it.

This has been used in experimental pages to compute things like download rate and we use it in our own controls implementation to display a progress bar as we didn’t implement the ‘buffered’ attribute. Support for ‘buffered’ has now landed so we want to remove the non-standard ‘progress’ information to be spec compliant.

To address the needs of those using the progress data for bandwidth calculation I’ve added two attributes to HTMLMediaElement:

interface nsIDOMHTMLMediaElement : nsIDOMHTMLElement
{
   ...
   // The approximate rate at which the media resource is being downloaded in
   // bytes per second. If the rate is not available (possibly due
   // to not having downloaded enough data to compute a consistent value)
   // this will be NaN.
   readonly attribute float mozDownloadRate;
 
   // The approximate rate at which the media resource is being decoded in
   // bytes per second. If the rate is not available this will be
   // NaN.
   readonly attribute float mozDecodeRate;
};

mozDownloadRate is an estimate, in bytes per second, of the current download rate of the media. If not enough information has been downloaded for a reliable estimate this will be NaN. mozDecodeRate provides the rate at which decoding is occurring. In the patch this is the length of the video divided by the duration and remains constant.

Whether this gets landed is yet to be determined but I think the information is useful and I’d be interested in any feedback on the data I’ve decided to include. There is some feedback in the bug from the patch review already and there’s plenty of time between now and when the Firefox 4 rush is over to look over ideas of what could be included, removed or changed. I posted about the proposed additions in the WHATWG mailing list and there are some responses in that thread.

Tue, 24 Aug 2010 05:30:00

John Benediktsson: Calculator with GUI

Update: Kyle Cordes has made some nice refactoring to avoid the "code smell" of passing global variables around while building the gadgets.

I started playing around with the Factor GUI framework recently. The documentation is very detailed, but sometimes it is nice to have simple examples to learn from.

I thought it would be fun to build a simple calculator application. A teaser of what it will look like when we are done:

First, some imports and a namespace.

USING: accessors colors.constants combinators.smart kernel fry
math math.parser models namespaces sequences ui ui.gadgets
ui.gadgets.borders ui.gadgets.buttons ui.gadgets.labels
ui.gadgets.tracks ui.pens.solid ;

FROM: models => change-model ;

IN: calc-ui

Factor user interface elements are called gadgets. Many of them support being dynamically updated by being connected to models. Each model maintains a list of connections that should be updated when the value being held by the model changes.

The Model

Our calculator model is based on the notion that we have two numbers (x and y) and an operator that can be applied to produce a new value.

TUPLE: calculator < model x y op valid ;

: <calculator> ( -- model )
    "0" calculator new-model 0 >>x ;

If we want to reset the model (such as when we press the "clear" button):

: reset ( model -- )
    0 >>x f >>y f >>op f >>valid "0" swap set-model ;

We're storing all values as floating-point numbers, but (for display purposes) we'll show integers when possible:

: display ( n -- str )
    >float number>string dup ".0" tail? [
        dup length 2 - head
    ] when ;

Each of x and y can be set based on the value, and the op is specified as a quotation:

: set-x ( model -- model )
    dup value>> string>number >>x ;

: set-y ( model -- model )
    dup value>> string>number >>y ;

: set-op ( model quot: ( x y -- z ) -- )
    >>op set-x f >>y f >>valid drop ;

Pushing the "=" button triggers the calculation:

: (solve) ( model -- )
    dup [ x>> ] [ y>> ] [ op>> ] tri call( x y -- z )
    [ >>x ] keep display swap set-model ;

: solve ( model -- )
    dup op>> [ dup y>> [ set-y ] unless (solve) ] [ drop ] if ;

We support negating the number:

: negate ( model -- )
    dup valid>> [
        dup value>> "-" head?
        [ [ 1 tail ] change-model ]
        [ [ "-" prepend ] change-model ] if
    ] [ drop ] if ;

And pushing the "." button (to add a decimal), or a number (to add a digit):

: decimal ( model -- )
    dup valid>>
    [ [ dup "." subseq? [ "." append ] unless ] change-model ]
    [ t >>valid "0." swap set-model ] if ;

: digit ( n model -- )
    dup valid>>
    [ swap [ append ] curry change-model ]
    [ t >>valid set-model ] if ;

That pretty much rounds out the basic features of the model.

The GUI

For convenience, I store the calculator model in a global symbol:

SYMBOL: calc
<calculator> calc set-global

I can use that to create buttons for each type (using short names and unicode characters to make the code a bit prettier):

: [C] ( -- button )
    "C" calc get-global '[ drop _ reset ] <border-button> ;

: [±] ( -- button )
    "±" calc get-global '[ drop _ negate ] <border-button> ;

: [+] ( -- button )
    "+" calc get-global '[ drop _ [ + ] set-op ] <border-button> ;

: [-] ( -- button )
    "-" calc get-global '[ drop _ [ - ] set-op ] <border-button> ;

: [×] ( -- button )
    "×" calc get-global '[ drop _ [ * ] set-op ] <border-button> ;

: [÷] ( -- button )
    "÷" calc get-global '[ drop _ [ / ] set-op ] <border-button> ;

: [=] ( -- button )
    "=" calc get-global '[ drop _ solve ] <border-button> ;

: [.] ( -- button )
    "." calc get-global '[ drop _ decimal ] <border-button> ;

: [#] ( n -- button )
    dup calc get-global '[ drop _ _ digit ] <border-button> ;

: [_] ( -- label )
    "" <label> ;

We will create a label that is updated when the model changes.

: <display> ( -- label )
    calc get-global <label-control> { 5 5 } <border>
        { 1 1/2 } >>align
        COLOR: gray <solid> >>boundary ;

And, finally, creating the GUI (using vertical and horizontal track layouts):

: <col> ( quot -- track )
    vertical <track> 1 >>fill { 5 5 } >>gap
    swap output>array [ 1 track-add ] each ; inline

: <row> ( quot -- track )
    horizontal <track> 1 >>fill { 5 5 } >>gap
    swap output>array [ 1 track-add ] each ; inline

: calc-ui ( -- )
    [
        <display>
        [     [C]     [±]     [÷]    [×] ] <row>
        [ "7" [#] "8" [#] "9" [#]    [-] ] <row>
        [ "4" [#] "5" [#] "6" [#]    [+] ] <row>
        [ "1" [#] "2" [#] "3" [#]    [=] ] <row>
        [ "0" [#]     [.]     [_]    [_] ] <row>
    ] <col> { 10 10 } <border> "Calculator" open-window ;

MAIN: calc-ui

Then, running the calculator application:

( scratchpad ) "calc-ui" run

The code for this is on my Github.

Tue, 24 Aug 2010 05:08:00

John Benediktsson: Building "cat"

One neat feature of Factor is the ability to create and deploy programs as compiled binaries -- both CLI (command-line) or UI (graphical) applications.

I thought it might be fun to build the cat command-line program in Factor, and show how it can be deployed as a binary. From the man pages:

The cat utility reads files sequentially, writing them to the standard output. The file operands are processed in command-line order. If file is a single dash ('-') or absent, cat reads from the standard input.

We'll start by creating the cat vocabulary. You can either create the cat.factor file yourself, or use tools.scaffold to do it for you:

( scratchpad ) USE: tools.scaffold

( scratchpad ) "cat" scaffold-work
Creating scaffolding for P" resource:work/cat/cat.factor"

( scratchpad ) "cat" vocab edit

Begin the implementation by listing some imports and a namespace:

USING: command-line kernel io io.encodings.binary io.files
namespaces sequences strings ;

IN: cat

Printing each line from a stream is easy using the each-line word (flushing after each write to match the behavior of cat):

: cat-lines ( -- )
    [ write nl flush ] each-line ;

I chose to treat files (which might be text or binary) as binary, reading and writing 1024 bytes at a time. We check that the file exists, printing an error if not found:

: cat-stream ( -- )
    [ 1024 read dup ] [ >string write flush ] while drop ;

: cat-file ( path -- )
    dup exists?
    [ binary [ cat-stream ] with-file-reader ]
    [ write ": not found" write nl flush ] if ;

Given a list of files, with a special case for "-" (to read from standard input), we can cat each one:

: cat-files ( paths -- )
    [ dup "-" = [ drop cat-lines ] [ cat-file ] if ] each ;

Finally, we need an entry point that checks if command-line arguments have been provided:

: run-cat ( -- )
    command-line get [ cat-lines ] [ cat-files ] if-empty ;

MAIN: run-cat

Using the deploy-tool:

( scratchpad ) "cat" deploy-tool

Click "Save" to persist the deploy settings into a deploy.factor file, and "Deploy" to create a binary. You should see output like the following:

Deploying cat...
Writing vocabulary manifest
Preparing deployed libraries
Stripping manual memory management debug code
Stripping destructor debug code
Stripping stack effect checking from call( and execute(
Stripping specialized arrays
Stripping startup hooks
Stripping default methods
Stripping compiler classes
Finding megamorphic caches
Stripping globals
Compressing objects
Compressing quotations
Stripping word properties
Stripping symbolic word definitions
Stripping word names
Clearing megamorphic caches
Saving final image

And your binary should be in the same directory as your Factor installation (in a cat.app sub-directory on the Mac).

$ ls -hl cat.app/Contents/MacOS/cat 
-rwxr-xr-x  1 user  staff  421k Aug 21 11:11 cat.app/Contents/MacOS/cat*

$ cat.app/Contents/MacOS/cat
hello, world
hello, world
^D

The code for this is on my Github.

Sat, 21 Aug 2010 18:42:00