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

//   public release som-v2  30 Dec 2004

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

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

to setcar a value = cell[a] = value
to setcdr a value = cell[a+1] = value
to car a = if a == NIL a else cell[a]
to cdr a = if a == NIL a else cell[a+1]

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

// switch the half space
to initcell =
	if endcell == MAXCELL
		freecell = CELLPTR
		endcell = MAXCELL / 2
	else
		freecell = endcell + 1
		endcell = MAXCELL

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 lst
	a = lst
	b = cdr a
	while b != NIL
		a = b
		b = cdr a
	setcdr a (list x)
	lst

to item2 x = car cdr x
to item3 x = car cdr cdr x

// 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

// End
