Hello World
include std.io;

fun main (args) {
    print "Hello, world!\n";
}
Ackermann Function
include std.io;
include std.basic;

(* expects two integer arguments from the command line *)

fun ack (m, n) {
    if (m == 0) {
        return n + 1;
    } else if (n == 0) {
        return ack (m - 1, 1);
    } else {
        return ack (m - 1, ack (m, n - 1));
    }
}

fun main (args) {
    def m = val (str2int (head args));
    def n = val (str2int (head (tail args)));

    print (int2str (ack (m, n)) + "\n");
}
Streaming Digits of Pi
include std.io;
include std.basic;

fun make_gen () {
    def k = 0;

    return lambda () {
        k = k + 1;
        return (k, 4 * k + 2, 0, 2 * k + 1);
    };
}

fun compose ((a,b,c,d), (e,f,g,h)) {
    return (a*e, a*f + b*h, c*e + d*g, c*f + d*h);
}

fun extract ((a,b,c,d), j) {
    return ((a*j + b) div (c*j + d))#1;
}

fun pi_digits () {
    def z = (1, 0, 0, 1);
    def gen = make_gen ();

    return lambda () {
        def y = extract (z, 3);
        while (y <> extract (z, 4)) {
            z = compose (z, gen ());
            y = extract (z, 3);
        }
        z = compose ((10, -10 * y, 0, 1), z);
        return int2str y;
    };
}

fun main (args) {
    def n = val (str2int (head args));
    def digits = pi_digits ();

    def i = 10;
    while (i <= n) {
        def c = 0;
        while (c < 10) {
            print (digits ());
            c = c + 1;
        }
        print ("\t:" + (int2str i) + "\n");
        i = i + 10;
    }

    def remainder = n % 10;
    if (remainder > 0) {
        def c = 0;
        while (c < 10) {
            if (c < remainder) {
                print (digits ());
            } else {
                print " ";
            }
            c = c + 1;
        }
        print ("\t:" + (int2str n) + "\n");
    }
}
Thread Ring
include std.io;
include std.thread;
include std.alg;

def RING_SIZE = 503;

fun link (id, inChan, outChan, resChan): void {
    while (true) {
        def n = recv inChan;
        if (n > 0) {
            send (outChan, n - 1);
            yield ();
        } else if (n < 0) {
            send (outChan, n);
            break;
        } else {
            send (resChan, id);
            send (outChan, -1);
            break;
        }
    }
}

fun main (args) {
    def n = val (str2int (head args));

    def channels = generate (lambda () { return channel int; }, RING_SIZE);
    def resultChannel = channel int;

    def i = 0;
    while (i < RING_SIZE) {
        spawn (int2str i,
               (i + 1, at (i, channels), at ((i + 1) % RING_SIZE, channels), resultChannel),
               link);

        i = i + 1;
    }

    send (head channels, n);
    def result = recv resultChannel;
    print (int2str result + "\n");
}
1024-bit RSA Key Pair
include std.math;
include std.basic;
include std.io;
include std.rand;

(* handy record for packaging data *)
type rsa_key = {
    modulus: int,
    public_exponent: int,
    private_exponent: int (* please don't share this *)
};

(* creates prime p where (p - 1) not divisible by 3 according to TAoCP 4.5.4 pp405 *)
fun rsaMakePrime (numBytes) {
    def p = randPrime numBytes;

    while (mod3 (p - 1) == 0) {
        p = randPrime numBytes;
    }

    return p;
}

fun rsaMakeKey (numBytes) {
    (* any two distinct prime numbers *)
    def half = numBytes >> 1;
    def p = rsaMakePrime half;
    def q = rsaMakePrime half;

    (* the modulus for public and private keys *)
    def n = p * q;

    (* Euler's totient function *)
    def m = (p - 1) * (q - 1);

    (* find some e in open range (1, m) coprime to m *)
    def e = 17;
    while (m % e == 0) {
        e = nextProbablePrime (e, 25);
    }

    (* find modular multiplicative inverse of e mod m *)
    def d = invMod (e, m);

    return {modulus=n, public_exponent=e, private_exponent=d};
}

fun main (args) {
    (* generate 1024-bit public and private key pair *)
    def k = rsaMakeKey 128;

    (* show what we made *)
    print ("public key (n=" + int2radix (k.modulus, 16) + ", e=" + int2radix (k.public_exponent, 16) + ")\n");
    print ("private key (n=" + int2radix (k.modulus, 16) + ", d=" + int2radix (k.private_exponent, 16) + ")\n");
}
Spectral Norm
include std.io;
include std.alg;
include std.math;
include std.text;

(* Problem specification:
 * http://shootout.alioth.debian.org/u32/performance.php?test=spectralnorm#about
 *)

fun frange (x: float): [float] {
    def cur = 0.0f;
    def result = [];

    while (cur < x) {
        result = result <+ cur;
        cur = cur + 1.0f;
    }

    return result;
}

fun add (x: float, y: float): float {
    return x + y;
}

fun eval_A (i: float, j: float): float {
    return 1.0f / ((i + j) * (i + j + 1.0f) / 2.0f + i + 1.0f);
}

fun eval_A_times_u (u: [float]): [float] {
    def z = frange (fpromote (len u));
    def a = zip (z, u);

    return map (lambda (i) {
                    return foldl (add, 0.0f, [u_j * eval_A (j, i) || (j, u_j) in a]);
                }, z);
}

fun eval_At_times_u (u: [float]): [float] {
    def z = frange (fpromote (len u));
    def a = zip (z, u);

    return map (lambda (i) {
                    return foldl (add, 0.0f, [u_j * eval_A (i, j) || (j, u_j) in a]);
                }, z);
}

fun eval_AtA_times_u (u: [float]): [float] {
    return eval_At_times_u (eval_A_times_u u);
}

fun main (args) {
    def n = val (str2int (head args));

    def u = generate (lambda () { return 1.0f; }, n);
    def v: [float] = [];

    def dummy = 0;
    while (dummy < 10) {
        v = eval_AtA_times_u u;
        u = eval_AtA_times_u v;
        dummy = dummy + 1;
    }

    def step: [float * float] = [(ue * ve, ve * ve) || (ue,ve) in zip (u,v)];

    def (vBv, vv): float * float = foldl (lambda ((x1,y1): float * float, (x2,y2): float * float): float * float {
        return (x1 + x2, y1 + y2);
    }, (0.0f, 0.0f), step);

    def result = fsqrt (vBv / vv);
    print (fformat ("#.#########", result));
}
Expression Language
include std.io;
include std.basic;

(*
 * See: http://en.wikipedia.org/wiki/Standard_ML#Expression_language
 *)

data Err = Error: string;

data Type = IntT
          | BoolT;

data Expr = True
          | False
          | Int: int
          | Not: Expr
          | Add: Expr * Expr
          | If: Expr * Expr * Expr;

fun typeOf (expr) {
    match (expr) {
        case True    { return BoolT; }
        case False   { return BoolT; }
        case (Int ?) { return IntT; }
        case (Not e) {
            if (typeOf e == BoolT) {
                return BoolT;
            } else {
                throw Error "not: only defined over bool";
            }
        }
        case (Add (e1,e2)) {
            if (typeOf e1 == IntT and typeOf e2 == IntT) {
                return IntT;
            } else {
                throw Error "add: only defined over int";
            }
        }
        case (If (cond,t,f)) {
            if (typeOf cond <> BoolT) {
                throw Error "if: condition must have type bool";
            } else if (typeOf t <> typeOf f) {
                throw Error "if: inconsistent branch types";
            } else {
                return typeOf t;
            }
        }
    }
}

fun getInt (i) {
    match (i) {
        case (Int n) { return n; }
        case ?       { throw Error "getInt: unhandled case"; }
    }
}

fun eval (expr) {
    match (expr) {
        case True    { return True; }
        case False   { return False; }
        case (Int n) { return Int n; }
        case (Not e) {
            match (eval e) {
                case True  { return False; }
                case False { return True; }
                case ?     { throw Error "eval: not: unhandled case"; }
            }
        }
        case (Add (e1,e2)) {
            return Int (getInt (eval e1) + getInt (eval e2));
        }
        case (If (cond,t,f)) {
            if ((eval cond) == True) {
                return eval t;
            } else {
                return eval f;
            }
        }
        case ? { throw Error "eval: unhandled case"; }
    }
}

fun chkEval (expr) {
    typeOf expr;
    return eval expr;
}

fun main (args) {
    try {
        def e = chkEval (If (True, Add (Int 7, Int 3), Int 11));
        print (int2str (getInt e));
    } catch (e: Err) {
        match (e) {
            case (Error msg) {
                print msg;
            }
        }
    }
}