*scratch*

vijay's weblog

Max for lists

Python has a max function for the list type. Here is how you would use it:

max([3, 2, 1, 5, 0])
=> 5

max can take an optional key argument which specifies a one-argument ordering function:

max([3, 2, 1, -5, 0], key=abs)
=> -5

Here max is asked to use the absolute value of the elements to find the maximum. The absolute value of -5 is 5 thus making -5 the highest value in the list.

Motto do not have a built-in max function for lists. It has a max that return the largest of two numeric values:

3 5 max
=> 5

Using max along with the list-reduce procedure will give us a list-max similar to that in Python:

[def lst
 @max lst list-reduce]
def list-max

3 2 1 5 0 list list-max
=> 5

It is possible to write a more generic procedure that takes the ordering function too as an argument. Let us call it list-pick:

[def ord-fn def lst
 @ord-fn lst list-reduce]
def list-pick

3 2 1 5 0 list @max list-pick
=> 5
3 2 1 -5 0 list @max list-pick
=> 3

[def a def b a abs b abs gt ? a b] def abs-max
3 2 1 -5 0 list @abs-max list-pick
=> -5

Switch to map

The switch statement is a selection control construct found in popular programming languages. The following C++ code snippet demonstrates the syntax of switch in that language:

#include <iostream>
enum TrafficSignal { RED, GREEN, YELLOW };

void respond_to_signal (TrafficSignal ts)
{
   switch (ts)
     {
     case RED:
       cout << "stop!" << endl;
       break;
     case GREEN:
       cout << "go!" << endl;
       break;
     case YELLOW:
       cout << "caution!"  << endl;
       break;
     default:
       cout << "invalid signal." << endl;
     }
 }

 int main ()
 {
   respond_to_signal (YELLOW); // => caution!
   respond_to_signal (RED); // => stop!
   respond_to_signal (GREEN); // => go!
   respond_to_signal (static_cast (100)); // =>invalid signal.

   return 0;
 }

Is it possible to translate this code to Motto, a language weak in syntax? One solution is to exploit the built-in map data structure:

> red stop! green go! yellow caution! map def traffic-signals
> [invalid-signal swap traffic-signals map-get] def respond-to-signal

More than 17 lines of C++ code was compressed to just 2 lines and it works well:

> yellow respond-to-signal
caution!
> red respond-to-signal
stop!
> green respond-to-signal
go!
> blah respond-to-signal
invalid-signal

Now let us consider a problem from the realm of Objects – designing an Object Factory. An initial implementation in C++ will depend on the switch statement to choose the right factory, based on some unique identifier:

ShapesFactory* get_factory (ShapeId s)
{
   switch (s)
   {
     case CIRCLE:
       return CircleFactory::get_instance ();
       break;
     case SQUARE:
       return SquareFactory::get_instance ();
       break;
     default:
       throw "Invalid object id."
   }
}

When a new shape is added to the system the code should be modified and recompiled. If faced with a similar problem a Motto programmer would think of a map of object ids to constructors. The program need not be recompiled to support new classes. New object factories can be registered with the factory as the program runs. Here is an implementation of this idea:

;; A ShapesFactory.
[mk-map def shapes
 ;; Method: register.
 ;; Maps an object id with a constructor.
 ;; Returns true on success, false if the object id
 ;; is already registered.
 [def class def id
  id shapes map-at is-error ? [id [class] shapes map-put #t] #f] def register

 ;; Method: create.
 ;; Accepts an object id and returns a new object
 ;; by invoking the appropriate constructor from the map.
 [shapes map-at dup is-error ? [.p #f] [!]] def create
 []] def ShapesFactory

 ;; A global `factory` object to be used by all
 ;; shape classes.
 ShapesFactory def factory

This is how new Shape classes are registered with the factory:

;; Various Shapes classes:
 [def r
  [circle] def type
  [pi r r * *] def area
  []] def Circle

 1 def CIRCLE
 CIRCLE @Circle factory.register #t assert ;; assert will fail if the
                                           ;; object id is not unique.

 [def s
  [square] def type
  [s s *] def area
  []] def Square

 2 def SQUARE
 SQUARE @Square factory.register #t assert

 ;; Check if the factory construct correct objects:
 10 CIRCLE factory.create def c
 25 SQUARE factory.create def s

 c.type display-nl ;; => circle
 s.type display-nl ;; => square
 c.area display-nl ;; => 314.1592653589793
 s.area display-nl ;; => 625

 ;; New classes can be registered on-the-fly.
 [def h def w
  [rectangle] def type
  [w h *] def area
  []] def Rectangle

 3 def RECTANGLE
 RECTANGLE @Rectangle factory.register #t assert

 10 20 RECTANGLE factory.create def r
 r.type display-nl ;; => rectangle
 r.area display-nl ;; => 200

Lack of syntax is not a weakness. It can lead to elegant solutions!

Lazy Evaluation

This post is about lazy evaluation in Motto. As everything else, lazy evaluation can be accomplished without adding new syntax to the language. Code blocks and the bang (!) procedure is all that we need. As an example, consider the following procedure that generates an infinite sequence of numbers:

> [def n [n n 1 + integers]] def integers

integers is a procedure that returns a procedure. The returned procedure, when executed, will leave a copy of the argument on the stack and call integers again with the argument incremented by 1. This will leave a new procedure on the stack that will return this incremented value and so on. All this happens with no explicit management and modification of state. Let us see how integers can be used to produce a sequence, given a value to start with:

> 10 integers ! ! ! ! ! ! .p
10 11 12 13 14 15
> .c

;; or using the `times` procedure:
> 0 integers [!] 10 times .p
0 1 2 3 4 5 6 7 8 9

The following procedure shows how we could transform a lazy sequence by filtering out elements using a predicate:

> [def predic
   [! def n def i self def next-i
    i predic ? [i @n] [@n next-i]]] def filter

;; Filter even integers out:
> 0 integers @is-odd filter def p [p] 10 times .p
1 3 5 7 9 11 13 15 17 19
> .c

;; Filter odd integers out:
> 0 integers @is-even filter def p [p] 10 times .p
0 2 4 6 8 10 12 14 16 18

(This example is based on the code in Section 4.2.5 of R7RS.).

Returning procedures

“Procedures returning procedures” is an important idiom of Motto. Consider a simple procedure called complement that takes a predicate p and returns its inverse. The following code snippet demonstrates how complement could be used:

> [2 remainder 0 eq] def is-even
> 10 is-even
#t
> 3 is-even
#f
> @is-even complement def is-odd
> 3 is-odd
#t
> 2 is-odd
#f

Here we used complement to produce a new procedure which gives exactly the opposite result of is-even. complement itself is defined as:

> [def p [p not]] def complement

Another example:

> [def vowel a e i o u list vowel swap list-contains] def is-vowel
> @is-vowel complement def is-consonant
> a is-vowel
#t
> b is-vowel
#f
> b is-consonant
#t

Note: The value of a procedure can be extracted by preceding its name with an @. This is an alternative to value procedure-name.

Reference: On Lisp.

Equality of Procedures

What does it mean when we say two objects are equal? It could mean that both objects point to the same location in memory or it could mean that both objects have the same structure. In Motto, the eq procedure defines the first type of equality and equal defines the second:

> "hello" def a
> a def b
> a b eq
#t
> a b equal
#t
> "hello" def c
> a c eq
#f
> a c equal
#t

Here both a and b point to the same location in memory. So eq return true. c, though structurally similar to a, points to a different location. So a c equal return true and a c eq return false.

As procedures are first-class objects in Motto, they too can be compared for equality:

> [2 *] def double1
> @double1 def double2
> @double1 @double2 eq
#t
> [2 *] def double3
> @double1 @double3 eq
#f

(If we prefix a procedure name with @, the procedure object bound to that name will be pushed to the stack. This is a short-hand for the compiler definition value and is similar to the #' operator in Common Lisp.).

As we can see, eq is consistent in its behaviour. What about equal? Let us try equal with the above procedures. It should return true for all comparisons as all the three procedures have the same internal structure:

> @double1 @double2 equal
#t 
> @double1 @double3 equal
#t

If we compare double1 to a procedure with the same behaviour but with slight structural changes, equal will return false:

> [def a 2 a *] def double4
> 10 double1 10 double4
20 20
> @double1 @double4 equal
#f

In a strict mathematical sense two functions are equal if for all possible inputs they produce the same output. This definition also assumes that the functions do not cause any side effects. It is easy to define a predicate for comparing two procedures in the context of a particular input:

> [def proc1 def proc2
   [proc1] reduce-intact def result1
   [proc2] reduce-intact def result2 
   .c ;; Clearing the stack is optional.
   result1 result2 equal] def equal-p
> 10 @double1 @double4 equal-p
> #t

equal-p take the definitions of two procedures and applies them to the values on the stack. If the results produced are the same, equal-p will return true. The test should be repeated with all possible inputs (if possible) to establish that the procedures are equal indeed.

A few more usage samples of equal-p:

> [*] def mult1
> [def n def e [n 0 gt] [e n 1 - set n] loop] def replicate
> [replicate [+] reduce] def mult2    
> 2 3 mult1
6
> 2 3 mult2
12
> 2 3 @mult1 @mult2 equal-p
#t
> [+] def add1
> 2 3 add1
5
> 2 3 @mult1 @add1 equal-p
#f

Optimising recursion

This post looks at how the performance of deeply recursive procedures can be improved in Motto.

Let us start with the simple implementation of a procedure to calculate Fibonacci numbers:

> [def n n 0 eq ? 0 [n 1 eq ? 1 [n 1 - fib n 2 - fib +]]] def fib
> 5 fib
5
> 10 fib
55 
> 20 fib
6765

20 fib makes more than 20000 recursive calls. On my machine, It took almost 700 milliseconds to run. There are three ways to make this run faster.

Iteration

A dramatic improvement in speed can be achieved by using iteration:

> [def n 
   0 def a 
   1 def b 
   0 def i
   [i n lt] [a def tmp 
             b set a 
             b tmp + set b 
             i 1 + set i] loop
  a] def fib
> [20 fib] time!
2 ms real time
...
6765

Memoization

If the algorithm is not amenable to iteration, we can cache the results. Subsequent calls can return the result from the cache and avoid a costly re-computation. Here we optimize the fib procedure by storing all computed Fibonacci numbers in a map.

> mk-map def fib-memo
> [-1 swap fib-memo map-get] def get-fib
> [fib-memo map-put] def set-fib
> 0 0 set-fib
> 1 1 set-fib    

> [def n 
   n get-fib -1 eq ? 
   [n n 1 - fib n 2 - fib + set-fib n get-fib] 
   [n get-fib]] def fib

;; tests.

> [20 fib] time!
3 ms real time
...
> [20 fib] time!
0 ms real time
...

The number of recursive calls came down to 38 for the first instance and there were none for the second. Of course, the cache takes up additional memory and that is the price paid for the increased speed.

Virtual Machine definitions

If you want a fast recursive procedure, without trading memory, you can add fib as a Virtual Machine definition. That means you have to write the procedure in Scheme and make it callable from Motto:

> (define (fib n)
    (cond 
      ((= n 0) 0)
      ((= n 1) 1)
      (else
        (+ (fib (- n 1)) (fib (- n 2))))))

 > ;; Make `fib` accessible to Motto programs.
 > (def 'fib
     (lambda (vm stack)
       (stack-push (stack-pop stack) (fib (stack-top stack)))))
 > [20 fib] time!
 23 ms real time
 ...

If you have programmed in Java, you can think of this as making a safe JNI call, i.e, calling a fast low-level routine without the risks of segmentation faults, VM crashes etc.

The implementation of Motto require some improvements to make recursive calls more efficient. Having a mutable data stack will help a lot. The entire VM, or at least parts of it should be reimplemented in a systems language. But its another project, another story!

Procedural abstractions

This post explore some interesting ways procedures can be used to express algorithms and data abstractions in Motto programs.

Recursion

The following procedure solves the Towers of Hanoi problem with recursion:

> [c @ b @ a @ n @ 
   [n 1 - a c b hanoi
    Move disk from pole  a  to  b .s .c
    n 1 - c b a hanoi]
   n 0 gt when] 
   hanoi @

> 3 1 2 3 hanoi
Move disk from pole 1 to 2 
Move disk from pole 1 to 3 
Move disk from pole 2 to 3 
Move disk from pole 1 to 2 
Move disk from pole 3 to 1 
Move disk from pole 3 to 2 
Move disk from pole 1 to 2

The omnipresent stack makes it easy to visualize the shape of a recursive procedure. Let us try this with the classic factorial example:

> [.s n @  [n n 1 - fact *] n n 1 eq if] fact @

> 4 fact
4
4 3
4 3 2
4 3 2 1
24
> .c

> 10 fact
10
10 9
10 9 8
10 9 8 7
10 9 8 7 6
10 9 8 7 6 5
10 9 8 7 6 5 4
10 9 8 7 6 5 4 3
10 9 8 7 6 5 4 3 2
10 9 8 7 6 5 4 3 2 1
3628800
> .c

It is possible to prevent the stack from growing n steps deep by making the procedure iterative:

> [.s n @ f @ [f n * n 1 - fact-helper] f n 1 eq if] fact-helper @
> [1 swap fact-helper] fact-iter @

> 4 fact-iter
1 4
4 3
12 2
24 1
24
> .c

> 10 fact-iter
1 10
10 9
90 8
720 7
5040 6
30240 5
151200 4
604800 3
1814400 2
3628800 1
3628800
> .c

For repeatedly executing a piece of code we can also use the loop procedure. This will execute the code block on the top of the stack until the second value on the stack becomes false:

; Print "in loop" until user enter `quit`.
> [read quit eq not] ["in loop" display newline] loop
hello
in loop
blah
in loop
quit

Closures

A procedure is associated with an environment that contain references to non-local variables. A procedure together with such a referencing environment is known as a closure. The following is a simple example of a closure:

> [x @ y @ []] point @

A call to point will leave an empty procedure on the stack. Though this procedure contains no code to execute, it has an environment that refers to the values of x and y. The Motto virtual machine has an instruction called probe that allows us to access the variables in a closure. This instruction is invoked using a special dot notation.

> 10 20 point p @
> p.x p.y
20 10

A closure can also get computations done using its local state. The following updated version of point can construct new points by adding a value to its current coordinates:

> [x @ y @ 
   [a @ y a + x a + point2] new-point @ 
   []] 
  point2 @

> 10 20 point2 p2 @
> p2.x p2.y
20 10
> 100 p2.new-point p3 @
> p3.x p3.y
120 110

Closures can be used to implement abstract types. An abstract type reveals only its interface and hides all internal implementation details. This makes it easy to switch a type implementation without changing other parts of the program. In the above example, the point2 type has a simple interface: x, y and new-point. A new implementation of this type might choose to use a pair instead of two separate variable to store the coordinates, without disrupting the interface.

> [pair xy @ 
   [xy second] x @ 
   [xy first] y @
   [a @ xy first a + xy second a + point3] new-point @
   []] point3 @

> 10 20 point3 pp1 @
> pp1.x pp1.y
20 10
> .c
> 100 pp1.new-point pp2 @
> pp2.x pp2.y
120 110

A generic constructor procedure can be used to initialize the actual point type based on some input from the user:

> ;; Constructs a `point2` if user-input is `1`.
  ;; Constructs a `point3` on any other input.
> [ptype @ [point3] [point2] ptype 1 eq if] mk-point @

> 10 20 1 mk-point pt1 @
> 100 200 2 mk-point pt2 @
> pt1.x pt2.y
20 100 
> pt2.x pt1.y
200 10

Data types - Part II

This is a quick overview of the composite data types in Motto.

The data stack

Any value typed at the REPL is automatically pushed to the stack. Here are some basic stack operations:

> 10 20 30
10 20 30
> .p ;; Pop the stack
10 20
> .c ;; Clear the stack
> 100 20 78 32 12 [*] reduce 
59904000
> .c
> ;; Find the mean of all numbers on the stack:
> 6 11 7 length len @ [+] reduce len /
8
> red green blue
> ;; Check if the stack contains a particular value:
> red contains
#t
> [display newline] println @
> ;; The stack can be used as a key-value store:    
> name: sam age: 20
> name: get println
sam
> age: get println
20

The stack does away with the need to pass arguments explicitly to procedures. Procedures can leave any number of results on the stack. As an example, let us define a procedure for computing the mean of a list of numbers:

> [length count @ [+] reduce-intact count quotient] mean @
> 6 7 11 mean println
8
> .c
> 10 20 30 40 50 60 mean println
35

Mean is one of many averages that can be derived from a sequence of numbers. We can also define procedures to compute other averages like median, mode and range. There can be a single procedure that is used to aggregate all these averages together:

> [[gt] sort 
   length len @
   len 2 quotient mid @
   len is-odd ? [mid at] [mid at mid at + 2 quotient]]
  median @

> [most-occurs] mode @

> [[max] reduce-intact mx @
   [min] reduce-intact mn @
   mx mn -] range @

> [median avg_median @
   mean avg_mean @
   mode avg_mode @
   range avg_range @
   .c 
   median: avg_median
   mean: avg_mean
   mode: avg_mode
   range: avg_range] 
  averages @

> ;; tests
> 1 2 4 4 5 8 9 averages
median: 4 mean: 4 mode: 4 range: 8 
> .c
> 80 100 62 180 21 55 averages
median: 71 mean: 83 mode: 21 range: 159 
> .c

Each average could be retrieved separately using get:

> 3 5 12 averages
> median: get
5
> mean: get
6
> range: get
9
> mode: get
3
> .c

fetch is similar to get, but after retrieving the value, it removes the mapping from the stack. In the last post we saw how to use get to implement a procedure that take keyword arguments. Here we will redefine that procedure to use fetch so that the arguments are actually consumed by the procedure. In fact, having an extended form of fetch that can return a default value will be more useful here:

> ;; Extended form of `fetch` that accepts a default value.
> [key @ default @ key fetch dup key eq default swap if] fetch-d @

> ;; Procedure to compute distance between two points. If an argument is not
  ;; specified, it will default to 0.
> [0 x2: fetch-d 0 x1: fetch-d - 2 expt 
   0 y2: fetch-d 0 y1: fetch-d - 2 expt 
   + sqrt] distance @  

> x1: 10 x2: 5 y1: 100 y2: 120 distance
20.615528128088304 
> .c
> x1: 10 x2: 5 distance
5

Pair and List

As the name suggests pair is a composite of two values.

> 10 20 pair
(10 . 20)
> dup first
(10 . 20) 10
> swap second
10 20

It is possible to construct a list by making a pair point to another:

> 10 20 30 40 50 [pair] reduce
(10 20 30 40 . 50)

Motto has a built-in list type. The values on the stack can be wrapped up in a new list using the list procedure:

> 10 20 30 40 50 list lst @
> lst
(10 20 30 40 50)

> list-length
5  
> .c
> lst list-first lst list-rest
10 (20 30 40 50)
> .c
> lst list-reverse
(50 40 30 20 10)

> hello lst list-push   
(hello 10 20 30 40 50) 
> hello lst list-append
(10 20 30 40 50 hello)

> [2 * display #\space display] lst list-for-each
20 40 60 80 100
> .c

> ;; The `map` function from Lisp:
> [list-for-each list] my-list-map @
> [2 *] lst my-list-map
(20 40 60 80 100)

Array

Arrays are more efficient than lists for some operations, especially for accessing an arbitrary element. There are two ways to create an array. Either by using the array procedure or by typing in an array literal:

> a b c d array
#(a b c d) 

> ; An array literal.
> #(1 2 3 4 5)
#(1 2 3 4 5) 

> a b c d array arr @
> 0 arr array-at
a 
> hello 0 arr array-set
#(hello b c d) 
> arr ; array-set modifies the array.
#(hello b c d) 
> #(1 2 3 4) #(hello world) array-concat
#(1 2 3 4 hello world) 
> array-length
6

String

Strings are sequences of characters.

> "hello, world" s @
> 1 s string-at
#\e
> 3 5 s substring "lo" string-eq
#t
> 3 5 s substring "LO" string-eq ; `string-eq` is case-sensitive.
#f 
> 3 5 s substring "LO" string-ci-eq
#t 

> ; split the string using comma as the delimiter.
> #\, s string-split
("hello" " world") 
> ; use space as the delimiter.
> #\space s string-split
("hello," "world") 

> ; search for a substring.
> "hello" s string-find
0 
> "hullo" s string-find
#f 
> "hEllo" s string-find
#f 
> "hEllo" s string-ci-find
0 
> "llo" s string-find
2 
> "hello " "world" string-append
"worldhello "
> "hello " "world" string-concat
"hello world"

Map

Map is a data structure that acts like a dictionary, where a value is associated with a key. symbols and keywords are the most natural candidates for keys.

> name: mat age: 45 map m @
> name: m map-at
mat

> ; `map-at` will raise an error if the key is not found.
> salary: m map-at
#<$error #3 tag: value-not-found message: "Value not found."> 
> .c

> ; `map-get` allows to pass a default value for a missing key.
> 1450 salary: m map-get
1450 
> salary: 5000 m map-put
> 1450 salary: m map-at
5000

A map can stand-in for the switch-case control structure found in many imperative languages:

> [signal @ 
   red [stop! .s .c] green [go! .s .c] yellow [be ready .s .c] map signals @
   ["not a valid signal" error .s .c] signal signals map-get !] 
  signal-action @

> red signal-action
stop! 
> yellow signal-action
be ready 
> green signal-action 
go! 
> black signal-action
#<$error #2 tag: error message: "not a valid signal"> 
> red signal-action  
stop!

Motto tutorial

Motto is a practical syntax weak language in the tradition of Forth and Lisp. This post introduces the kernel of Motto where syntax is used only for identifying literals.

You can evaluate simple program statements in the Motto REPL:

motto v0.0

> "hello, world"
"hello, world"
> ; this is a comment.
> 34 6.23 
> #\a #\b #\c ; characters
> #t #f ; boolean    
> .s ; show what is on the stack
"hello, world" 34 6.23 #\a #\b #\c #t #f
> .c ; clear the stack.

Values we enter at the REPL is pushed to a data stack which is printed back to the user. You can also type commands or procedures that does something with the values on the stack. Procedures leave their result(s) back on the stack. Let us try the built-in arithmetic procedures:

> 4 5 +
9
> 10 *
90
> 45 2 remainder
90 1
> .c
> 45.89 5 /
9.178
> .c
> 943423792472394723947234927 323231313 *
304944111156291662875737288173669151

In short, programming in Motto is based on a simple rule: Push values to the data stack and issue commands (procedures) that does something with those values.

A basic type in Motto is the symbol. A symbol is the same as a string, but is not enclosed in double quotes. The following are all valid symbols:

> red green blue |a symbol with spaces|

A symbol is unique within the Motto virtual machine. So it can be used as a descriptive identifier for a literal. A value on the stack is bound to a symbol so that it can be recalled later using this descriptive name. The bind procedure (represented by a @) binds a value to a symbol:

> 3.14159265 PI @

Here the value 3.14159265 is bound to the symbol PI. We can use this symbol wherever we need the value of pi. For example, the following statement calculates the area of a circle with radius 100.897:

> PI 100.897 dup * *
31982.055975130526

The dup procedure duplicates the top of the stack. So the actual code that gets executed here is 3.14159265 100.897 100.897 * *.

Execution can be delayed by enclosing program statements in square brackets. Such suspended pieces of code are called code blocks:

> ["hello, world" .s .c]

The above statement creates a code block. If you display the stack now, you can see the compiled version of this code block sitting on the stack:

> .s
#<$proc #2 env: #f binding-env: #<$env #3 parent: #<$env #4parent: #f definitions: #<table #5>> definitions: #<table #6>> opcode: ((1 . "hello, world") 32 31)>

The bang procedure (represented by !) is used to execute a code block:

> !
hello, world

Code blocks are first class types like strings and numbers. So they can be bound to symbols. A code block that is bound to a symbol is known as a procedure. Let us define a procedure that calculates the area of a circle. This procedure will consume the top value on the stack and use it as the radius:

> [dup * PI *] area-of-circle @
> 45.78 area-of-circle
6584.17626524826
> .c
> 100.897 area-of-circle
31982.055975130526
> .c

Notice that a procedure is automatically executed by Motto. We need the bang procedure only for executing unbound code blocks.

In future posts I will cover:

  1. data types – number, character, boolean, string, list, array, map etc.
  2. procedural abstractions – recursion, closures.
  3. dynamically extending the compiler and virtual machine.

Before we conclude, here is a glimpse of the higher-order programming facilities provided by Motto:

> ;computing area of many circles in one go...
> 45.32 12.78 90 78 [area-of-circle] apply
6452.524683657361 513.1113009762599 25446.900465000002 19113.4496826
> ;...add them together...
> [+] reduce
51525.98613223362

Job scheduler

This post describes a simple job scheduler. Each job description consists of a procedure and some ticks into the future. The scheduler will pick up the job after the given ticks (seconds) and run the procedure. A job description is represented using the following structure. (All code in Spark-Scheme.):

(define-struct job (run-at proc))

There is a fixed size vector that is used to store the jobs.

(define max-jobs 10)
(define jobs (make-vector max-jobs ()))

The index on which a job get stored is calculated as:

(remainder (+ (current-seconds) ticks) max-jobs)

The job is added to a list at the resulting index. The following procedure contain the complete logic for scheduling a job:

(define (schedule-job ticks job-proc)
  (let* ((run-at (+ (current-seconds) ticks))
         (job (make-job run-at job-proc))
         (index (remainder run-at max-jobs))
         (q (vector-ref jobs index)))
       (vector-set! jobs index (cons job q))))

The scheduler wakes up for each second and run all the jobs scheduled for that second. If the current list has jobs that are scheduled to run in the future, they are left back to be executed later:

(define (scheduler)
  (sleep 1)
  (run-jobs (current-seconds))
  (scheduler))

(define (run-jobs now)
  (let* ((index (remainder now max-jobs))
         (q (vector-ref jobs index)))
    (let loop ((old-q q) (new-q ()))
      (if (not (null? old-q))
          (let ((job (car old-q)))
            (if (run-job job now)
                (loop (cdr old-q) new-q)
                (loop (cdr old-q) (cons job new-q))))
          (vector-set! jobs index new-q)))))

 (define (run-job job now)
   (if (<= (job-run-at job) now)
       (begin
         (thread (job-proc job))
         #t)
       #f))

The scheduler runs in its own thread:

(define (run-scheduler)
  (thread scheduler))

A test run of the scheduler:

> (run-scheduler)
> (schedule-job 5 (lambda () (printf "group1 job1~n") (flush-output)))
> (schedule-job 5 (lambda () (printf "group1 job2~n") (flush-output)))
> (schedule-job 15 (lambda () (printf "group3 job1~n") (flush-output)))
> (schedule-job 10 (lambda () (printf "group2 job1~n") (flush-output)))
;; after 5 seconds:
group1 job1
group1 job2
;; after 10 seconds:
group2 job1
;; after 15 seconds:
group3 job1

Reference: The Design and Implementation of the FreeBSD Operating System.