6: Lists

6.1: Lists of characters

SML char list
datatype char_list = Nil
                   | Cons of (char * char_list) ;
SML list hi
(* list_hi : char_list *)
val list_hi = Cons("H",Cons("i",Nil)) ;
C char list
typedef struct list_struct {
  char                list_head ;
  struct list_struct  * list_tail ;
} *char_list ;
C cons
#define list_struct_size sizeof( struct list_struct )

char_list cons( char head, char_list tail ) {
  char_list l = malloc( list_struct_size ) ;
  if( l == NULL ) {
    printf( "cons: no space\n" ) ;
    abort( ) ;
  }
  l->list_head = head ;
  l->list_tail = tail ;
  return l ;
}
C list hi
char_list list_hi( void ) {
  char_list hi = cons( 'H', cons( 'i', NULL ) ) ;
  return hi ;
}

6.1.1: List access functions: head and tail

SML head and tail
(* head : char_list -> char *)
fun head (Cons(x,xs)) = x ;

(* tail : char_list -> char_list *)
fun tail (Cons(x,xs)) = xs ;
C head and tail
char head( char_list l ) {
  if( l == NULL ) {
    abort() ;
  }
  return l->list_head ;
}

char_list tail( char_list l ) {
  if( l == NULL ) {
    abort() ;
  }
  return l->list_tail ;
}

Answer to exercise 6.2

C literal equivalent of char list
typedef enum { Cons, Nil } char_list_tags ;

typedef struct char_list {
  char_list_tags tag ;
  union {
    struct {
      char                list_head ;
      struct char_list  * list_tail ;
    } cons_cell ;
  } char_list_union ;
} *char_list ;
C flat literal equivalent of char list
typedef enum { Cons, Nil } char_list_tags  ;
typedef struct char_list {
  char_list_tags      tag ;
  char                list_head ;
  struct char_list  * list_tail ;
} *char_list ;

6.2: The length of a list

SML length
(* length : char_list -> int *)
fun length Nil          = 0
  | length (Cons(x,xs)) = 1 + length xs ;
SML length with conditional
(* length : char_list -> int *)
fun length x_xs = if x_xs = Nil
                     then 0
                     else 1 + length (tail x_xs) ;
C length with conditional
int length( char_list x_xs ) {
  if ( x_xs == NULL ) {
    return 0 ;
  } else {
    return 1 + length( tail( x_xs ) ) ;
  }
}

6.3: Accessing an arbitrary element of a list

SML nth
(* nth : char_list -> int -> char *)
fun nth (Cons(x,xs)) 0 = x
  | nth (Cons(x,xs)) n = nth xs (n-1) ;
SML nth without pattern matching
(* nth : char_list -> int -> char *)
fun nth x_xs n = if n = 0
                    then head x_xs
                    else nth (tail x_xs) (n-1) ;
C nth
char nth( char_list x_xs, int n ) {
  while( n != 0 ) {
    x_xs = tail( x_xs ) ;
    n-- ;
  }
  return head( x_xs ) ;
}

Answer to exercise 6.4

C nth with bounds check
char nth( char_list x_xs, int n ) {
  while( true ) {
    if( x_xs == NULL ) {
      printf( "nth\n" ) ;
      abort() ;
    }
    if ( n == 0 ) {
      return head( x_xs ) ;
    }
    x_xs = tail( x_xs ) ;
    n-- ;
  }
}

6.4: Append, filter and map: recursive versions

6.4.1: Appending two lists

SML append
(* append : char_list -> char_list -> char_list *)
fun append Nil          ys = ys
  | append (Cons(x,xs)) ys = Cons(x,append xs ys) ;
C append
char_list append( char_list x_xs, char_list ys ) {
  if( x_xs == NULL ) {
    return ys ;
  } else {
    return cons( head( x_xs ),
                 append( tail( x_xs ), ys ) ) ;
  }
}
C append hi and ho
char_list list_hi_ho( void ) {
  char_list hi = cons( 'H', cons( 'i', NULL ) ) ;
  char_list ho = cons( 'H', cons( 'o', NULL ) ) ;
  char_list hiho = append( hi, ho ) ;
  return hiho ;
}

6.4.2: Filtering elements from a list

SML filter
(* filter : (char->bool) -> char_list -> char_list *)
fun filter pred Nil
    = Nil
  | filter pred (Cons(x,xs))
    = if pred(x)
         then Cons(x,filter pred xs)
         else filter pred xs ;
C filter
char_list filter( bool (*pred)( char ), char_list x_xs ) {
  if ( x_xs == NULL ) {
    return NULL ;
  } else {
    char x = head( x_xs ) ;
    char_list xs = tail( x_xs ) ;
    if( pred( x ) ) {
      return cons( x, filter( pred, xs ) ) ;
    } else {
      return filter( pred, xs ) ;
    }
  }
}
SML filter digit
(* filter_digit : char_list -> char_list *)
fun filter_digit xs = filter digit xs ;
SML digit
(* digit : char -> bool *)
fun digit x = x >= "0" andalso x <= "9" ;
C filter char list digit
char_list filter_digit( char_list xs ) {
  return filter( digit, xs ) ;
}
C digit
bool digit( char x ) {
  return x >= '0' && x <= '9' ;
}
SML filter greater
(* filter_greater : char -> char_list -> char_list *)
fun filter_greater p xs
    = let
         fun greater_p x = x > (p:char)
      in
         filter greater_p xs
      end ;
C extra filter
char_list extra_filter( bool (*pred)( void *, char ),
                        void * arg, char_list x_xs ) {
  if ( x_xs == NULL ) {
    return NULL ;
  } else {
    char x = head( x_xs ) ;
    char_list xs = tail( x_xs ) ;
    if( pred( arg, x ) ) {
      return cons( x, extra_filter( pred, arg, xs ) ) ;
    } else {
      return extra_filter( pred, arg, xs ) ;
    }
  }
}
C filter greater
char_list filter_greater( char p, char_list xs ) {
  return extra_filter( greater, &p, xs ) ;
}
C greater
bool greater( void *arg, char x ) {
  char * c = arg;
  return x > *c ;
}

6.4.3: Mapping a function over a list

SML map
(* map : (char->char) -> char_list -> char_list *)
fun map f Nil          = Nil
  | map f (Cons(x,xs)) = Cons(f x,map f xs) ;
C map
char_list map( char (*f)( char ), char_list x_xs ) {
  if( x_xs == NULL ) {
    return NULL ;
  } else {
    char x = head( x_xs ) ;
    char_list xs = tail( x_xs ) ;
    return cons( f( x ), map( f, xs ) ) ;
  }
}

Answer to exercise 6.9

C extra map
char_list extra_map( char (*f)( void *, char ),
                     void * arg, char_list x_xs ) {
  if( x_xs == NULL ) {
    return NULL ;
  } else {
    char x = head( x_xs ) ;
    char_list xs = tail( x_xs ) ;
    return cons( f( arg, x ), extra_map( f, arg, xs ) ) ;
  }
}

6.5: Open lists

SML copy
(* copy : char_list -> char_list *)
fun copy Nil          = Nil
  | copy (Cons(x,xs)) = Cons(x,copy xs) ;
C copy
char_list copy( char_list x_xs ) {
  if( x_xs == NULL ) {
    return NULL ;
  } else {
    return cons( head( x_xs ), copy( tail( x_xs ) ) ) ;
  }
}
SML tail recursive copy
(* copy' : char_list -> char_list -> char_list *)
fun copy' accu Nil
    = accu
  | copy' accu (Cons(x,xs))
    = copy' (append accu (Cons(x,Nil))) xs ;

(* copy : char_list -> char_list *)
fun copy xs = copy' Nil xs ;
C inefficient copy with open list
char_list copy( char_list xs ) {
  char_list accu = NULL ;
  while( xs != NULL ) {
    accu = append( accu, cons( head( xs ), NULL ) ) ;
    xs = tail( xs ) ;
  }
  return accu ;
}

6.5.1: Open lists by remembering the last cell

C while loop
while( condition ) {
  statement ;
}
C once unrolled while loop
if( condition ) {
  statement ;
  while( condition ) {
    statement ;
  }
}
C once unrolled inefficient copy with open list
char_list copy( char_list xs ) {
  char_list accu = NULL ;
  if( xs != NULL ) {
    accu = append( accu, cons( head( xs ), NULL ) ) ;
    xs = tail( xs ) ;
    while( xs != NULL ) {
      accu = append( accu, cons( head( xs ), NULL ) ) ;
      xs = tail( xs ) ;
    }
  }
  return accu ;
}
C schematic append
accu = append( accu, cons( head( xs ), NULL ) ) ;
C schematic append in the beginning
accu = cons( head( xs ), NULL ) ;
C copy with open list
char_list copy( char_list xs ) {
  char_list accu = NULL ;
  char_list last ;
  if( xs != NULL ) {
    last = accu
         = cons( head( xs ), NULL ) ;
    xs = tail( xs ) ;
    while( xs != NULL ) {
      last = last->list_tail
           = cons( head( xs ), NULL ) ;
      xs = tail( xs ) ;
    }
  }
  return accu ;
}
C multiple assignment
last = accu
     = cons( head( xs ), NULL ) ;
C segregated multiple assignment
accu = cons( head( xs ), NULL ) ;
last = accu ;
C copy ho
char_list list_ho( void ) {
  char_list ho = cons( 'H', cons( 'o', NULL ) ) ;
  char_list copy_ho = copy( ho ) ;
  return copy_ho ;
}

6.5.2: Open lists by using pointers to pointers

C copy with open list and advanced pointer
char_list copy( char_list xs ) {
  char_list accu = NULL ;
  char_list *last = &accu ;
  while( xs != NULL ) {
    char_list new = cons( head( xs ), NULL ) ;
    *last = new ;
    last = &new->list_tail ;
    xs = tail( xs ) ;
  }
  return accu ;
}

6.5.3: Append using open lists

SML compare append
fun append  Nil ys
          = ys
  | append (Cons(x,xs)) ys
          = Cons(x,append xs ys) ;
SML compare copy
fun copy  Nil
        = Nil
  | copy (Cons(x,xs))
        = Cons(x,copy xs) ;
C append with open list
char_list append( char_list xs,
                  char_list ys ) {   /*added char_list ys*/
  char_list accu = ys;              /*replaced NULL by ys*/
  char_list last ;
  if( xs != NULL ) {
    last = accu
         = cons( head(xs), ys ) ;   /*replaced NULL by ys*/
    xs = tail( xs ) ;
    while( xs != NULL ) {
      last = last->list_tail
           = cons( head(xs), ys ) ; /*replaced NULL by ys*/
      xs = tail( xs ) ;
    }
  }
  return accu ;
}

Answer to exercise 6.11

C append with open list and advanced pointer
char_list append( char_list xs, char_list ys ) {
  char_list accu = ys ;
  char_list *last = &accu ;
  while( xs != NULL ) {
    char_list new = cons( head( xs ), ys ) ;
    *last = new ;
    last = &new->list_tail ;
    xs = tail( xs ) ;
  }
  return accu ;
}

Answer to exercise 6.13

C filter with open list and advanced pointer
char_list filter( bool (*pred)( char ), char_list xs ) {
  char_list accu = NULL ;
  char_list *last = &accu ;
  while( xs != NULL ) {
    const char x = head( xs ) ;
    if( pred( x ) ) {
      char_list new = cons( x, NULL ) ;
      *last = new ;
      last = &new->list_tail ;
    }
    xs = tail( xs ) ;
  }
  return accu ;
}

6.6: Lists versus arrays

C the same data as a list and as an array
void list_array( void ) {
  char_list list = cons('H',cons('i',
                   cons('H',cons('o',NULL)))) ;
  char array[4]  = {'H','i','H','o'};
}

6.6.1: Converting an array to a list

SML array to list with map
(* array_to_list : char array -> char_list *)
fun array_to_list s
    = let
         val l = 0
         val u = length s - 1
         fun subscript i = sub(s, i)
      in
         map subscript (l--u)
      end ;
SML array to list with foldr
(* array_to_list : char array -> char_list *)
fun array_to_list s
    = let
         val l = 0
         val u = length s - 1
         fun sub_cons i xs = Cons(sub(s, i), xs)
      in
         foldr sub_cons Nil (l -- u)
      end ;
C array to list with for loop
char_list array_to_list( char s [], int n ) {
  int l = 0 ;
  int u = n - 1 ;
  char_list list = NULL ;
  int i ;
  for( i = u; i >= l; i-- ) {
    list = cons( s[i], list ) ;
  }
  return list;
}

6.6.2: From a list to an array

SML list to array
(* list_to_array : char_list -> char array *)
fun list_to_array xs
    = let
         val n = length xs
         val u = n - 1
         val s = array(n, " ")
         fun update s i = upd(s,i,nth xs i)
      in
         foldl update s (0 -- u)
      end ;
C list to array with for loop
char * list_to_array( char_list xs ) {
  int n = length( xs ) ;
  char * array = malloc( n ) ;
  int i;
  if( array == NULL ) {
    printf( "list_to_array: no space\n" ) ;
    abort( ) ;
  }
  for( i = 0; i < n; i++ ) {
    array[i] = nth( xs, i ) ;
  }
  return array;
}
SML list to array simultaneous traversal
(* list_to_array : char_list -> char array *)
fun list_to_array xs
    = let
         val n = length xs
         val s = array(n, " ")
         fun traverse s i Nil
             = s
           | traverse s i (Cons(x,xs))
             = traverse (upd(s,i,x)) (i+1) xs
      in
         traverse s 0 xs
      end ;
C list to array with simultaneous traversal
char * list_to_array( char_list xs ) {
  int n = length( xs ) ;
  char * array = malloc( n ) ;
  int i = 0 ;
  if( array == NULL ) {
    printf( "list_to_array: no space\n" ) ;
    abort( ) ;
  }
  while( xs != NULL ) {
    array[i] = head( xs ) ;
    i = i+1 ;
    xs = tail( xs ) ;
  }
  return array;
}

Exercise 6.17

C list of blocks of characters
typedef struct string {
  char data[ 32 ] ;
  int length ;
  struct string *next ;
} *string ;

6.7: Variable number of arguments

C sum prototype, variable number of arguments
int sum( int n, ... ) ;
C calls to sum vararg
sum( 3, 5, 1, 9 ) == 15    &&
sum( 2, 314, 52 ) == 366   &&
sum( 0 ) == 0
C sum function, variable number of arguments
#include <stdarg.h>

int sum( int n, ... ) {
  int i, a ;
  int accu = 0 ;
  va_list arguments ;              /* Declaration */
  va_start( arguments, n ) ;    /* Initialisation */
  for( i=0 ; i<n ; i++ ) {
    a = va_arg( arguments, int ) ;   /* Retrieval */
    accu = accu + a ;
  }
  va_end( arguments ) ;                 /* Ending */
  return accu ;
}
C printf implementation
void printf( char *format, ... ) {
  va_list ptr ;
  int i ;
  va_start( ptr, format ) ;
  for( i=0 ; format[i] != '\0' ; i++ ) {
    if( format[i] == '%' ) {
      switch( format[i+1] ) {
        case 'd' : {
          int d = va_arg( ptr, int ) ;
          /* print the integer d */
          break ;
        }
        case 'f' : {
          double f = va_arg( ptr, double ) ;
          /* print the double f */
          break ;
        }
        /* other cases */
      }
      i++ ;
    } else {
      /* print format[i] */
    }
  }
  va_end( ptr ) ;
}

6.8: Store reuse

C free list
void free_list( char_list xs ) {
  while( xs != NULL ) {
    char_list last = xs ; /* Remember which cell to free */
    xs = tail( xs ) ;     /* First advance xs in the list */
    free( last ) ;        /* Before freeing the head */
  }
}
C append hi and ho, deallocating hi
char_list list_hi_ho( void ) {
  char_list hi = cons( 'H', cons( 'i', NULL ) ) ;
  char_list ho = cons( 'H', cons( 'o', NULL ) ) ;
  char_list hiho = append( hi, ho ) ;
  free_list( hi ) ;
  return hiho ;
}

Summary

C general form of a named struct
typedef struct s {
  /* other member declarations */
  struct s * n ;
} t ;

Further exercises

Answer to exercise 6.18

C reverse
char_list reverse( char_list x_xs ) {
  char_list accu = NULL ;
  while( x_xs != NULL ) {
    accu = cons( head( x_xs ), accu ) ;
    x_xs = tail( x_xs ) ;
  }
  return accu ;
}

Exercise 6.19

SML data type tree
datatype tree = Branch of (tree * tree)
              | Leaf   of int ;
C make leaf prototype
tree_ptr mkLeaf( int leaf ) ;
C make branch prototype
tree_ptr mkBranch( tree_ptr left, tree_ptr right ) ;
SML rotate
rotate (Branch(Leaf(1),Leaf(2)))
      = Branch(Leaf(2),Leaf(1)) ;
rotate (Leaf(0))
      = Leaf(0) ;

Exercise 6.20

SML snoc list
datatype 'a snoc_list = Snoc of ('a snoc_list * 'a)
                      | Nil ;
SML snoc list test
Snoc(Snoc(Snoc(Nil,1),2),3) ;
SML cons list test
Cons(1,Cons(2,Cons(3,Nil))) ;
SML cons list
datatype 'a list = Nil
                 | Cons of ('a * 'a list) ;
C snoc type
typedef struct snoc_struct {
  void                * snoc_tail ;
  struct snoc_struct  * snoc_head ;
} * snoc_list ;
C snoc print prototype
void sprint(void (*print) ( void * ), snoc_list l ) ;

Exercise 6.21

SML ntree
datatype ntree = Br of (ntree snoc_list)
               | Lf of int ;
SML sample ntree
val sample
  = let
       val l234 = Snoc( Snoc( Snoc( Nil, Lf 2 ),
                              Lf 3
                            ),
                        Lf 4
                      )
    in
       Br (Snoc( Snoc( Nil, Lf 1 ),
                 Br  ( l234 )
               )
          )
    end ;
C nprint prototype
void nprint( ntree t ) ;

Exercise 6.22

SML char list
datatype char_list = Nil
                   | Cons of (char * char_list) ;

(* head : char_list -> char *)
fun head (Cons(x,xs)) = x ;
C pattern match type
typedef enum { Bind, Data } tree_tag ;

typedef struct tree_struct {
  tree_tag tag ;
  union {
    struct tree_struct ** bind ;   /* Bind */
    struct data_struct {           /* Data */
      char key ;                   /* Data */
      int size ;                   /* Data */
      struct tree_struct ** data ; /* Data */
    } comp ;                       /* Data */
  } alt ;
} * tree_ptr ;
C pattern match allocator prototypes
tree_ptr mkBind( tree_ptr * b ) ;
tree_ptr mkData( char k, int s, ... ) ;
C pattern match prototype
bool match( tree_ptr pat, tree_ptr exp ) ;

Answer to exercise 6.22

C pattern match allocators
tree_ptr mkBind( tree_ptr * b ) {
  tree_ptr tree ;
  tree = malloc( sizeof( struct tree_struct ) ) ;
  tree->tag = Bind ;
  tree->alt.bind = b ;
  printf( "mkBind( %p ): %p\n", b, tree ) ;
  return tree ;
}

tree_ptr mkData( char k, int s, ... ) {
  va_list ap ;
  int i ;
  tree_ptr tree ;
  tree = malloc( sizeof( struct tree_struct ) ) ;
  tree->tag = Data ;
  tree->alt.comp.key = k ;
  tree->alt.comp.size = s ;
  tree->alt.comp.data = calloc( s, sizeof( tree_ptr ) ) ;
  printf( "mkData( %d, %d", k, s ) ;
  va_start( ap, s ) ;
  for( i = 0; i < s; i++ ) {
    tree_ptr d = va_arg( ap, tree_ptr ) ;
    tree->alt.comp.data[i] = d ;
    printf( ", %p", d ) ;
  }
  va_end( ap ) ;
  printf( " ): %p\n", tree ) ;
  return tree ;
}
C pattern match
bool match( tree_ptr pat, tree_ptr exp ) {
  switch( pat->tag ) {
    case Bind :
      * (pat->alt.bind) = exp ;
      return true ;
    case Data :
      if ( exp->tag == Data &&
           exp->alt.comp.key == pat->alt.comp.key &&
           exp->alt.comp.size == pat->alt.comp.size ) {
        int i ;
        for( i = 0; i < pat->alt.comp.size; i++ ) {
          if( ! match( pat->alt.comp.data[i],
                       exp->alt.comp.data[i] ) ) {
            return false ;
          }
        }
	return true ;
      } else {
        return false ;
      }
  }
  abort() ;
}
C pattern match main
int main( void ) {
  tree_ptr a, b, c, d ;
  tree_ptr exp = mkData( 'A', 3,
                   mkData( 'B', 0 ),
                   mkData( 'C', 0 ),
                   mkData( 'D', 3,
                     mkData( 'E', 0 ),
                     mkData( 'F', 0 ),
                     mkData( 'G', 0 ) ) ) ;
  tree_ptr pat = mkData( 'A', 3,
                   mkBind( &b ),
                   mkBind( &c ),
                   mkBind( &d ) ) ;
  if( match( pat, exp ) ) {
    printf( "1: b=%p, c=%p, d=%p\n", b, c, d ) ;
  }
  if( match( pat, b ) ) {
    printf( "2: b=%p, c=%p, d=%p\n", b, c, d ) ;
  }
  if( match( pat, c ) ) {
    printf( "3: b=%p, c=%p, d=%p\n", b, c, d ) ;
  }
  if( match( mkBind( &a ), exp ) ) {
    printf( "4: a=%p\n", a ) ;
  }
  return 0 ;
}