// list-s.txt    list processing
//   implement list.c  for som-som project  14 Jan 2004
//   P. Chongstitvatana

//   public release som v3.0  5 March 2007 (Maka-bucha day)
//   public release som v3.1  19 Aug 2007 (Draft vote day)
//   public release som v4.0  2 July 2008

enum
    10 CELLPTR			// min pointer to acell
enum
    100000 MAXCELL

to init_list =
    cell = array MAXCELL
    freecell = CELLPTR
    endcell = MAXCELL - 2

: setcar a value =
    cell[a] = value

: setcdr a value =
    cell[a+1] = value

//: car a = if a == NIL a else cell[a]
//: cdr a = if a == NIL a else cell[a+1]
: car a = cell[a]
: cdr a = cell[a+1]
to item2 x = car cdr x
to item3 x = car cdr cdr x

to newcell | a =
    a = freecell
    freecell = freecell + 2
    if freecell >= endcell
        seterror "out of memory cell"
    else
        setcar a NIL
        setcdr a NIL
    a

to islist x = (car x) >= CELLPTR
to isatom x = (car x) < CELLPTR

to newatom type value | a =
    a = newcell
    setcar a type
    setcdr a value
    a

to list a | b =
    b = newcell
    setcar b a
    b

to cons a l | b =
    b = newcell
    setcdr b l
    setcar b a
    b

to append lst x | a b =
    if x != NIL
        a = lst
        b = cdr a
        while b != NIL
            a = b
            b = cdr a
        setcdr a (list x)
    lst


// can cons2 be used instead of cons ?  31 Mar 2004

// cons2 x, y = {NIL, atom, list}
to cons2 x y | z =
    if x == NIL
        y break
    if y == NIL
        list x break
    // it is the same whether x is atom of list
    // a new cell is required to build a dot-pair
    // only y must be inspected, if it is not a list
    // a new dot-pair to make y a list is needed
    if isatom y
        z = newatom y NIL
    else
        z = y
    newatom x z

// clone a copy of list t
to copylist t =
    if t == NIL
        NIL
        break
    if isatom t
        newatom (car t) (cdr t)
    else
        cons2 (copylist car t) (copylist cdr t)

to countcell | k =
    k = (MAXCELL - freecell) / 2
    prints "+freecell = " print k nl

// data structure of type lis
// is an one-dimension vector with element 0 storing its size
// total space of vector is size+1

to addlis lis x | n =
    n = lis[0] + 1
    lis[n] = x
    lis[0] = n

: clearlis lis = lis[0] = 0
: sizeoflis lis = lis[0]

to countlis lis | i n =
    n = 0
    for i 1 (sizeoflis lis)
        if lis[i] != 0
            n = n + 1
    n

// End
