/* Stack, is Jsish */
var stack = [];
puts('depth:', stack.length);

stack.push(42);
stack.push('abc');
puts('depth:', stack.length);

puts('popped:', stack.pop());
if (stack.length) printf('not '); printf('empty\n');
puts('top:', stack[stack.length-1]);
puts('popped:', stack.pop());
if (stack.length) printf('not '); printf('empty\n');

puts('depth:', stack.length);


100 PROGRAM "SpiralMa.bas"
110 TEXT 80
120 INPUT PROMPT "Enter size of matrix (max. 10): ":N
130 NUMERIC A(1 TO N,1 TO N)
140 CALL INIT(A)
150 CALL WRITE(A)
160 DEF INIT(REF T)
170   LET BCOL,BROW,COL,ROW=1:LET TCOL,TROW=N:LET DIR=0
180   FOR I=0 TO N^2-1
190     LET T(COL,ROW)=I
200     SELECT CASE DIR
210     CASE 0
220       IF ROW<TROW THEN
230         LET ROW=ROW+1
240       ELSE
250         LET DIR=1:LET COL=COL+1:LET BCOL=BCOL+1
260       END IF
270     CASE 1
280       IF COL<TCOL THEN
290         LET COL=COL+1
300       ELSE
310         LET DIR=2:LET ROW=ROW-1:LET TROW=TROW-1
320       END IF
330     CASE 2
340       IF ROW>BROW THEN
350         LET ROW=ROW-1
360       ELSE
370         LET DIR=3:LET COL=COL-1:LET TCOL=TCOL-1
380       END IF
390     CASE 3
400       IF COL>BCOL THEN
410         LET COL=COL-1
420       ELSE
430         LET DIR=0:LET ROW=ROW+1:LET BROW=BROW+1
440       END IF
450     END SELECT
460   NEXT
470 END DEF
480 DEF WRITE(REF T)
490   FOR I=LBOUND(T,1) TO UBOUND(T,1)
500     FOR J=LBOUND(T,2) TO UBOUND(T,2)
510       PRINT USING " ##":T(I,J);
520     NEXT
530     PRINT
540   NEXT
550 END DEF


stack = Int[]           # []
@show push!(stack, 1)   # [1]
@show push!(stack, 2)   # [1, 2]
@show push!(stack, 3)   # [1, 2, 3]
@show pop!(stack)       # 3
@show length(stack)     # 2
@show empty!(stack)     # []
@show isempty(stack)    # true


stack:()
push:{stack::x,stack}
pop:{r:*stack;stack::1_ stack;r}
empty:{0=#stack}

/example:
stack:()
  push 3
  stack
,3
  push 5
  stack
5 3
  pop[]
5
  stack
,3
  empty[]
0
  pop[]
3
  stack
!0
  empty[]
1


public class Blah {

  public static void main(String[] args) {
    print2dArray(getSpiralArray(5));
  }

  public static int[][] getSpiralArray(int dimension) {
    int[][] spiralArray = new int[dimension][dimension];

    int numConcentricSquares = (int) Math.ceil((dimension) / 2.0);

    int j;
    int sideLen = dimension;
    int currNum = 0;

    for (int i = 0; i < numConcentricSquares; i++) {
      // do top side
      for (j = 0; j < sideLen; j++) {
        spiralArray[i][i + j] = currNum++;
      }

      // do right side
      for (j = 1; j < sideLen; j++) {
        spiralArray[i + j][dimension - 1 - i] = currNum++;
      }

      // do bottom side
      for (j = sideLen - 2; j > -1; j--) {
        spiralArray[dimension - 1 - i][i + j] = currNum++;
      }

      // do left side
      for (j = sideLen - 2; j > 0; j--) {
        spiralArray[i + j][i] = currNum++;
      }

      sideLen -= 2;
    }

    return spiralArray;
  }

  public static void print2dArray(int[][] array) {
    for (int[] row : array) {
      for (int elem : row) {
        System.out.printf("%3d", elem);
      }
      System.out.println();
    }
  }
}


// version 1.1.2

class Stack<E> {
    private val data = mutableListOf<E>()

    val size get() = data.size

    val empty get() = size == 0

    fun push(element: E) = data.add(element)

    fun pop(): E {
        if (empty) throw RuntimeException("Can't pop elements from an empty stack")
        return data.removeAt(data.lastIndex)
    }

    val top: E
        get() {
            if (empty) throw RuntimeException("Empty stack can't have a top element")
            return data.last()
        }

    fun clear() = data.clear()

    override fun toString() = data.toString()
}

fun main(args: Array<String>) {
    val s = Stack<Int>()
    (1..5).forEach { s.push(it) }
    println(s)
    println("Size of stack = ${s.size}")
    print("Popping: ")
    (1..3).forEach { print("${s.pop()} ") }
    println("\nRemaining on stack: $s")
    println("Top element is now ${s.top}")
    s.clear()
    println("After clearing, stack is ${if(s.empty) "empty" else "not empty"}")
    try {
        s.pop()
    }
    catch (e: Exception) {
        println(e.message)
    }
}


: cr  "\n" . ;
: empty?  dup execute length if 0 else -1 then swap drop ;
: pop  dup execute length 1 - extract swap drop ;
: push  dup execute rot append over ;
: s. stack execute . ;

[] '_ set
: stack '_ ;
stack                     # local variable
    1 swap push set
    2 swap push set s. cr # [    1     2  ]
    pop .           s. cr # 2     [    1  ]
    pop drop
    empty? .              # -1


spiralArray = function (edge) {
    var arr = Array(edge),
        x = 0, y = edge,
        total = edge * edge--,
        dx = 1, dy = 0,
        i = 0, j = 0;
    while (y) arr[--y] = [];
    while (i < total) {
        arr[y][x] = i++;
        x += dx; y += dy;
        if (++j == edge) {
            if (dy < 0) {x++; y++; edge -= 2}
            j = dx; dx = -dy; dy = j; j = 0;
       }
    }
    return arr;
}

// T E S T:
arr = spiralArray(edge = 5);
for (y= 0; y < edge; y++) console.log(arr[y].join(" "));


local(a) = array

#a->push('a')
#a->push('b')
#a->push('c')

#a->pop // c
#a->pop // b
#a->pop // a
#a->pop // null


global stack$
stack$=""

randomize .51
for i = 1 to 10
    if rnd(1)>0.5 then
        print  "pop => ";pop$()
    else
        j=j+1
        s$ = chr$(j + 64)
        print "push ";s$
        call push s$
    end if
next

print
print "Clean-up"
do
    print  "pop => ";pop$()
loop while not(empty())
print "Stack is empty"

end

'------------------------------------
sub push s$
    stack$=s$+"|"+stack$    'stack
end sub

function pop$()
    if stack$="" then pop$="*EMPTY*": exit function
    pop$=word$(stack$,1,"|")
    stack$=mid$(stack$,instr(stack$,"|")+1)
end function

function empty()
     empty =(stack$="")
end function


# Create an m x n matrix
 def matrix(m; n; init):
   if m == 0 then []
   elif m == 1 then [range(0;n)] | map(init)
   elif m > 0 then
     matrix(1;n;init) as $row
     | [range(0;m)] | map( $row )
   else error("matrix\(m);_;_) invalid")
   end ;

# Print a matrix neatly, each cell occupying n spaces
def neatly(n):
  def right: tostring | ( " " * (n-length) + .);
  . as $in
  | length as $length
  | reduce range (0;$length) as $i
      (""; . + reduce range(0;$length) as $j
      (""; "\(.)\($in[$i][$j] | right )" ) + "\n" ) ;

def right:
  if   . == [1,  0] then [ 0, -1]
  elif . == [0, -1] then [-1,  0]
  elif . == [-1, 0] then [ 0,  1]
  elif . == [0,  1] then [ 1,  0]
  else error("invalid direction: \(.)")
  end;


immutable Spiral
    m::Int
    n::Int
    cmax::Int
    dir::Array{Array{Int,1},1}
    bdelta::Array{Array{Int,1},1}
end

function Spiral(m::Int, n::Int)
    cmax = m*n
    dir = Array{Int,1}[[0,1], [1,0], [0,-1], [-1,0]]
    bdelta = Array{Int,1}[[0,0,0,1], [-1,0,0,0],
                          [0,-1,0,0], [0,0,1,0]]
    Spiral(m, n, cmax, dir, bdelta)
end

function spiral(m::Int, n::Int)
    0<m&&0<n || error("The matrix dimensions must be positive.")
    Spiral(m, n)
end
spiral(n::Int) = spiral(n, n)

type SpState
    cnt::Int
    dirdex::Int
    cell::Array{Int,1}
    bounds::Array{Int,1}
end

Base.length(sp::Spiral) = sp.cmax
Base.start(sp::Spiral) = SpState(1, 1, [1,1], [sp.n,sp.m,1,1])
Base.done(sp::Spiral, sps::SpState) = sps.cnt > sp.cmax

function Base.next(sp::Spiral, sps::SpState)
    s = sub2ind((sp.m, sp.n), sps.cell[1], sps.cell[2])
    if sps.cell[rem1(sps.dirdex+1, 2)] == sps.bounds[sps.dirdex]
        sps.bounds += sp.bdelta[sps.dirdex]
        sps.dirdex = rem1(sps.dirdex+1, 4)
    end
    sps.cell += sp.dir[sps.dirdex]
    sps.cnt += 1
    return (s, sps)
end


-- parent script "Stack"

property _tos

on push (me, data)
  me._tos = [#data:data, #next:me._tos]
end

on pop (me)
  if voidP(me._tos) then return VOID
  data = me._tos.data
  me._tos = me._tos.next
  return data
end

on peek (me)
  if voidP(me._tos) then return VOID
  return me._tos.data
end

on empty (me)
  return voidP(me.peek())
end


make "stack []
push "stack 1
push "stack 2
push "stack 3
print pop "stack   ; 3
print empty? :stack ; false


:- object(stack).

    :- public(push/3).
    push(Element, Stack, [Element| Stack]).

    :- public(pop/3).
    pop([Top| Stack], Top, Stack).

    :- public(empty/1)
    empty([]).

:- end_object.


// version 1.1.3

typealias Vector = IntArray
typealias Matrix = Array<Vector>

fun spiralMatrix(n: Int): Matrix {
    val result = Matrix(n) { Vector(n) }
    var pos = 0
    var count = n
    var value = -n
    var sum = -1
    do {
        value = -value / n
        for (i in 0 until count) {
            sum += value
            result[sum / n][sum % n] = pos++
        }
        value *= n
        count--
        for (i in 0 until count) {
            sum += value
            result[sum / n][sum % n] = pos++
        }
    }
    while (count > 0)
    return result
}

fun printMatrix(m: Matrix) {
    for (i in 0 until m.size) {
        for (j in 0 until m.size) print("%2d ".format(m[i][j]))
        println()
    }
    println()
}

fun main(args: Array<String>) {
    printMatrix(spiralMatrix(5))
    printMatrix(spiralMatrix(10))
}


HAI 2.3
HOW IZ I Init YR Stak
   Stak HAS A Length ITZ 0
IF U SAY SO

HOW IZ I Push YR Stak AN YR Value
  Stak HAS A SRS Stak'Z Length ITZ Value
  Stak'Z Length R SUM OF Stak'Z Length AN 1
IF U SAY SO

HOW IZ I Top YR Stak
  FOUND YR Stak'Z SRS DIFF OF Stak'Z Length AN 1
IF U SAY SO

HOW IZ I Pop YR Stak
  I HAS A Top ITZ I IZ Top YR Stak MKAY
  Stak'Z Length R DIFF OF Stak'Z Length AN 1
  FOUND YR Top
IF U SAY SO

HOW IZ I Empty YR Stak
  FOUND YR BOTH SAEM 0 AN Stak'Z Length
IF U SAY SO

I HAS A Stak ITZ A BUKKIT
I IZ Init YR Stak MKAY
I IZ Push YR Stak AN YR "Fred" MKAY
I IZ Push YR Stak AN YR "Wilma" MKAY
I IZ Push YR Stak AN YR "Betty" MKAY
I IZ Push YR Stak AN YR "Barney" MKAY

IM IN YR LOOP UPPIN YR Dummy TIL I IZ Empty YR Stak MKAY
  VISIBLE I IZ Pop YR Stak MKAY
IM OUTTA YR LOOP

KTHXBYE


stack = {}
table.insert(stack,3)
print(table.remove(stack)) --> 3


nomainwin

UpperLeftX   = 50
UpperLeftY   = 50
WindowWidth  =900
WindowHeight =930

statictext #w.st, "", 10, 850, 870, 40

open "Spiral matrix" for graphics_nsb_nf as #w

#w "trapclose [quit]"
#w "backcolor darkblue; color cyan; fill darkblue"

for N =2 to 50

    #w.st "!font courier_new "; int(  60 /N); " bold"
    #w    "down; font arial ";  int( 240 /N); " bold"

    g$ ="ruld"                                  '   direction sequence
    if N/2 =int( N/2) then pg =2 else pg =0     '   pointer to current direction
                                                '   last move is left or right depending on N even/odd
    d$ =""

    for i =1 to N -1                            '   calculate direction to move
        d$ =nChar$( i, mid$( g$, pg +1, 1)) +d$
        pg =( pg +1) mod 4
        d$ =nChar$( i, mid$( g$, pg +1, 1)) +d$
        pg =( pg +1) mod 4
    next i

    d$ =nChar$( N -1, "r") +d$                  '   first row

    #w.st "   N ="; N; "  "; d$

    xp =60 +250 /N
    yp =80 +250 /N

    stp =int( 750 /N)

    for i =0 to N^2 -1
        dir$ =mid$( d$, i, 1)
        select case dir$
            case "r"
                xp =xp +stp
            case "d"
                yp =yp +stp
            case "l"
                xp =xp -stp
            case "u"
                yp =yp -stp
        end select

        #w "place "; xp; " "; yp
        #w "\"; i
    next i

    timer 3000, [on]
    wait
  [on]
    timer 0
    #w "cls"
    scan
next N

wait

function nChar$( n, i$)
    for i =1 to n
        nChar$ =nChar$ +i$
    next i
end function

[quit]
close #w
end


Module Checkit {
      a=Stack
      Stack a {
            Push 100, 200, 300
      }
      Print StackItem(a, 1)=300
      Stack a {
            Print StackItem(1)=300
            While not empty {
                  Read N
                  Print N
            }
      }
}
Checkit


with(stack): # load the package, to allow use of short command names

s := stack:-new(a, b):

push(c, s):

# The following statements terminate with a semicolon and print output.
top(s);
pop(s);
pop(s);
empty(s);
pop(s);
empty(s);


EmptyQ[a_] := If[Length[a] == 0, True, False]
SetAttributes[Push, HoldAll];[a_, elem_] := AppendTo[a, elem]
SetAttributes[Pop, HoldAllComplete];
Pop[a_] := If[EmptyQ[a], False, b = Last[a]; Set[a, Most[a]]; b]
Peek[a_] := If[EmptyQ[a], False, Last[a]]

Example use:
stack = {};Push[stack, 1]; Push[stack, 2]; Push[stack, 3]; Push[stack, 4];
Peek[stack]
->4
Pop[stack]
->4
Peek[stack]
->3


av, sn = math.abs, function(s) return s~=0 and s/av(s) or 0 end
function sindex(y, x) -- returns the value at (x, y) in a spiral that starts at 1 and goes outwards
  if y == -x and y >= x then return (2*y+1)^2 end
  local l = math.max(av(y), av(x))
  return (2*l-1)^2+4*l+2*l*sn(x+y)+sn(y^2-x^2)*(l-(av(y)==l and sn(y)*x or sn(x)*y)) -- OH GOD WHAT
end

function spiralt(side)
  local ret, start, stop = {}, math.floor((-side+1)/2), math.floor((side-1)/2)
  for i = 1, side do
    ret[i] = {}
    for j = 1, side do
      ret[i][j] = side^2 - sindex(stop - i + 1,start + j - 1) --moves the coordinates so (0,0) is at the center of the spiral
    end
  end
  return ret
end

for i,v in ipairs(spiralt(8)) do for j, u in ipairs(v) do io.write(u .. "   ") end print() end


mystack = {};

% push
mystack{end+1} = x;

%pop
x = mystack{end};  mystack{end} = [];

%peek,top
x = mystack{end};

% empty
isempty(mystack)


/* lists can be used as stacks; Maxima provides pop and push */

load(basic)$

a: []$
push(25, a)$
push(7, a)$
pop(a);

emptyp(a);
length(a);


with(ArrayTools):

spiralArray := proc(size::integer)
 local M, sideLength, count, i, j:
 M := Matrix(size):
 count := 0:
 sideLength := size:
 for i from 1 to ceil(sideLength / 2) do
  for j from 1 to sideLength do
   M[i,i + j - 1] := count++:
  end:
  for j from 1 to sideLength - 1 do
   M[i + j, sideLength + i - 1] := count++:
  end:
  for j from 1 to sideLength - 1 do
   M[i + sideLength - 1, sideLength - j + i - 1] := count++:
  end:
  for j from 1 to sideLength - 2 do
   M[sideLength + i - j - 1, i] := count++
  end:
  sideLength -= 2:
 end:
 return M;
end proc:

spiralArray(5);


AddSquareRing[x_List/;[email protected]@Dimensions[x] && Length[Dimensions[x]]==2]:=Module[{new=x,size,smallest},
 size=Length[x];
 smallest=x[[1,1]];
 Do[
  new[[i]]=Prepend[new[[i]],smallest-i];
  new[[i]]=Append[new[[i]],smallest-3 size+i-3]
 ,{i,size}];
 PrependTo[new,Range[smallest-3size-3-size-1,smallest-3size-3]];
 AppendTo[new,Range[smallest-size-1,smallest-size-size-2,-1]];
 new
]
MakeSquareSpiral[size_Integer/;size>0]:=Module[{largest,start,times},
 start=size^2+If[Mod[size,2]==0,{{-4,-3},{-1,-2}},{{-1}}];
 times=If[Mod[size,2]==0,size/2-1,(size-1)/2];
 Nest[AddSquareRing,start,times]
]


:- module sstack.

:- interface.

% We're going to call the type sstack (simple stack) because we don't want to get it
% accidentally confused with the official stack module in the standard library.
:- type sstack(T).

:- func sstack.new = sstack(T).
:- pred sstack.is_empty(sstack(T)::in) is semidet.
:- func sstack.push(sstack(T), T) = sstack(T).
:- pred sstack.pop(T::out, sstack(T)::in, sstack(T)::out) is semidet.

:- implementation.

:- import_module list.

:- type sstack(T)
   --->  sstack(list(T)).

sstack.new = sstack([]).

sstack.is_empty(sstack([])).

sstack.push(Stack0, Elem) = Stack1 :-
   Stack0 = sstack(Elems),
   Stack1 = sstack([Elem | Elems]).

sstack.pop(Elem, !Stack) :-
   !.Stack = sstack([Elem | Elems]),
   !:Stack = sstack(Elems).

:- end_module sstack.


// Note in Miniscript, a value of zero is false,
// and any other number is true.
// therefore the .len function works as the inverse of a .empty function
stack = [2, 4, 6]
stack.push 8
print "Stack is " + stack
print "Adding '9' to stack " + stack.push(9)
print "Top of stack is " + stack.pop
print "Stack is " + stack
if stack.len then
    print "Stack is not empty"
else
    print "Stack is empty"
end if


function matrix = reverseSpiral(n)

    matrix = (-spiral(n))+n^2;

    if mod(n,2)==0
        matrix = flipud(matrix);
    else
        matrix = fliplr(matrix);
    end

end %reverseSpiral


spiral(n) := block([a, i, j, k, p, di, dj, vi, vj, imin, imax, jmin, jmax],
a: zeromatrix(n, n),
vi: [1, 0, -1, 0],
vj: [0, 1, 0, -1],
imin: 0,
imax: n,
jmin: 1,
jmax: n + 1,
p: 1,
di: vi[p],
dj: vj[p],
i: 1,
j: 1,
for k from 1 thru n*n do (
   a[j, i]: k,
   i: i + di,
   j: j + dj,
   if i < imin or i > imax or j < jmin or j > jmax then (
      i: i - di,
      j: j - dj,
      p: mod(p, 4) + 1,
      di: vi[p],
      dj: vj[p],
      i: i + di,
      j: j + dj,
      if p = 1 then imax: imax - 1
      elseif p = 2 then jmax: jmax - 1
      elseif p = 3 then imin: imin + 1
      else jmin: jmin + 1
   )
),
a
)$

spiral(5);
/* matrix([ 1,  2,  3,  4,  5],
          [16, 17, 18, 19,  6],
          [15, 24, 25, 20,  7],
          [14, 23, 22, 21,  8],
          [13, 12, 11, 10,  9]) */


class Stack
        declare internalList

        // constructor
        def Stack()
                internalList = list()
        end

        def push(val)
                internalList.append(val)
        end

        def pop()
                val = internalList[int(len($internalList) - 1)]
                internalList.remove(val)

                return val
        end

        def empty()
                return len(internalList) = 0
        end
end


public class Stack[T]
{
    private stack : list[T];

    public this()
    {
        stack = [];
    }

    public this(init : list[T])
    {
        stack = init;
    }

    public Push(item : T) : Stack[T]
    {
        Stack(item::stack)
    }

    public Pop() : T * Stack[T]
    {
        (stack.Head, Stack(stack.Tail))
    }

    public Peek() : T
    {
        stack.Head
    }

    public IsEmpty() : bool
    {
        stack.Length == 0
    }
}


/* NetRexx ************************************************************
* 13.08.2013 Walter Pachl  translated from REXX version 2
**********************************************************************/
options replace format comments java crossref savelog symbols nobinary

stk = create_stk

say push(stk,123) 'from push'
say empty(stk)
say peek(stk)     'from peek'
say pull(stk)     'from pull'
say empty(stk)
Say pull(stk)     'from pull'

method create_stk static returns Rexx
  stk = ''
  stk[0] = 0
  return stk

method push(stk,v) static
  stk[0]=stk[0]+1
  stk[stk[0]]=v
  Return v

method peek(stk) static
  x=stk[0]
  If x=0 Then
    Return 'stk is empty'
  Else
    Return stk[x]

method pull(stk) static
  x=stk[0]
  If x=0 Then
    Return 'stk is empty'
  Else Do
    stk[0]=stk[0]-1
    Return stk[x]
    End

method empty(stk) static
  Return stk[0]=0


%Spiral Matrix. Nigel Galloway, February 3rd., 2020
int: Size;
array [1..Size,1..Size] of var 1..Size*Size: spiral;
constraint spiral[1,1..]=1..Size;
constraint forall(n in 2..(Size+1) div 2)(forall(g in n..Size+1-n)(spiral[n,g]=spiral[n,g-1]+1));
constraint forall(n in 1..(Size+1) div 2)(forall(g in n+1..Size+1-n)(spiral[g,Size-n+1]=spiral[g-1,Size-n+1]+1));
constraint forall(n in 1..Size div 2)(forall(g in n..Size-n)(spiral[Size-n+1,g]=spiral[Size-n+1,g+1]+1)) /\ forall(n in 1..Size div 2)(forall(g in n+1..Size-n)(spiral[g,n]=spiral[g+1,n]+1));
output [show2d(spiral)];


/* NetRexx */
options replace format comments java crossref symbols binary

parse arg size .

if \size.datatype('W') then do
  printArray(generateArray(3))
  say
  printArray(generateArray(4))
  say
  printArray(generateArray(5))
  say
  end
else do
  printArray(generateArray(size))
  say
  end

return

-- -----------------------------------------------------------------------------
method generateArray(dimension = int) private static returns int[,]

  -- the output array
  array = int[dimension, dimension]

  -- get the number of squares, including the center one if
  -- the dimension is odd

  squares = dimension % 2 + dimension // 2

  -- length of a side for the current square
  sidelength = dimension
  current = 0

  loop i_ = 0 to squares - 1

    -- do each side of the current square
    -- top side
    loop j_ = 0 to sidelength - 1
      array[i_, i_ + j_] = current
      current = current + 1
      end j_

    -- down the right side
    loop j_ = 1 to sidelength - 1
      array[i_ + j_, dimension - 1 - i_] = current
      current = current + 1
      end j_

    -- across the bottom
    loop j_ = sidelength - 2 to 0 by -1
      array[dimension - 1 - i_, i_ + j_] = current
      current = current + 1
      end j_

    -- and up the left side
    loop j_ = sidelength - 2 to 1 by -1
      array[i_ + j_, i_] = current
      current = current + 1
      end j_

    -- reduce the length of the side by two rows
    sidelength = sidelength - 2
    end i_

  return array

-- -----------------------------------------------------------------------------
method printArray(array = int[,]) private static

  dimension = array[1].length
  rl = formatSize(array)
  loop i_ = 0 to dimension - 1
    line = Rexx("|")
    loop j_ = 0 to dimension - 1
      line = line Rexx(array[i_, j_]).right(rl)
      end j_
    line = line "|"
    say line
    end i_

  return

-- -----------------------------------------------------------------------------
method formatSize(array = int[,]) private static returns Rexx

  dim = array[1].length
  maxNum = Rexx(dim * dim - 1).length()

  return maxNum


type Stack[T] = distinct seq[T]

func initStack[T](initialSize = 32): Stack[T] =
  Stack[T](newSeq[T](initialSize))

func isEmpty[T](stack: Stack[T]): bool =
  seq[T](stack).len == 0

func push[T](stack: var Stack[T]; item: sink T) =
  seq[T](stack).add(item)

func pop[T](stack: var Stack[T]): T =
  if stack.isEmpty:
    raise newException(IndexDefect, "stack is empty.")
  seq[T](stack).pop()

func top[T](stack: Stack[T]): T =
  if stack.isEmpty:
    raise newException(IndexDefect, "stack is empty.")
  seq[T](stack)[^1]

func mtop[T](stack: var Stack[T]): var T =
  if stack.isEmpty:
    raise newException(IndexDefect, "stack is empty.")
  seq[T](stack)[^1]

func `mtop=`[T](stack: var Stack[T]; value: T) =
  if stack.isEmpty:
    raise newException(IndexDefect, "stack is empty.")
  seq[T](stack)[^1] = value

when isMainModule:

  var s = initStack[int]()
  s.push 2
  echo s.pop
  s.push 3
  echo s.top
  s.mtop += 1
  echo s.top
  s.mtop = 5
  echo s.top


MODULE Stacks;
IMPORT
  Object,
  Object:Boxed,
  Out := NPCT:Console;

TYPE
  Pool(E: Object.Object) = POINTER TO ARRAY OF E;
  Stack*(E: Object.Object) = POINTER TO StackDesc(E);
  StackDesc*(E: Object.Object) = RECORD
    pool: Pool(E);
    cap-,top: LONGINT;
  END;

  PROCEDURE (s: Stack(E)) INIT*(cap: LONGINT);
  BEGIN
    NEW(s.pool,cap);s.cap := cap;s.top := -1
  END INIT;

  PROCEDURE (s: Stack(E)) Top*(): E;
  BEGIN
    RETURN s.pool[s.top]
  END Top;

  PROCEDURE (s: Stack(E)) Push*(e: E);
  BEGIN
    INC(s.top);
    ASSERT(s.top < s.cap);
    s.pool[s.top] := e;
  END Push;

  PROCEDURE (s: Stack(E)) Pop*(): E;
  VAR
    resp: E;
  BEGIN
    ASSERT(s.top >= 0);
    resp := s.pool[s.top];DEC(s.top);
    RETURN resp
  END Pop;

  PROCEDURE (s: Stack(E)) IsEmpty(): BOOLEAN;
  BEGIN
    RETURN s.top < 0
  END IsEmpty;

  PROCEDURE (s: Stack(E)) Size*(): LONGINT;
  BEGIN
    RETURN s.top + 1
  END Size;

  PROCEDURE Test;
  VAR
    s: Stack(Boxed.LongInt);
  BEGIN
    s := NEW(Stack(Boxed.LongInt),100);
    s.Push(NEW(Boxed.LongInt,10));
    s.Push(NEW(Boxed.LongInt,100));
    Out.String("size: ");Out.Int(s.Size(),0);Out.Ln;
    Out.String("pop: ");Out.Object(s.Pop());Out.Ln;
    Out.String("top: ");Out.Object(s.Top());Out.Ln;
    Out.String("size: ");Out.Int(s.Size(),0);Out.Ln
  END Test;

BEGIN
  Test
END Stacks.


import sequtils, strutils

proc `$`(m: seq[seq[int]]): string =
  for r in m:
    let lg = result.len
    for c in r:
      result.addSep(" ", lg)
      result.add align($c, 2)
    result.add '\n'

proc spiral(n: Positive): seq[seq[int]] =
  result = newSeqWith(n, repeat(-1, n))
  var dx = 1
  var dy, x, y = 0
  for i in 0 ..< (n * n):
    result[y][x] = i
    let (nx, ny) = (x+dx, y+dy)
    if nx in 0 ..< n and ny in 0 ..< n and result[ny][nx] == -1:
      x = nx
      y = ny
    else:
      swap dx, dy
      dx = -dx
      x += dx
      y += dy

echo spiral(5)


let next_dir = function
  |  1,  0 ->  0, -1
  |  0,  1 ->  1,  0
  | -1,  0 ->  0,  1
  |  0, -1 -> -1,  0
  | _ -> assert false

let next_pos ~pos:(x,y) ~dir:(nx,ny) = (x+nx, y+ny)

let next_cell ar ~pos:(x,y) ~dir:(nx,ny) =
  try ar.(x+nx).(y+ny)
  with _ -> -2

let for_loop n init fn =
  let rec aux i v =
    if i < n then aux (i+1) (fn i v)
  in
  aux 0 init

let spiral ~n =
  let ar = Array.make_matrix n n (-1) in
  let pos = 0, 0 in
  let dir = 0, 1 in
  let set (x, y) i = ar.(x).(y) <- i in
  let step (pos, dir) =
    match next_cell ar pos dir with
    | -1 -> (next_pos pos dir, dir)
    | _ -> let dir = next_dir dir in (next_pos pos dir, dir)
  in
  for_loop (n*n) (pos, dir)
           (fun i (pos, dir) -> set pos i; step (pos, dir));
  (ar)

let print =
  Array.iter (fun line ->
    Array.iter (Printf.printf " %2d") line;
    print_newline())

let () = print(spiral 5)


stack := IntStack->New();
stack->Push(13);
stack->Push(7);
(stack->Pop() + stack->Pop())->PrintLine();
stack->IsEmpty()->PrintLine();


NSMutableArray *stack = [NSMutableArray array]; // creating

[stack addObject:value]; // pushing

id value = [stack lastObject];
[stack removeLastObject]; // popping

[stack count] == 0 // is empty?


exception Stack_empty

class ['a] stack =
  object (self)
    val mutable lst : 'a list = []

    method push x =
      lst <- x::lst

    method pop =
      match lst with
        []    -> raise Stack_empty
      | x::xs -> lst <- xs;
                 x

    method is_empty =
      lst = []
  end


ListBuffer Class new: Stack
Stack method: push  self add ;
Stack method: pop   self removeLast ;
Stack method: top   self last ;


call printArray generateArray(3)
say
call printArray generateArray(4)
say
call printArray generateArray(5)

::routine generateArray
  use arg dimension
  -- the output array
  array = .array~new(dimension, dimension)

  -- get the number of squares, including the center one if
  -- the dimension is odd
  squares = dimension % 2 + dimension // 2
  -- length of a side for the current square
  sidelength = dimension
  current = 0
  loop i = 1 to squares
      -- do each side of the current square
      -- top side
      loop j = 0 to sidelength - 1
          array[i, i + j] = current
          current += 1
      end
      -- down the right side
      loop j = 1 to sidelength - 1
          array[i + j, dimension - i + 1] = current
          current += 1
      end
      -- across the bottom
      loop j = sidelength - 2 to 0 by -1
          array[dimension - i + 1, i + j] = current
          current += 1
      end
      -- and up the left side
      loop j = sidelength - 2 to 1 by -1
          array[i + j, i] = current
          current += 1
      end
      -- reduce the length of the side by two rows
      sidelength -= 2
  end
  return array

::routine printArray
  use arg array
  dimension = array~dimension(1)
  loop i = 1 to dimension
      line = "|"
      loop j = 1 to dimension
          line = line array[i, j]~right(2)
      end
      line = line "|"
      say line
   end


(define stack #null)
(print "stack is: " stack)
(print "is stack empty: " (eq? stack #null))

(print "* pushing 1")
(define stack (cons 1 stack))
(print "stack is: " stack)
(print "is stack empty: " (eq? stack #null))

(print "* pushing 2")
(define stack (cons 2 stack))
(print "stack is: " stack)
(print "is stack empty: " (eq? stack #null))

(print "* pushing 3")
(define stack (cons 3 stack))
(print "stack is: " stack)
(print "is stack empty: " (eq? stack #null))

(print "* poping")
(define-values (value stack) (uncons stack #f))
(print "value: " value)
(print "stack: " stack)
(print "is stack empty: " (eq? stack #null))

(print "* poping")
(define-values (value stack) (uncons stack #f))
(print "value: " value)
(print "stack: " stack)
(print "is stack empty: " (eq? stack #null))

(print "* poping")
(define-values (value stack) (uncons stack #f))
(print "value: " value)
(print "stack: " stack)
(print "is stack empty: " (eq? stack #null))

(print "* poping")
(define-values (value stack) (uncons stack #f))
(print "value: " value)
(print "stack: " stack)
(print "is stack empty: " (eq? stack #null))


stack = .queue~of(123, 234)  -- creates a stack with a couple of items
stack~push("Abc")   -- pushing
value = stack~pull  -- popping
value = stack~peek  -- peeking
-- the is empty test
if stack~isEmpty then say "The stack is empty"


declare
  fun {Spiral N}
     %% create nested array
     Arr = {Array.new 1 N unit}
     for Y in 1..N do Arr.Y := {Array.new 1 N 0} end
     %% fill it recursively with increasing numbers
     C = {Counter 0}
  in
     {Fill Arr 1 N C}
     Arr
  end

  proc {Fill Arr S E C}
     %% go right
     for X in S..E do
        Arr.S.X := {C}
     end
     %% go down
     for Y in S+1..E do
        Arr.Y.E := {C}
     end
     %% go left
     for X in E-1..S;~1 do
        Arr.E.X := {C}
     end
     %% go up
     for Y in E-1..S+1;~1 do
        Arr.Y.S := {C}
     end
     %% fill the inner rectangle
     if E - S > 1 then {Fill Arr S+1 E-1 C} end
  end

  fun {Counter N}
     C = {NewCell N}
  in
     fun {$}
        C := @C + 1
     end
  end
in
  {Inspect {Spiral 5}}


function f()
  sys a=1,b=2,c=3,d=4
  push a
  push b
  push c
  push d
  print a "," b "," c "," d 'result 1,2,3,4
  a=10
  b=20
  c=30
  d=40
  print a "," b "," c "," d 'result 10,20,30,40
  pop a
  pop b
  pop c
  pop d
  print a "," b "," c "," d 'result 4,3,2,1
end function

f


functor
export
   New
   Push
   Pop
   Empty
define
   fun {New}
      {NewCell nil}
   end

   proc {Push Stack Element}
      NewStack
      %% Use atomic swap for thread safety
      OldStack = Stack := NewStack
   in
      NewStack = Element|OldStack
   end

   proc {Pop Stack ?Result}
      NewStack
      %% Use atomic swap for thread safety
      OldStack = Stack := NewStack
   in
      Result|NewStack = OldStack
   end

   fun {Empty Stack}
      @Stack == nil
   end
end


spiral(dim) = {
  my (M = matrix(dim, dim), p = s = 1, q = i = 0);
  for (n=1, dim,
    for (b=1, dim-n+1, M[p,q+=s] = i; i++);
    for (b=1, dim-n, M[p+=s,q] = i; i++);
    s = -s;
  );
  M
}


program Spiralmat;
type
  tDir = (left,down,right,up);
  tdxy = record
           dx,dy: longint;
         end;
  tdeltaDir = array[tDir] of tdxy;
const
  Nextdir : array[tDir] of tDir = (down,right,up,left);
  cDir : tDeltaDir = ((dx:1;dy:0),(dx:0;dy:1),(dx:-1;dy:0),(dx:0;dy:-1));
  cMaxN = 32;
type
  tSpiral =  array[0..cMaxN,0..cMaxN] of LongInt;

function FillSpiral(n:longint):tSpiral;
var
  b,i,k, dn,x,y : longInt;
  dir : tDir;
  tmpSp : tSpiral;
BEGIN
  b := 0;
  x := 0;
  y := 0;
  //only for the first line
  k := -1;
  dn := n-1;
  tmpSp[x,y] := b;
  dir :=  left;
  repeat
    i := 0;
    while i < dn do
    begin
      inc(b);
      tmpSp[x,y] := b;
      inc(x,cDir[dir].dx);
      inc(y,cDir[dir].dy);
      inc(i);
    end;
    Dir:= NextDir[dir];
    inc(k);
    IF k > 1 then
    begin
      k := 0;
      //shorten the line every second direction change
      dn := dn-1;
      if dn <= 0 then
        BREAK;
    end;
  until false;
  //the last
  tmpSp[x,y] := b+1;
  FillSpiral := tmpSp;
end;

var
  a : tSpiral;
  x,y,n : LongInt;
BEGIN
  For n := 1 to 5{cMaxN} do
  begin
    A:=FillSpiral(n);
    For y := 0 to n-1 do
    begin
      For x := 0 to n-1 do
        write(A[x,y]:4);
      writeln;
    end;
    writeln;
  end;
END.


push(x)=v=concat(v,[x]);;
pop()={
  if(#v,
    my(x=v[#v]);
    v=vecextract(v,1<<(#v-1)-1);
    x
  ,
    error("Stack underflow")
  )
};
empty()=v==[];
peek()={
  if(#v,
    v[#v]
  ,
    error("Stack underflow")
  )
};


{ tStack is the actual stack type, tStackNode a helper type }
type
  pStackNode = ^tStackNode;
  tStackNode = record
                next: pStackNode;
                data: integer;
               end;
  tStack = record
            top: pStackNode;
           end;

{ Always call InitStack before using a stack }
procedure InitStack(var stack: tStack);
 begin
  stack.top := nil
 end;

{ This function removes all content from a stack; call before disposing, or before a local stack variable goes out of scope }
procedure ClearStack(var stack: tStack);
 var
  node: pStackNode;
 begin
  while stack.top <> nil do
   begin
    node := stack.top;
    stack.top := stack.top^.next;
    dispose(node);
   end
 end;

function StackIsEmpty(stack: tStack):Boolean;
 begin
  StackIsEmpty := stack.top = nil
 end;

procedure PushToStack(var stack: tStack; value: integer);
 var
  node: pStackNode;
 begin
  new(node);
  node^.next := stack.top;
  node^.data := value;
  stack.top := node
 end;

{ may only be called on a non-empty stack! }
function PopFromStack(var stack: tStack): integer;
 var
  node: pStackNode;
 begin
  node := stack.top;
  stack.top := node^.next;
  PopFromStack := node^.data;
  dispose(node);
 end;


with javascript_semantics
-- comparing a simple implementation against using the builtins:
sequence stack = {}

procedure push_(object what)
    stack = append(stack,what)
end procedure

function pop_()
    object what = stack[$]
    stack = stack[1..$-1]
    return what
end function

function empty_()
    return length(stack)=0
end function

?empty_()               -- 1
push_(5)
?empty_()               -- 0
push_(6)
?pop_()                 -- 6
?pop_()                 -- 5
?empty_()               -- 1

?"===builtins==="
requires("1.0.2") -- (latest bugfixes, plus top renamed as peep, for p2js)

integer sid = new_stack()
?stack_empty(sid)       -- 1
push(sid,5)
?stack_empty(sid)       -- 0
push(sid,6)
--?peep(sid)            -- 6 (leaving it there)
?pop(sid)               -- 6
?pop(sid)               -- 5
?stack_empty(sid)       -- 1


with javascript_semantics
integer n = 6,  x = 1,  y = 0, counter = 0,
      len = n, dx = 0, dy = 1
string fmt = sprintf("%%%dd",length(sprintf("%d",n*n)))
sequence m = repeat(repeat("??",n),n)
for i=1 to 2*n do                       -- 2n runs..
    for j=1 to len do                   -- of a length...
        x += dx
        y += dy
        m[x][y] = sprintf(fmt,counter)
        counter += 1
    end for
    len -= odd(i)                       -- ..-1 every other
    {dx,dy} = {dy,-dx}                  -- in new direction
end for

printf(1,"%s\n",{join(apply(m,join),"\n")})


$stack = array();

empty( $stack ); // true

array_push( $stack, 1 ); // or $stack[] = 1;
array_push( $stack, 2 ); // or $stack[] = 2;

empty( $stack ); // false

echo array_pop( $stack ); // outputs "2"
echo array_pop( $stack ); // outputs "1"


(push 'Stack 3)
(push 'Stack 2)
(push 'Stack 1)


(load "@lib/simul.l")

(de spiral (N)
   (prog1 (grid N N)
      (let (Dir '(north east south west .)  This 'a1)
         (for Val (* N N)
            (=: val Val)
            (setq This
               (or
                  (with ((car Dir) This)
                     (unless (: val) This) )
                  (with ((car (setq Dir (cdr Dir))) This)
                     (unless (: val) This) ) ) ) ) ) ) )

(mapc
   '((L)
      (for This L (prin (align 3 (: val))))
      (prinl) )
   (spiral 5) )


/* Generates a square matrix containing the integers from 0 to N**2-1, */
/* where N is the length of one side of the square.                    */
/* Written 22 February 2010.                                           */
   declare n fixed binary;

put skip list ('Please type the size of the square:');
get list (n);

begin;
   declare A(n,n) fixed binary;
   declare (i, j, iinc, jinc, q) fixed binary;

   A = -1;

   i, j = 1; iinc = 0; jinc = 1;
   do q = 0 to n**2-1;
      if a(i,j) < 0 then
         a(i,j) = q;
      else
         do;
             /* back up */
             j = j -jinc; i = i - iinc;
             /* change direction */
             if iinc = 0 & jinc = 1 then do; iinc = 1; jinc = 0; end;
             else if iinc =  1 & jinc =  0 then do; iinc =  0; jinc = -1; end;
             else if iinc =  0 & jinc = -1 then do; iinc = -1; jinc =  0; end;
             else if iinc = -1 & jinc =  0 then do; iinc =  0; jinc =  1; end;
            /* Take one step in the new direction */
             i = i + iinc; j = j + jinc;
             a(i,j) = q;
         end;
      if i+iinc > n | i+iinc < 1 then
         do;
            iinc = 0; jinc = 1;
            if j+1 > n then jinc = -1; else if j-1 < 1 then jinc = 1;
            if a(i+iinc,j+jinc) >= 0 then jinc = -jinc;
            /* j = j + jinc; /* to move on from the present (filled) position */
         end;
      else i = i + iinc;
      if j+jinc > n | j+jinc < 1 then
         do;
            jinc = 0; iinc = 1;
            if i+1 > n then iinc = -1; else if i-1 < 1 then iinc = 1;
            if a(i+iinc,j+jinc) >= 0 then iinc = -iinc;
            i = i + iinc; /* to move on from the present (filled) position */
         end;
      else j = j + jinc;
   end;

   /* Display the square. */
   do i = 1 to n;
      put skip edit (A(i,*)) (F(4));
   end;

end;


object s = ADT.Stack();
s->push("a");
s->push("b");
write("top: %O, pop1: %O, pop2: %O\n",
      s->top(), s->pop(), s->pop());
s->reset(); // Empty the stack


/* Any controlled variable may behave as a stack. */

declare s float controlled;

/* to push a value on the stack. */
allocate s;
s = 10;

/* To pop a value from the stack. */
put (s);
free s;

/* to peek at the top of stack> */
put (s);

/* To see whether the stack is empty */
if allocation(s) = 0 then ...

/* Note: popping a value from the stack, or peeking,          */
/* would usually require a check that the stack is not empty. */

/* Note: The above is a simple stack for S. */
/* S can be any kind of data structure, an array, etc. */

/* Example to push ten values onto the stack, and then to */
/* remove them.                                           */

/* Push ten values, obtained from the input, onto the stack: */
declare S float controlled;
do i = 1 to 10;
   allocate s;
   get list (s);
end;
/* To pop those values from the stack: */
do while (allocation(s) > 0);
   put skip list (s);
   free s;
end;
/* The values are printed in the reverse order, of course. */


% empty? is already defined.
/push {exch cons}.
/pop {uncons exch pop}.
[2 3 4 5 6] 1 push
= [1 2 3 4 5 6]
[1 2 3 4 5 6] pop
=[2 3 4 5 6]
[2 3 4 5 6] empty?
=false
[] empty?
=true


function Spiral-Matrix ( [int]$N )
    {
    #  Initialize variables
    $X = 0
    $Y = -1
    $i = 0
    $Sign = 1

    #  Intialize array
    $A = New-Object 'int[,]' $N, $N

    #  Set top row
    1..$N | ForEach { $Y += $Sign; $A[$X,$Y] = ++$i }

    #  For each remaining half spiral...
    ForEach ( $M in ($N-1)..1 )
        {
        #  Set the vertical quarter spiral
        1..$M | ForEach { $X += $Sign; $A[$X,$Y] = ++$i }

        #  Curve the spiral
        $Sign = -$Sign

        #  Set the horizontal quarter spiral
        1..$M | ForEach { $Y += $Sign; $A[$X,$Y] = ++$i }
        }

    #  Convert the array to text output
    $Spiral = ForEach ( $X in 1..$N ) { ( 1..$N | ForEach { $A[($X-1),($_-1)] } ) -join "`t" }

    return $Spiral
    }

Spiral-Matrix 5
""
Spiral-Matrix 7


$stack = New-Object -TypeName System.Collections.Stack
# or
$stack = [System.Collections.Stack] @()


% push( ELEMENT, STACK, NEW )
% True if NEW is [ELEMENT|STACK]
push(ELEMENT,STACK,[ELEMENT|STACK]).

% pop( STACK, TOP, NEW )
% True if TOP and NEW are head and tail, respectively, of STACK
pop([TOP|STACK],TOP,STACK).

% empty( STACK )
% True if STACK is empty
empty([]).


%  Prolog implementation: SWI-Prolog 7.2.3

replace([_|T], 0, E, [E|T]) :- !.
replace([H|T], N, E, Xs)    :-
  succ(N1, N), replace(T, N1, E, Xs1), Xs = [H|Xs1].

% True if Xs is the Original grid with the element at (X, Y) replaces by E.
replace_in([H|T], (0, Y), E, Xs) :- replace(H, Y, E, NH), Xs = [NH|T], !.
replace_in([H|T], (X, Y), E, Xs) :-
  succ(X1, X), replace_in(T, (X1, Y), E, Xs1), Xs = [H|Xs1].

% True, if E is the value at (X, Y) in Xs
get_in(Xs, (X, Y), E) :- nth0(X, Xs, L), nth0(Y, L, E).

create(N, Mx) :-             % NxN grid full of nils
  numlist(1, N, Ns),
  findall(X, (member(_, Ns), X = nil), Ls),
  findall(X, (member(_, Ns), X = Ls), Mx).

% Depending of the direction, returns two possible coordinates and directions
% (C,D) that will be used in case of a turn, and (A,B) otherwise.
ops(right, (X,Y), (A,B), (C,D), D1, D2) :-
  A is X, B is Y+1, D1 = right, C is X+1, D is Y, D2 = down.

ops(left, (X,Y), (A,B), (C,D), D1, D2) :-
  A is X, B is Y-1, D1 = left, C is X-1, D is Y, D2 = up.

ops(up, (X,Y), (A,B), (C,D), D1, D2) :-
  A is X-1, B is Y, D1 = up, C is X, D is Y+1, D2 = right.

ops(down, (X,Y), (A,B), (C,D), D1, D2) :-
  A is X+1, B is Y, D1 = down, C is X, D is Y-1, D2 = left.

% True if NCoor is the right coor in spiral shape. Returns a new direction also.
next(Dir, Mx, Coor, NCoor, NDir) :-
  ops(Dir, Coor, C1, C2, D1, D2),
  (get_in(Mx, C1, nil) -> NCoor = C1, NDir = D1
                        ; NCoor = C2, NDir = D2).

% Returns an spiral with [H|Vs] elements called R, only work if the length of
% [H|Vs], is the square of the size of the grid.
spiralH(Dir, Mx, Coor, [H|Vs], R)  :-
 replace_in(Mx, Coor, H, NMx),
 (Vs = [] -> R = NMx
           ; next(Dir, Mx, Coor, NCoor, NDir),
             spiralH(NDir, NMx, NCoor, Vs, R)).

% True if Mx is the grid in spiral shape of the numbers from 0 to N*N-1.
spiral(N, Mx) :-
  Sq is N*N-1, numlist(0, Sq, Ns),
  create(N, EMx), spiralH(right, EMx, (0,0), Ns, Mx).


Global NewList MyStack()

Procedure Push_LIFO(n)
  FirstElement(MyStack())
  InsertElement(MyStack())
  MyStack() = n
EndProcedure

Procedure Pop_LIFO()
  If FirstElement(MyStack())
    Topmost = MyStack()
    DeleteElement(MyStack())
  EndIf
  ProcedureReturn Topmost
EndProcedure

Procedure Empty_LIFO()
  Protected Result
  If ListSize(MyStack())=0
    Result = #True
  EndIf
  ProcedureReturn Result
EndProcedure

Procedure Peek_LIFO()
  If FirstElement(MyStack())
    Topmost = MyStack()
  EndIf
  ProcedureReturn Topmost
EndProcedure

;----   Example of implementation ----
Push_LIFO(3)
Push_LIFO(1)
Push_LIFO(4)
While Not Empty_LIFO()
  Debug Pop_LIFO()
Wend


from collections import deque
stack = deque()
stack.append(value) # pushing
value = stack.pop()
not stack # is empty?


Procedure spiralMatrix(size = 1)
  Protected i, x = -1, y, count = size, n
  Dim a(size - 1,size - 1)

  For i = 1 To count
    x + 1
    a(x,y) = n
    n + 1
  Next

  Repeat
    count - 1
    For i = 1 To count
      y + 1
      a(x,y) = n
      n + 1
    Next
    For i = 1 To count
      x - 1
      a(x,y) = n
      n + 1
    Next

    count - 1
    For i = 1 To count
      y - 1
      a(x,y) = n
      n + 1
    Next
    For i = 1 To count
      x + 1
      a(x,y) = n
      n + 1
    Next
  Until count < 1

  PrintN("Spiral: " + Str(Size) + #CRLF$)
  Protected colWidth = Len(Str(size * size - 1)) + 1
  For y = 0 To size - 1
    For x = 0 To size - 1
      Print("" + LSet(Str(a(x, y)), colWidth, " ") + "")
    Next
    PrintN("")
  Next
  PrintN("")
EndProcedure

If OpenConsole()
  spiralMatrix(2)
  PrintN("")
  spiralMatrix(5)

  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
  Input()
  CloseConsole()
EndIf


[ size 1 = ] is isempty ( s --> b )

[ stack ]    is mystack (   --> s )

mystack isempty if [ say "mystack is empty" cr cr ]
23 mystack put
mystack share echo   say " is on the top of mystack" cr cr

mystack mystack put ( you can put anything on an ancillary stack, even itself! )

mystack share  echo  say " is on the top of mystack" cr cr
mystack take   echo  say " has been removed from mystack" cr cr
mystack take   echo  say " has been removed from mystack" cr cr
mystack isempty if [ say "mystack is empty" cr cr ]
say "you are in a maze of twisty little passages, all alike"


library(proto)

stack <- proto(expr = {
   l <- list()
   empty <- function(.) length(.$l) == 0
   push <- function(., x)
   {
      .$l <- c(list(x), .$l)
      print(.$l)
      invisible()
   }
   pop <- function(.)
   {
      if(.$empty()) stop("can't pop from an empty list")
      .$l[[1]] <- NULL
      print(.$l)
      invisible()
   }
})

stack$empty()
# [1] TRUE
stack$push(3)
# [[1]]
# [1] 3
stack$push("abc")
# [[1]]
# [1] "abc"
# [[2]]
# [1] 3
stack$push(matrix(1:6, nrow=2))
# [[1]]
#      [,1] [,2] [,3]
# [1,]    1    3    5
# [2,]    2    4    6
# [[2]]
# [1] "abc"
# [[3]]
# [1] 3
stack$empty()
# [1] FALSE
stack$pop()
# [[1]]
[1] "abc"
# [[2]]
# [1] 3
stack$pop()
# [[1]]
# [1] 3
stack$pop()
# list()
stack$pop()
# Error in get("pop", env = stack, inherits = TRUE)(stack, ...) :
#   can't pop from an empty list


#lang racket
(define stack '())
(define (push x stack) (cons x stack))
(define (pop stack) (values (car stack) (cdr stack)))
(define (empty? stack) (null? stack))


def spiral(n):
    dx,dy = 1,0            # Starting increments
    x,y = 0,0              # Starting location
    myarray = [[None]* n for j in range(n)]
    for i in xrange(n**2):
        myarray[x][y] = i
        nx,ny = x+dx, y+dy
        if 0<=nx<n and 0<=ny<n and myarray[nx][ny] == None:
            x,y = nx,ny
        else:
            dx,dy = -dy,dx
            x,y = x+dx, y+dy
    return myarray

def printspiral(myarray):
    n = range(len(myarray))
    for y in n:
        for x in n:
            print "%2i" % myarray[x][y],
        print

printspiral(spiral(5))


  [ stack ]                  is stepcount (     --> s )
  [ stack ]                  is position  (     --> s )
  [ stack ]                  is heading   (     --> s )

  [ heading take
    behead join
    heading put ]            is right     (     -->   )

  [ heading share 0 peek
    unrot times
      [ position share
        stepcount share
        unrot poke
        over position tally
        1 stepcount tally ]
     nip ]                   is walk      ( [ n --> [ )

  [ dip [ temp put [] ]
    temp share times
       [ temp share split
         dip
           [ nested join ] ]
    drop temp release ]      is matrixify ( n [ --> [ )

  [ 0 stepcount put      ( set up... )
    0 position put
    ' [ 1 ] over join
    -1 join over negate join
    heading put
    0 over dup * of

    over 1 - walk right  ( turtle draws spiral )
    over 1 - times
      [ i 1+ walk right
        i 1+ walk right ]
    1 walk

    matrixify            ( ...tidy up )
    heading release
    position release
    stepcount release ]      is spiral    (   n --> [ )

  9 spiral
  witheach
    [ witheach
        [ dup 10 < if sp echo sp ]
      cr ]


my @stack;          # just a array
@stack.push($elem); # add $elem to the end of @stack
$elem = @stack.pop; # get the last element back
@stack.elems == 0   # true, because the stack is empty
not @stack          # also true because @stack is false


rebol [
	Title: "Stack"
	URL: http://rosettacode.org/wiki/Stack
]

stack: make object! [
	data: copy []

	push: func [x][append data x]
	pop: func [/local x][x: last data  remove back tail data  x]
	empty: does [empty? data]

	peek: does [last data]
]

; Teeny Tiny Test Suite

assert: func [code][print [either do code ["  ok"]["FAIL"]  mold code]]

print "Simple integers:"
s: make stack []  s/push 1  s/push 2 ; Initialize.

assert [2 = s/peek]
assert [2 = s/pop]
assert [1 = s/pop]
assert [s/empty]

print [lf "Symbolic data on stack:"]
v: make stack [data: [this is a test]] ; Initialize on instance.

assert ['test = v/peek]
assert ['test = v/pop]
assert ['a = v/pop]
assert [not v/empty]


spiral <- function(n) matrix(order(cumsum(rep(rep_len(c(1, n, -1, -n), 2 * n - 1), n - seq(2 * n - 1) %/% 2))), n, byrow = T) - 1

spiral(5)


#lang racket
(require math)

(define (spiral rows columns)
  (define (index x y) (+ (* x columns) y))
  (do ((N (* rows columns))
       (spiral (make-vector (* rows columns) #f))
       (dx 1) (dy 0) (x 0) (y 0)
       (i 0 (+ i 1)))
      ((= i N) spiral)
    (vector-set! spiral (index y x) i)
    (let ((nx (+ x dx)) (ny (+ y dy)))
      (cond
       ((and (< -1 nx columns)
             (< -1 ny rows)
             (not (vector-ref spiral (index ny nx))))
        (set! x nx)
        (set! y ny))
       (else
        (set!-values (dx dy) (values (- dy) dx))
        (set! x (+ x dx))
        (set! y (+ y dy)))))))

(vector->matrix 4 4 (spiral 4 4))


: stack ( n"-  ) create 0 , allot ;
: push  ( na-  ) dup ++ dup @ + ! ;
: pop   (  a-n ) dup @ over -- + @ ;
: top   (  a-n ) dup @ + @ ;
: empty? ( a-f ) @ 0 = ;

10 stack st

1 st push
2 st push
3 st push
st empty? putn
st top putn
st pop putn st pop putn st pop putn
st empty? putn


y=123                        /*define a REXX variable, value is 123  */
push y                       /*pushes   123   onto the stack.        */
pull g                       /*pops last value stacked & removes it. */
q=empty()                    /*invokes the  EMPTY  subroutine (below)*/
exit                         /*stick a fork in it, we're done.       */

empty: return queued()       /*subroutine returns # of stacked items.*/


# Project : Stack

load "stdlib.ring"
ostack = new stack
for n = 5 to 7
     see "Push: " + n + nl
     ostack.push(n)
next
see "Pop:" + ostack.pop() + nl
see "Push: " + "8" + nl
ostack.push(8)
while len(ostack) > 0
        see "Pop:" + ostack.pop() + nl
end
if len(ostack) = 0
   see "Pop: stack is empty" + nl
ok


class Turtle {
    my @dv =  [0,-1], [1,-1], [1,0], [1,1], [0,1], [-1,1], [-1,0], [-1,-1];
    my $points = 8; # 'compass' points of neighbors on grid: north=0, northeast=1, east=2, etc.

    has @.loc = 0,0;
    has $.dir = 0;
    has %.world;
    has $.maxegg;
    has $.range-x;
    has $.range-y;

    method turn-left ($angle = 90) { $!dir -= $angle / 45; $!dir %= $points; }
    method turn-right($angle = 90) { $!dir += $angle / 45; $!dir %= $points; }

    method lay-egg($egg) {
    %!world{~@!loc} = $egg;
    $!maxegg max= $egg;
    $!range-x minmax= @!loc[0];
    $!range-y minmax= @!loc[1];
    }

    method look($ahead = 1) {
    my $there = @!loc »+« @dv[$!dir] »*» $ahead;
    %!world{~$there};
    }

    method forward($ahead = 1) {
    my $there = @!loc »+« @dv[$!dir] »*» $ahead;
    @!loc = @($there);
    }

    method showmap() {
    my $form = "%{$!maxegg.chars}s";
    my $endx = $!range-x.max;
        for $!range-y.list X $!range-x.list -> ($y, $x) {
        print (%!world{"$x $y"} // '').fmt($form);
        print $x == $endx ?? "\n" !! ' ';
    }
    }
}

# Now we can build the spiral in the normal way from outside-in like this:

sub MAIN(Int $size = 5) {
my $t = Turtle.new(dir => 2);
my $counter = 0;
$t.forward(-1);
for 0..^ $size -> $ {
    $t.forward;
    $t.lay-egg($counter++);
}
for $size-1 ... 1 -> $run {
    $t.turn-right;
    $t.forward, $t.lay-egg($counter++) for 0..^$run;
    $t.turn-right;
    $t.forward, $t.lay-egg($counter++) for 0..^$run;
}
$t.showmap;
}


stack = []
stack.push(value) # pushing
value = stack.pop # popping
stack.empty? # is empty?


dim stack$(10)   ' stack of ten
global stack$
global stackEnd

for i = 1 to 5                                      ' push 5 values to the stack
 a$ = push$(chr$(i + 64))
 print "Pushed ";chr$(i + 64);" stack has ";stackEnd
next i

print "Pop Value:";pop$();" stack has ";stackEnd  ' pop last in
print "Pop Value:";pop$();" stack has ";stackEnd  ' pop last in

e$ = mt$()                                        ' MT the stack
print "Empty stack. stack has ";stackEnd

' ------ PUSH the stack
FUNCTION push$(val$)
stackEnd = stackEnd + 1                            ' if more than 10 then lose the oldest
if stackEnd > 10 then
   for i = 0 to 9
      stack$(i) = stack$(i+1)
   next i
   stackEnd   = 10
end if
stack$(stackEnd) = val$
END FUNCTION

' ------ POP the stack -----
FUNCTION pop$()
if stackEnd = 0 then
   pop$     = "Stack is MT"
  else
   pop$     = stack$(stackEnd)                        ' pop last in
   stackEnd = max(stackEnd - 1,0)
end if
END FUNCTION

' ------ MT the stack ------
FUNCTION mt$()
  stackEnd = 0
END FUNCTION


fn main() {
    let mut stack = Vec::new();
    stack.push("Element1");
    stack.push("Element2");
    stack.push("Element3");

    assert_eq!(Some(&"Element3"), stack.last());
    assert_eq!(Some("Element3"), stack.pop());
    assert_eq!(Some("Element2"), stack.pop());
    assert_eq!(Some("Element1"), stack.pop());
    assert_eq!(None, stack.pop());
}


/*REXX program displays a spiral in a  square array  (of any size)  starting at  START. */
parse arg size start .                           /*obtain optional arguments from the CL*/
if size =='' | size ==","  then size =5          /*Not specified?  Then use the default.*/
if start=='' | start==","  then start=0          /*Not specified?  Then use the default.*/
tot=size**2;           L=length(tot + start)     /*total number of elements in spiral.  */
k=size                                           /*K:   is the counter for the spiral.  */
row=1;       col=0                               /*start spiral at    row 1,  column 0. */
                                                 /* [↓]  construct the numbered spiral. */
     do n=0  for k;    col=col + 1;   @.col.row=n + start;   end;       if k==0  then exit
                                                 /* [↑]  build the first row of spiral. */
     do until  n>=tot                                                   /*spiral matrix.*/
        do one=1  to -1  by -2  until n>=tot;   k=k-1                   /*perform twice.*/
          do n=n  for k;   row=row + one;    @.col.row=n + start;   end /*for the row···*/
          do n=n  for k;   col=col - one;    @.col.row=n + start;   end /* "   "  col···*/
        end   /*one*/                                                   /* ↑↓ direction.*/
     end      /*until n≥tot*/                    /* [↑]   done with the matrix spiral.  */
                                                 /* [↓]   display spiral to the screen. */
  do      r=1  for size;    _=   right(@.1.r, L) /*construct display   row   by    row. */
       do c=2  for size -1; _=_  right(@.c.r, L) /*construct a line  for the display.   */
       end   /*col*/                             /* [↑]  line has an extra leading blank*/
  say _                                          /*display a line (row) of the spiral.  */
  end      /*row*/                               /*stick a fork in it,  we're all done. */


class STACK{T} is
  private attr stack :LLIST{T};

  create:SAME is
    res ::= new;
    res.stack := #LLIST{T};
    return res;
  end;

  push(elt: T) is
    stack.insert_front(elt);
  end;

  pop: T is
    if ~stack.is_empty then
      stack.rewind;
      r ::= stack.current;
      stack.delete;
      return r;
    else
      raise "stack empty!\n";
    end;
  end;

  top: T is
    stack.rewind;
    return stack.current;
  end;

  is_empty: BOOL is
    return stack.is_empty;
  end;
end;


class Stack[T] {
  private var items = List[T]()

  def isEmpty = items.isEmpty

  def peek = items match {
    case List()       => error("Stack empty")
    case head :: rest => head
  }

  def pop = items match {
    case List()       => error("Stack empty")
    case head :: rest => items = rest; head
  }

  def push(value: T) = items = value +: items
}


# Project : Spiral matrix

load "guilib.ring"
load "stdlib.ring"
new qapp
        {
        win1 = new qwidget() {
                   setwindowtitle("Spiral matrix")
                   setgeometry(100,100,600,400)
                   n = 5
                   result = newlist(n,n)
                   spiral = newlist(n,n)
                   k = 1
                   top = 1
                   bottom = n
                   left = 1
                   right = n
                   while (k <= n*n)
                           for  i= left to right
                                result[top][i] = k
                                k = k + 1
                           next
                           top = top + 1
                           for i = top to bottom
                                result[i][right] = k
                                k = k + 1
                           next
                           right = right - 1
                           for i = right to left step -1
                                result[bottom][i] = k
                                k = k + 1
                           next
                           bottom = bottom - 1
                           for i = bottom to top step -1
                                result[i][left] = k
                                k = k + 1
                           next
                           left = left + 1
                   end
                   for m = 1 to n
                        for p = 1 to n
                             spiral[p][m] = new qpushbutton(win1) {
                                                  x = 150+m*40
                                                  y = 30 + p*40
                                                  setgeometry(x,y,40,40)
                                                  settext(string(result[m][p]))
                                                  }
                        next
                   next
                   show()
                   }
                   exec()
                   }


def spiral(n)
  spiral = Array.new(n) {Array.new(n, nil)}     # n x n array of nils
  runs = n.downto(0).each_cons(2).to_a.flatten  # n==5; [5,4,4,3,3,2,2,1,1,0]
  delta = [[1,0], [0,1], [-1,0], [0,-1]].cycle
  x, y, value = -1, 0, -1
  for run in runs
    dx, dy = delta.next
    run.times { spiral[y+=dy][x+=dx] = (value+=1) }
  end
  spiral
end

def print_matrix(m)
  width = m.flatten.map{|x| x.to_s.size}.max
  m.each {|row| puts row.map {|x| "%#{width}s " % x}.join}
end

print_matrix spiral(5)


(define (make-stack)
  (let ((st '()))
    (lambda (message . args)
      (case message
        ((empty?) (null? st))
        ((top) (if (null? st)
                   'empty
                   (car st)))
        ((push) (set! st (cons (car args) st)))
        ((pop) (if (null? st)
                   'empty
                   (let ((result (car st)))
                     (set! st (cdr st))
                     result)))
        (else 'badmsg)))))


$ include "seed7_05.s7i";

const func type: stack (in type: baseType) is func
  result
    var type: stackType is void;
  begin
    stackType := array baseType;

    const proc: push (inout stackType: aStack, in baseType: top) is func
      begin
         aStack := [] (top) & aStack;
      end func;

    const func baseType: pop (inout stackType: aStack) is func
      result
        var baseType: top is baseType.value;
      begin
        if length(aStack) = 0 then
          raise RANGE_ERROR;
        else
          top := aStack[1];
          aStack := aStack[2 ..];
        end if;
      end func;

    const func boolean: empty (in stackType: aStack) is
      return length(aStack) = 0;
  end func;

const type: intStack is stack(integer);

const proc: main is func
  local
    var intStack: s is intStack.value;
  begin
    push(s, 10);
    push(s, 20);
    writeln(pop(s) = 20);
    writeln(pop(s) = 10);
    writeln(empty(s));
  end func;


const VECTORS: [(isize, isize); 4] = [(1, 0), (0, 1), (-1, 0), (0, -1)];

pub fn spiral_matrix(size: usize) -> Vec<Vec<u32>> {
    let mut matrix = vec![vec![0; size]; size];
    let mut movement = VECTORS.iter().cycle();
    let (mut x, mut y, mut n) = (-1, 0, 1..);

    for (move_x, move_y) in std::iter::once(size)
        .chain((1..size).rev().flat_map(|n| std::iter::repeat(n).take(2)))
        .flat_map(|steps| std::iter::repeat(movement.next().unwrap()).take(steps))
    {
        x += move_x;
        y += move_y;
        matrix[y as usize][x as usize] = n.next().unwrap();
    }

    matrix
}

fn main() {
    for i in spiral_matrix(4).iter() {
        for j in i.iter() {
            print!("{:>2} ", j);
        }
        println!();
    }
}


class Folder(){
  var dir = (1,0)
  var pos = (-1,0)
  def apply(l:List[Int], a:Array[Array[Int]]) = {
    var (x,y) = pos  //start position
    var (dx,dy) = dir //direction
    l.foreach {e => x = x + dx; y = y + dy; a(y)(x) = e }  //copy l elements to array using current direction
    pos = (x,y)
    dir = (-dy, dx) //turn
  }
}
def spiral(n:Int) = {
  def dup(n:Int) = (1 to n).flatMap(i=>List(i,i)).toList
  val folds = n :: dup(n-1).reverse  //define fold part lengths

  var array = new Array[Array[Int]](n,n)
  val fold = new Folder()

  var seq = (0 until n*n).toList  //sequence to fold
  folds.foreach {len => fold(seq.take(len),array); seq = seq.drop(len)}
  array
}


put () into stack
repeat with each item of 1 .. 10
	push it into stack
end repeat

repeat while stack is not empty
	pop stack
	put it
end repeat


var stack = [];
stack.push(42);         # pushing
say stack.pop;          # popping
say stack.is_empty;     # is_emtpy?


collections define: #Stack &parents: {ExtensibleArray}.
"An abstraction over ExtensibleArray implementations to follow the stack
protocol. The convention is that the Sequence indices run least-to-greatest
from bottom to top."

[email protected](Stack traits) push: obj
[s addLast: obj].

[email protected](Stack traits) pop
[s removeLast].

[email protected](Stack traits) pop: n
[s removeLast: n].

[email protected](Stack traits) top
[s last].

[email protected](Stack traits) top: n
[s last: n].

[email protected](Stack traits) bottom
[s first].


$ include "seed7_05.s7i";

const type: matrix is array array integer;

const func matrix: spiral (in integer: n) is func
  result
    var matrix: myArray is matrix.value;
  local
    var integer: i is 0;
    var integer: dx is 1;
    var integer: dy is 0;
    var integer: x is 1;
    var integer: y is 1;
    var integer: nx is 0;
    var integer: ny is 0;
    var integer: swap is 0;
  begin
    myArray := n times n times 0;
    for i range 1 to n**2 do
      myArray[x][y] := i;
      nx := x + dx;
      ny := y + dy;
      if nx >= 1 and nx <= n and ny >= 1 and ny <= n and myArray[nx][ny] = 0 then
        x := nx;
        y := ny;
      else
        swap := dx;
        dx := -dy;
        dy := swap;
        x +:= dx;
        y +:= dy;
      end if;
    end for;
  end func;

const proc: writeMatrix (in matrix: myArray) is func
  local
    var integer: x is 0;
    var integer: y is 0;
  begin
    for key y range myArray do
      for key x range myArray[y] do
        write(myArray[x][y] lpad 4);
      end for;
      writeln;
    end for;
  end func;

const proc: main is func
  begin
    writeMatrix(spiral(5));
  end func;


s := Stack new.
s push: 1.
s push: 2.
s push: 3.
s pop.
s top. "2"


signature STACK =
sig
    type 'a stack
    exception EmptyStack

    val empty : 'a stack
    val isEmpty : 'a stack -> bool

    val push : ('a * 'a stack) -> 'a stack
    val pop  : 'a stack -> 'a stack
    val top  : 'a stack -> 'a
    val popTop : 'a stack -> 'a stack * 'a

    val map : ('a -> 'b) -> 'a stack -> 'b stack
    val app : ('a -> unit) -> 'a stack -> unit
end


struct Stack<T> {
    var items = [T]()
    var empty:Bool {
        return items.count == 0
    }

    func peek() -> T {
        return items[items.count - 1]
    }

    mutating func pop() -> T {
        return items.removeLast()
    }

    mutating func push(obj:T) {
        items.append(obj)
    }
}

var stack = Stack<Int>()
stack.push(1)
stack.push(2)
println(stack.pop())
println(stack.peek())
stack.pop()
println(stack.empty)


processor Stack
  @: $;

  sink push
    ..|@Stack: $;
  end push

  source peek
    [email protected](last) !
  end peek

  source pop
    ^@Stack(last) !
  end pop

  source empty
    [email protected]::length -> #
    <=0> 1 !
    <> 0 !
  end empty
end Stack

def myStack: [1] -> Stack;

2 -> !myStack::push

'$myStack::empty; $myStack::pop;
' -> !OUT::write
'$myStack::empty; $myStack::pop;
' -> !OUT::write
'$myStack::empty;
' -> !OUT::write

3 -> !myStack::push
'$myStack::empty; $myStack::peek;
' -> !OUT::write
'$myStack::empty; $myStack::pop;
' -> !OUT::write
'$myStack::empty;' -> !OUT::write


proc push {stackvar value} {
    upvar 1 $stackvar stack
    lappend stack $value
}
proc pop {stackvar} {
    upvar 1 $stackvar stack
    set value [lindex $stack end]
    set stack [lrange $stack 0 end-1]
    return $value
}
proc size {stackvar} {
    upvar 1 $stackvar stack
    llength $stack
}
proc empty {stackvar} {
    upvar 1 $stackvar stack
    expr {[size stack] == 0}
}
proc peek {stackvar} {
    upvar 1 $stackvar stack
    lindex $stack end
}

set S [list]
empty S ;# ==> 1 (true)
push S foo
empty S ;# ==> 0 (false)
push S bar
peek S ;# ==> bar
pop S ;# ==> bar
peek S ;# ==> foo


package require Tcl 8.5
namespace path {::tcl::mathop}
proc spiral size {
    set m [lrepeat $size [lrepeat $size .]]
    set x 0; set dx 0
    set y -1; set dy 1
    set i -1
    while {$i < $size ** 2 - 1} {
        if {$dy == 0} {
            incr x $dx
            if {0 <= $x && $x < $size && [lindex $m $x $y] eq "."} {
                lset m $x $y [incr i]
            } else {
                # back up and change direction
                incr x [- $dx]
                set dy [- $dx]
                set dx 0
            }
        } else {
            incr y $dy
            if {0 <= $y && $y < $size && [lindex $m $x $y] eq "."} {
                lset m $x $y [incr i]
            } else {
                # back up and  change direction
                incr y [- $dy]
                set dx $dy
                set dy 0
            }
        }
    }
    return $m
}

print_matrix [spiral 5]


init() { if [ -e stack ]; then rm stack; fi } # force pop to blow up if empty
push() { echo $1 >> stack; }
pop() {
	tail -1 stack;
	x=`head -n -1 stack | wc -c`
	if [ $x -eq '0' ]; then rm stack; else
		truncate -s `head -n -1 stack | wc -c` stack
	fi
}
empty() { head -n -1 stack |wc -l; }
stack_top() { tail -1 stack; }


init() {
  if [[ -n $KSH_VERSION ]]; then
    set -A stack
  else
    stack=(); # this sets stack to '()' in ksh
  fi
}

push() {
  stack=("$1" "${stack[@]}")
}

stack_top() {
  # this approach sidesteps zsh indexing difference
  set -- "${stack[@]}"
  printf '%s\n' "$1"
}

pop() {
  stack_top
  stack=("${stack[@]:1}")
}

empty() {
  (( ${#stack[@]} == 0 ))
}

# Demo
push fred; push wilma; push betty; push barney
printf 'peek(stack)==%s\n' "$(stack_top)"
while ! empty; do
  pop
done


5->N
DelVar [F]
{N,N}→dim([F])
1→A: N→B
1→C: N→D
0→E: E→G
1→I: 1→J
For(K,1,N*N)
K-1→[F](I,J)
If E=0: Then
If J<D: Then
J+1→J
Else: 1→G
I+1→I: A+1→A
End
End
If E=1: Then
If I<B: Then
I+1→I
Else: 2→G
J-1→J: D-1→D
End
End
If E=2: Then
If J>C: Then
J-1→J
Else: 3→G
I-1→I: B-1→B
End
End
If E=3: Then
If I>A: Then
I-1→I
Else: 0→G
J+1→J: C+1→C
End
End
G→E
End
[F]


// library: math: create: array: spiral: inwards <description></description> <version control></version control> <version>1.0.0.0.15</version> (filenamemacro=creamasi.s) [<Program>] [<Research>] [kn, ri, mo, 31-12-2012 01:15:43]
PROC PROCMathCreateArraySpiralInwards( INTEGER nI )
 // e.g. PROC Main()
 // e.g. STRING s1[255] = "5"
 // e.g. IF ( NOT ( Ask( "math: create: array: spiral: inwards: nI = ", s1, _EDIT_HISTORY_ ) ) AND ( Length( s1 ) > 0 ) ) RETURN() ENDIF
 // e.g.  PROCMathCreateArraySpiralInwards( Val( s1 ) )
 // e.g. END
 // e.g.
 // e.g. <F12> Main()
 //
 INTEGER columnEndI = 0
 //
 INTEGER columnBeginI = nI - 1
 //
 INTEGER rowEndI = 0
 //
 INTEGER rowBeginI = nI - 1
 //
 INTEGER columnI = 0
 //
 INTEGER rowI = 0
 //
 INTEGER minI = 0
 INTEGER maxI = nI * nI - 1
 INTEGER I = 0
 //
 INTEGER columnWidthI = Length( Str( nI * nI - 1 ) ) + 1
 //
 INTEGER directionRightI = 0
 INTEGER directionLeftI = 1
 INTEGER directionDownI = 2
 INTEGER directionUpI = 3
 //
 INTEGER directionI = directionRightI
 //
 FOR I = minI TO maxI
  //
  SetGlobalInt( Format( "MatrixS", columnI, ",", rowI ), I )
  // SetGlobalInt( Format( "MatrixS", columnI, ",", rowI ), I )
  //
  PutStrXY( ( Query( ScreenCols ) / 8 ) + columnI * columnWidthI, ( Query( ScreenRows ) / 8 ) + rowI, Str( I ), Color( BRIGHT RED ON WHITE ) )
  // PutStrXY( ( Query( ScreenCols ) / 8 ) + columnI * columnWidthI, ( Query( ScreenRows ) / 8 ) + rowI, Str( I + 1 ), Color( BRIGHT RED ON WHITE ) )
  //
  CASE directionI
   //
   WHEN directionRightI
    //
    IF ( columnI < columnBeginI )
     //
     columnI = columnI + 1
     //
    ELSE
     //
     directionI = directionDownI
     //
     rowI = rowI + 1
     //
     rowEndI = rowEndI + 1
     //
    ENDIF
    //
   WHEN directionDownI
    //
    IF ( rowI < rowBeginI )
     //
     rowI = rowI + 1
     //
    ELSE
     //
     directionI = directionLeftI
     //
     columnI = columnI - 1
     //
     columnBeginI = columnBeginI - 1
     //
    ENDIF
    //
   WHEN directionLeftI
    //
    IF ( columnI > columnEndI )
     //
     columnI = columnI - 1
     //
    ELSE
     //
     directionI = directionUpI
     //
     rowI = rowI - 1
     //
     rowBeginI = rowBeginI - 1
     //
    ENDIF
    //
   WHEN directionUpI
    //
    IF ( rowI > rowEndI )
     //
     rowI = rowI - 1
     //
    ELSE
     //
     directionI = directionRightI
     //
     columnI = columnI + 1
     //
     columnEndI = columnEndI + 1
     //
    ENDIF
    //
   OTHERWISE
    //
    Warn( Format( "PROCMathCreateArraySpiralInwards(", " ", "case", " ", ":", " ", Str( directionI ), ": not known" ) )
    //
    RETURN()
    //
  ENDCASE
  //
 ENDFOR
 //
END

PROC Main()
STRING s1[255] = "5"
IF ( NOT ( Ask( "math: create: array: spiral: inwards: nI = ", s1, _EDIT_HISTORY_ ) ) AND ( Length( s1 ) > 0 ) ) RETURN() ENDIF
 PROCMathCreateArraySpiralInwards( Val( s1 ) )
END


'Simple Stack class

'uses a dynamic array of Variants to stack the values
'has read-only property "Size"
'and methods "Push", "Pop", "IsEmpty"

Private myStack()
Private myStackHeight As Integer

'method Push
Public Function Push(aValue)
  'increase stack height
  myStackHeight = myStackHeight + 1
  ReDim Preserve myStack(myStackHeight)
  myStack(myStackHeight) = aValue
End Function

'method Pop
Public Function Pop()
  'check for nonempty stack
  If myStackHeight > 0 Then
    Pop = myStack(myStackHeight)
    myStackHeight = myStackHeight - 1
  Else
    MsgBox "Pop: stack is empty!"
  End If
End Function

'method IsEmpty
Public Function IsEmpty() As Boolean
  IsEmpty = (myStackHeight = 0)
End Function

'property Size
Property Get Size() As Integer
  Size = myStackHeight
End Property


class stack
	dim tos
	dim stack()
	dim stacksize

	private sub class_initialize
		stacksize = 100
		redim stack( stacksize )
		tos = 0
	end sub

	public sub push( x )
		stack(tos) = x
		tos = tos + 1
	end sub

	public property get stackempty
		stackempty = ( tos = 0 )
	end property

	public property get stackfull
		stackfull = ( tos > stacksize )
	end property

	public property get stackroom
		stackroom = stacksize - tos
	end property

	public function pop()
		pop = stack( tos - 1 )
		tos = tos - 1
	end function

	public sub resizestack( n )
		redim preserve stack( n )
		stacksize = n
		if tos > stacksize then
			tos = stacksize
		end if
	end sub
end class

dim s
set s = new stack
s.resizestack 10
wscript.echo s.stackempty
dim i
for i = 1 to 10
	s.push rnd
	wscript.echo s.stackroom
	if s.stackroom = 0 then exit for
next
for i = 1 to 10
	wscript.echo s.pop
	if s.stackempty then exit for
next


Input "Width:  ";w
Input "Height: ";h
Print

For i = 0 To h-1
  For j = 0 To w-1
    Print Using "__#"; FUNC(_Spiral(w,h,j,i));
  Next
  Print
Next
End

_Spiral Param(4)
If [email protected] Then
  Return ([email protected] + FUNC(_Spiral([email protected], [email protected], [email protected] - 1, [email protected] - [email protected] - 1)))
Else
  Return ([email protected])
EndIf


#import std
#import nat
#import int

spiral =

^H/block nleq-<lS&r+ -+
   [email protected]+ sum:-0*yK33x+ (|\LL negation**)+ rlc ~&lh==1,
   ~&rNNXNXSPlrDlSPK32^lrtxiiNCCSLhiC5D/~& iota*+ iota+-

#cast %nLLL

examples = spiral* <5,6,7>


const (
    max_depth = 256
)

struct Stack {
mut:
    data  []f32 = []f32{len: max_depth}
    depth int
}

fn (mut s Stack) push(v f32) {
    if s.depth >= max_depth {
        return
    }
    println('Push: ${v:3.2f}')
    s.data[s.depth] = v
    s.depth++
}

fn (mut s Stack) pop() ?f32 {
    if s.depth > 0 {
        s.depth--
        result := s.data[s.depth]
        println('Pop: top of stack was ${result:3.2f}')
        return result
    }
    return error('Stack Underflow!!')
}

fn (s Stack) peek() ?f32 {
    if s.depth > 0 {
        result := s.data[s.depth - 1]
        println('Peek: top of stack is ${result:3.2f}')
        return result
    }
    return error('Out of Bounds...')
}

fn (s Stack) empty() bool {
    return s.depth == 0
}

fn main() {
    mut stack := Stack{}
    println('Stack is empty? ' + if stack.empty() { 'Yes' } else { 'No' })
    stack.push(5.0)
    stack.push(4.2)
    println('Stack is empty? ' + if stack.empty() { 'Yes' } else { 'No' })
    stack.peek() or { return }
    stack.pop() or { return }
    stack.pop() or { return }
}


def (stack)
  (tag 'stack nil)

mac (push! x s) :qcase `(isa stack ,s)
  `(push! ,x (rep ,s))

mac (pop! s) :qcase `(isa stack ,s)
  `(pop! (rep ,s))

def (empty? s) :case (isa stack s)
  (empty? rep.s)


Function build_spiral(n)
	botcol = 0 : topcol = n - 1
	botrow = 0 : toprow = n - 1
	'declare a two dimensional array
	Dim matrix()
	ReDim matrix(topcol,toprow)
	dir = 0 : col = 0 : row = 0
	'populate the array
	For i = 0 To n*n-1
		matrix(col,row) = i
		Select Case dir
			Case 0
				If col < topcol Then
					col = col + 1
				Else
					dir = 1 : row = row + 1 : botrow = botrow + 1
				End If
			Case 1
				If row < toprow Then
					row = row + 1
				Else
					dir = 2 : col = col - 1 : topcol = topcol - 1
				End If
			Case 2
				If col > botcol Then
					col = col - 1
				Else
					dir = 3 : row = row - 1 : toprow = toprow - 1
				End If
			Case 3
				If row > botrow Then
					row = row - 1
				Else
					dir = 0 : col = col + 1 : botcol = botcol + 1
				End If
		End Select
	Next
	'print the array
	For y = 0 To n-1
		For x = 0 To n-1
			WScript.StdOut.Write matrix(x,y) & vbTab
		Next
		WScript.StdOut.WriteLine
	Next
End Function

build_spiral(CInt(WScript.Arguments(0)))


Option Explicit

Sub Main()
    print2dArray getSpiralArray(5)
End Sub

Function getSpiralArray(dimension As Integer) As Integer()
    ReDim spiralArray(dimension - 1, dimension - 1) As Integer

    Dim numConcentricSquares As Integer
    numConcentricSquares = dimension \ 2
    If (dimension Mod 2) Then numConcentricSquares = numConcentricSquares + 1

    Dim j As Integer, sideLen As Integer, currNum As Integer
    sideLen = dimension

    Dim i As Integer
    For i = 0 To numConcentricSquares - 1
        ' do top side
        For j = 0 To sideLen - 1
            spiralArray(i, i + j) = currNum
            currNum = currNum + 1
        Next

        ' do right side
        For j = 1 To sideLen - 1
            spiralArray(i + j, dimension - 1 - i) = currNum
            currNum = currNum + 1
        Next

        ' do bottom side
        For j = sideLen - 2 To 0 Step -1
            spiralArray(dimension - 1 - i, i + j) = currNum
            currNum = currNum + 1
        Next

        ' do left side
        For j = sideLen - 2 To 1 Step -1
            spiralArray(i + j, i) = currNum
            currNum = currNum + 1
        Next

        sideLen = sideLen - 2
    Next

    getSpiralArray = spiralArray()
End Function

Sub print2dArray(arr() As Integer)
    Dim row As Integer, col As Integer
    For row = 0 To UBound(arr, 1)
        For col = 0 To UBound(arr, 2) - 1
            Debug.Print arr(row, col),
        Next
        Debug.Print arr(row, UBound(arr, 2))
    Next
End Sub


import "/seq" for Stack

var s = Stack.new()
s.push(1)
s.push(2)
System.print("Stack contains %(s.toList)")
System.print("Number of elements in stack = %(s.count)")
var item = s.pop()
System.print("'%(item)' popped from the stack")
System.print("Last element is now %(s.peek())")
s.clear()
System.print("Stack cleared")
System.print("Is stack now empty? %((s.isEmpty) ? "yes" : "no")")


; x86_64 linux nasm

struc Stack
  maxSize: resb 8
  currentSize: resb 8
  contents:
endStruc

section .data

soError: db "Stack Overflow Exception", 10
seError: db "Stack Empty Error", 10

section .text

createStack:
; IN: max number of elements (rdi)
; OUT: pointer to new stack (rax)
  push rdi
  xor rdx, rdx
  mov rbx, 8
  mul rbx
  mov rcx, rax
  mov rax, 12
  mov rdi, 0
  syscall
  push rax
  mov rdi, rax
  add rdi, rcx
  mov rax, 12
  syscall
  pop rax
  pop rbx
  mov qword [rax + maxSize], rbx
  mov qword [rax + currentSize], 0
  ret

push:
; IN: stack to operate on (stack argument), element to push (rdi)
; OUT: void
  mov rax, qword [rsp + 8]
  mov rbx, qword [rax + currentSize]
  cmp rbx, qword [rax + maxSize]
  je stackOverflow
  lea rsi, [rax + contents + 8*rbx]
  mov qword [rsi], rdi
  add qword [rax + currentSize], 1
  ret

pop:
; pop
; IN: stack to operate on (stack argument)
; OUT: element from stack top
  mov rax, qword [rsp + 8]
  mov rbx, qword [rax + currentSize]
  cmp rbx, 0
  je stackEmpty
  sub rbx, 1
  lea rsi, [rax + contents + 8*rbx]
  mov qword [rax + currentSize], rbx
  mov rax, qword [rsi]
  ret

; stack operation exceptions
stackOverflow:
  mov rsi, soError
  mov rdx, 25
  jmp errExit
stackEmpty:
  mov rsi, seError
  mov rdx, 18
errExit:
  mov rax, 1
  mov rdi, 1
  syscall
  mov rax, 60
  mov rdi, 1
  syscall


(define-class stack
    (instance-variables vals))

(define-method (stack 'initialize)
    (setq vals '())
    self)

(define-method (stack 'push x)
    (setq vals (cons x vals)))

(define-method (stack 'pop)
    (define tos (car vals))
    (setq vals (cdr vals))
    tos)

(define-method (stack 'emptyp)
    (null vals))


import "/fmt" for Conv, Fmt

var n = 5
var top = 0
var left = 0
var bottom = n - 1
var right = n - 1
var sz = n * n
var a = List.filled(sz, 0)
var i = 0
while (left < right) {
    // work right, along top
    var c = left
    while (c <= right) {
        a[top*n+c] = i
        i = i + 1
        c = c + 1
    }
    top = top + 1
    // work down right side
    var r = top
    while (r <= bottom) {
        a[r*n+right] = i
        i = i + 1
        r = r + 1
    }
    right = right - 1
    if (top == bottom) break
    // work left, along bottom
    c = right
    while (c >= left) {
        a[bottom*n+c] = i
        i = i + 1
        c = c - 1
    }
    bottom = bottom - 1
    r = bottom
    // work up left side
    while (r >= top) {
        a[r*n+left] = i
        i = i + 1
        r = r - 1
    }
    left = left + 1
}
// center (last) element
a[top*n+left] = i

// print
var w = Conv.itoa(n*n - 1).count
i = 0
for (e in a) {
    Fmt.write("$*d ", w, e)
    if (i%n == n - 1) System.print()
    i = i + 1
}


include c:\cxpl\codes;  \intrinsic 'code' declarations
int Stack(100), SP;

proc Push(I);           \Push an integer onto the Stack
int  I;
[SP:= SP+1;
Stack(SP):= I;
]; \Push

func Pop;               \Pop an integer from the Stack
int  I;
[I:= Stack(SP);
SP:= SP-1;
return I;
]; \Pop

func Empty;             \Return 'true' if Stack is empty
return SP<0;

func Top;               \Return the integer at top of Stack
return Stack(SP);

int I;
[SP:= -1;               \initialize stack pointer
for I:= 0 to 10 do Push(I*I);
IntOut(0, Top);  CrLf(0);
while not Empty do [IntOut(0, Pop);  ChOut(0, ^ )];
CrLf(0);
]


limit = 1000
dim stack(limit)

top = 0

sub push(n)
    if top < limit then
        top = top + 1 : stack(top) = n
    else
        print "stack full - ";
    end if
end sub

sub pop()
    if top then
        top = top - 1 : return stack(top + 1)
    else
        print "stack empty - ";
    end if
end sub

sub empty()
    return not top
end sub

// ======== test ========

for n = 3 to 5
    print "Push ", n : push(n)
next

print "Pop ", pop()

print "Push ", 6 : push(6)

while(not empty())
    print "Pop ", pop()
wend

print "Pop ", pop()


def N=5;
int A(N,N);
int I, J, X, Y, Steps, Dir;
include c:\cxpl\codes;
[Clear;
I:= 0;  X:= -1;  Y:= 0;  Steps:= N;  Dir:= 0;
repeat  for J:= 1 to Steps do
                [case Dir&3 of
                  0: X:= X+1;
                  1: Y:= Y+1;
                  2: X:= X-1;
                  3: Y:= Y-1
                other [];
                A(X,Y):= I;
                Cursor(X*3,Y);  IntOut(0,I);
                I:= I+1;
                ];
        Dir:= Dir+1;
        if Dir&1 then Steps:= Steps-1;
until   Steps = 0;
Cursor(0,N);
]


; Spiral matrix in Z80 assembly (for CP/M OS - you can use `tnylpo` or `z88dk-ticks` on PC)
    OPT --syntax=abf : OUTPUT "spiralmt.com"    ; asm syntax for z00m's variant of sjasmplus
    ORG $100
spiral_matrix:
    ld a,5              ; N matrix size (argument for the code) (valid range: 1..150)
    ; setup phase
    push af
    ld l,a
    ld h,0
    add hl,hl
    ld (delta_d),hl     ; down-direction address delta = +N*2
    neg
    ld l,a
    ld h,$FF
    add hl,hl
    ld (delta_u),hl     ; up-direction address delta = -N*2
    neg
    ld hl,matrix
    ld de,2             ; delta_r value to move right in matrix
    ld bc,0             ; starting value
    dec a               ; first sequences will be N-1 long
    jr z,.finish        ; 1x1 doesn't need any sequence, just set last element
    call set_sequence   ; initial entry sequence has N-1 elements (same as two more)
    ; main loop - do twice same length sequence, then decrement length, until zero
.loop:
    call set_sequence_twice
    dec a
    jr nz,.loop
.finish:                ; whole spiral is set except last element, set it now
    ld (hl),c
    inc hl
    ld (hl),b
    ; print matrix - reading it by POP HL (destructive, plus some memory ahead of matrix too)
    pop de              ; d = N
    ld (.oldsp+1),sp
    ld sp,matrix        ; set stack to beginning of matrix (call/push does damage memory ahead)
    ld c,d              ; c = N (lines counter)
.print_rows:
    ld b,d              ; b = N (value per row counter)
.print_row:
    pop hl
    push de
    push bc
    call print_hl
    pop bc
    pop de
    djnz .print_row
    push de
    call print_crlf
    pop de
    dec c
    jr nz,.print_rows
.oldsp:
    ld sp,0
    rst 0               ; return to CP/M

print_crlf:
    ld e,10
    call print_char
    ld e,13
    jr print_char
print_hl:
    ld b,' '
    ld e,b
    call print_char
    ld de,-10000
    call extract_digit
    ld de,-1000
    call extract_digit
    ld de,-100
    call extract_digit
    ld de,-10
    call extract_digit
    ld a,l
print_digit:
    ld b,'0'
    add a,b
    ld e,a
print_char:
    push bc
    push hl
    ld c,2
    call 5
    pop hl
    pop bc
    ret
extract_digit:
    ld a,-1
.digit_loop:
    inc a
    add hl,de
    jr c,.digit_loop
    sbc hl,de
    or a
    jr nz,print_digit
    ld e,b
    jr print_char

set_sequence_twice:
    call set_sequence
set_sequence:
    ; A = length, HL = next_to_matrix, DE = delta to advance hl, BC = next_value
    push af
.set_loop:
    ld (hl),c
    inc hl
    ld (hl),b
    dec hl              ; [HL] = BC
    add hl,de           ; HL += DE
    inc bc              ; ++BC
    dec a
    jr nz,.set_loop
    push hl             ; change DE for next direction (right->down->left->up->right->...)
.d: ld hl,delta_d       ; self-modify-code: pointer to next delta
    ld e,(hl)
    inc hl
    ld d,(hl)           ; de = address delta for next sequence
    inc hl
    ld a,low delta_u+2  ; if hl == delta_u+2 => reset it back to delta_r
    cp l
    jr nz,.next_delta
    ld hl,delta_r
.next_delta:
    ld (.d+1),hl        ; self modify code pointer for next delta value
    pop hl
    pop af
    ret

delta_r:    dw      +2  ; value to add to move right in matrix
delta_d:    dw      0   ; value to add to move down in matrix (set to +N*2)
delta_l:    dw      -2  ; value to add to move left in matrix
delta_u:    dw      0   ; value to add to move up in matrix (set to -N*2)

matrix:
    ; following memory is used for NxN matrix of uint16_t values (150x150 needs 45000 bytes)


class Stack{
   var [const] stack=L();
   fcn push(x){stack.append(x); self}
   fcn pop    {stack.pop()}
   fcn empty  {(not stack.len())}
   var [proxy] isEmpty = empty;
}


with Ada.Text_IO;  use Ada.Text_IO;

procedure Test is
begin
   Put ("Quote """ & ''' & """" & Character'Val (10));
end Test;


printf(($"flip:"g"!"l$,flip));
printf(($"flop:"g"!"l$,flop));
printf(($"blank:"g"!"l$,blank));
printf(($"error char:"g"!"l$,error char));
printf(($"null character:"g"!"l$,null character))


?     A unary or dyadic operator giving 8 bit indirection.
!     A unary or dyadic operator giving 32 bit indirection.
#     As a prefix indicates a file channel number.
      As a suffix indicates a 64-bit numeric variable or constant.
$     As a prefix indicates a 'fixed string' (string indirection).
      As a suffix indicates a string variable.
%     As a prefix indicates a binary constant e.g. %11101111.
      As a suffix indicates an integer (signed 32-bit) variable.
&     As a prefix indicates a hexadecimal constant e.g. &EF.
      As a suffix indicates a byte (unsigned 8-bit) variable.
'     Causes an additional new-line in PRINT or INPUT.
;     Suppresses a forthcoming action, e.g. the new-line in PRINT.
@     A prefix character for 'system' variables.
^     A unary operator returning a pointer (address of an object).
      The dyadic exponentiation (raise to the power) operator.
\     The line continuation character, to split code across lines.
[ ]   Delimiters for assembler statements.
{ }   Indicates a structure.
~     Causes conversion to hexadecimal, in PRINT and STR$.
|     A unary operator giving floating-point indirection.
      A delimiter in the VDU statement.


  10   \ single cell number
  -10  \ negative single cell number
  10.  \ double cell number
  10e  \ floating-point number


C  or c in column one mark a comment line.
D  or d in column one mark a debugging statement, ignored or compiled according to an option set at compile time.
*  in column one for compiler control statements (e.g. Fortran II, Fortran IV)
0  in column six does not indicate a continuation line, even though not a blank.
   Space: ignored within source outside text literals, even between parts of a word. Allows G O  TO
'  Delimits a text literal. Also has been used in READ(F'N) to read record N of the file attached to F.
"  Delimits a text literal. Doubling required for each contained in the literal.
!  Outside a text literal marks an "escape comment" - only text before it on the line will be compiled. The B6700 used % for this.
&  Outside a text literal indicated that further source is continued on the next line.


-- comment here until end of line
{- comment here -}


\b backspace
\d delete
\e escape
\f formfeed
\l linefeed
\n newline
\r return
\t horizontal tab
\v vertical tab
\' single quote
\" double quote
\\ backslash
\ddd octal code
\xdd hexadecimal code
\^c control code


   ''      NB. empty string

   ''''    NB. one quote character
'
   ''''''  NB. two quote characters
''


& | ^ ~ //bitwise AND, OR, XOR, and NOT
>> << //bitwise arithmetic shift
>>> //bitwise logical shift
+ - * / = % //+ can be used for String concatenation)


#	defined local ie. #mylocal will fail if not defined
$	defined variable ie. $myvar will fail if not defined
=	assignment
:=	assign as return assigned value
?	ternary conditional true ? this
|	ternary else false ? this | that
||	or
&&	and
!	negative operator
{	open capture
}	close capture
=>	specify givenblock / capture
->	invoke method: mytype->mymethod
&  	retarget: mytype->mymethod&  // returns mytype
^	autocollect from capture: {^ 'this will be outputted' ^}
::	tag prefix, ie. ::mytype->gettype // returns myype
::	type constraint, ie. define mymethod(p::integer) => #i * 2
\	escape method: ie. \mymethod->invoke(2)
// comment
/* open comment
*/ close comment


\documentclass{minimal}
\begin{document}
5\% of \$10
\end{document}


str = "Hello " & QUOTE & "world!" & QUOTE
put str
-- "Hello "world!""


Markup :
()   Sequence
{}   List
"    String
\    Escape for following character
(* *) Comment block
base^^number`s
`    Context
[[]] Indexed reference

Within expression:
\        At end of line: Continue on next line, skipping white space


USER>Set S1="Hello, World!"  Write S1
Hello, World!
USER>Set S2=""Hello, World!"" Write S2

SET S2=""Hello, World!"" Write S2
^
<SYNTAX>
USER>Set S3="""Hello, World!"" she typed." Write S3
"Hello, World!" she typed.
USER>Set S4="""""""Wow""""""" Write S4
"""Wow"""


var f = open(r"C:\texts\text.txt") # a raw string, so ``\t`` is no tab


;   Comment (to end of line)
-   Introduces a negative number (not used for subtraction)
=   Load an include file or define a macro
&   Prefix for a method
%   Prefix for a global variable
!   Prefix for an object
.   Prefix for a property
'   Prefix for a vocabulary word
?   Prefix for a class; check if an object is of this class
*   Prefix for a class; create a new object of this class
:   Prefix for a label; define the label
/   Prefix for a label; jump if true
\   Prefix for a label; jump if false
|   Prefix for a label; jump unconditionally
,   Prefix for a local variable or argument
[   Begin a declaration heading or phrase
]   End a declaration heading or phrase
(   Begin a dispatch method
)   End a dispatch method
<   Read through a pointer
>   Write through a pointer
+   The object that the method was called on
"   Begin string literal
{   Begin string literal
~   Special (used for advanced macros)
^   Suffix for pointer types
@   Suffix for object type
#   Suffix for integer type
$   Suffix for string type


\b     //Backspace
\n     //Line Feed
\r     //Carriage Return
\t     //Tab
\0     //Null
\'     //Single Quote
\"     //Double Q


\\     backslash
\"     double quote
\'     single quote
\n     line feed
\r     carriage return
\t     tab
\b     backspace
\  (backslash followed by a space) space
\DDD   where D is a decimal digit; the character with code DDD in decimal
\xHH   where H is a hex digit; the character with code HH in hex


   #[]\(){}',|`

   ()   List
   []{} Reserved for feature use
   #\   Character constant
   '    Quote
   `    Backquote
   ,    Unquote
   |    Used by code blocks (like multiline comment, symbol name container)


Delimiters #$:.%\^
Operators , = := == != < <= > >= @= @== @!= @< @<= @> @>= + - * / += -= *= /= @+= @-= @*= @/= .. & &= ? ; : |
Braces ()[]{}
BlockComment /* */ --/* --*/
LineComment --
TokenStart abcedfghijklmnopqrstuvwxyz
TokenStart ABCDEFGHIJKLMNOPQRSTUVWXYZ_
TokenChar 0123456789
Escapes \rnt\'"eE#x0buU


Markup:
   () []    List
   .        Dotted pair (when surounded by white space)
   "        Transient symbol (string)
   {}       External symbol (database object)
   \        Escape for following character
   #        Comment line
   #{ }#    Comment block

Read macros:
   '        The 'quote' function
   `        Evaluate and insert a list element
   ~        Evaluate and splice a partial list
   ,        Indexed reference

Within strings:
   ^        ASCII control character
   \        At end of line: Continue on next line, skipping white space


'John''s pen' which is stored as <<John's pen>>
"He said ""Go!"" and opened the door" which is stored as <<He said "Go!" and opened the door>>


a=1             ; The ';' indicates that a comment starts
b=2*a:  a=b*33  ; b will now be 2, and a=66


    $   Item
    @	Positional
    %	Associative
    &	Callable


  if a¬==b      then say 'not equal'
  if a ¬== b    then say 'not equal'
  if a ¬ = = b  then say 'not equal'
  if a ¬ ,
         = = b  then say 'not equal'


    audible alert    BEL      \a    backslash    (\)   \\
    backspace        BS       \b    apostrophe   (')   \'
    escape           ESC      \e    double quote (")   \"
    formfeed         FF       \f
    newline          NL (LF)  \n    control-A          \A
    carriage return  CR       \r      ...
    horizontal tab   HT       \t    control-Z          \Z
    vertical tab     VT       \v


' '  String literal
" "  Identifier
[ ]  Identifier
` `  Identifier
?    Numbered host parameter
:    Named host parameter
$    Named host parameter
@    Named host parameter
( )  Parentheses
+    Add
-    Subtract/negative
*    Multiply
/    Divide
%    Modulo
&    Bitwise AND
|    Bitwise OR
~    Bitwise NOT
<<   Left shift
>>   Right shift
=    Equal
==   Equal
<>   Not equal
!=   Not equal
<    Less
>    Greater
<=   Less or equal
>=   Greater or equal
||   String concatenation


{...}     ;# group in one word, without substituting content; nests
"..."     ;# group in one word, with substituting content
[...]     ;# evaluate content as script, then substitute with its result; nests
$foo      ;# substitute with content of variable foo
$bar(foo) ;# substitute with content of element 'foo' of array 'bar'
\a        ;# audible alert (bell)
\b        ;# backspace
\f        ;# form feed
\n        ;# newline
\r        ;# carriage return
\t        ;# Tab
\v        ;# vertical tab
\\        ;# backslash
\ooo      ;# the Unicode with octal value 'ooo'
\xhh      ;# the character with hexadecimal value 'hh'
\uhhhh    ;# the Unicode with hexadecimal value 'hhhh'
#         ;# if first character of a word expected to be a command, begin comment
          ;# (extends till end of line)
{*}       ;# if first characters of a word, interpret as list of words to substitute,
          ;# not single word (introduced with Tcl 8.5)


V guyprefers = [‘abe’ = [‘abi’, ‘eve’, ‘cath’, ‘ivy’, ‘jan’, ‘dee’, ‘fay’, ‘bea’, ‘hope’, ‘gay’],
                ‘bob’ = [‘cath’, ‘hope’, ‘abi’, ‘dee’, ‘eve’, ‘fay’, ‘bea’, ‘jan’, ‘ivy’, ‘gay’],
                ‘col’ = [‘hope’, ‘eve’, ‘abi’, ‘dee’, ‘bea’, ‘fay’, ‘ivy’, ‘gay’, ‘cath’, ‘jan’],
                ‘dan’ = [‘ivy’, ‘fay’, ‘dee’, ‘gay’, ‘hope’, ‘eve’, ‘jan’, ‘bea’, ‘cath’, ‘abi’],
                ‘ed’  = [‘jan’, ‘dee’, ‘bea’, ‘cath’, ‘fay’, ‘eve’, ‘abi’, ‘ivy’, ‘hope’, ‘gay’],
                ‘fred’= [‘bea’, ‘abi’, ‘dee’, ‘gay’, ‘eve’, ‘ivy’, ‘cath’, ‘jan’, ‘hope’, ‘fay’],
                ‘gav’ = [‘gay’, ‘eve’, ‘ivy’, ‘bea’, ‘cath’, ‘abi’, ‘dee’, ‘hope’, ‘jan’, ‘fay’],
                ‘hal’ = [‘abi’, ‘eve’, ‘hope’, ‘fay’, ‘ivy’, ‘cath’, ‘jan’, ‘bea’, ‘gay’, ‘dee’],
                ‘ian’ = [‘hope’, ‘cath’, ‘dee’, ‘gay’, ‘bea’, ‘abi’, ‘fay’, ‘ivy’, ‘jan’, ‘eve’],
                ‘jon’ = [‘abi’, ‘fay’, ‘jan’, ‘gay’, ‘eve’, ‘bea’, ‘dee’, ‘cath’, ‘ivy’, ‘hope’]]
V galprefers = [‘abi’ = [‘bob’, ‘fred’, ‘jon’, ‘gav’, ‘ian’, ‘abe’, ‘dan’, ‘ed’, ‘col’, ‘hal’],
                ‘bea’ = [‘bob’, ‘abe’, ‘col’, ‘fred’, ‘gav’, ‘dan’, ‘ian’, ‘ed’, ‘jon’, ‘hal’],
                ‘cath’= [‘fred’, ‘bob’, ‘ed’, ‘gav’, ‘hal’, ‘col’, ‘ian’, ‘abe’, ‘dan’, ‘jon’],
                ‘dee’ = [‘fred’, ‘jon’, ‘col’, ‘abe’, ‘ian’, ‘hal’, ‘gav’, ‘dan’, ‘bob’, ‘ed’],
                ‘eve’ = [‘jon’, ‘hal’, ‘fred’, ‘dan’, ‘abe’, ‘gav’, ‘col’, ‘ed’, ‘ian’, ‘bob’],
                ‘fay’ = [‘bob’, ‘abe’, ‘ed’, ‘ian’, ‘jon’, ‘dan’, ‘fred’, ‘gav’, ‘col’, ‘hal’],
                ‘gay’ = [‘jon’, ‘gav’, ‘hal’, ‘fred’, ‘bob’, ‘abe’, ‘col’, ‘ed’, ‘dan’, ‘ian’],
                ‘hope’= [‘gav’, ‘jon’, ‘bob’, ‘abe’, ‘ian’, ‘dan’, ‘hal’, ‘ed’, ‘col’, ‘fred’],
                ‘ivy’ = [‘ian’, ‘col’, ‘hal’, ‘gav’, ‘fred’, ‘bob’, ‘abe’, ‘ed’, ‘jon’, ‘dan’],
                ‘jan’ = [‘ed’, ‘hal’, ‘gav’, ‘abe’, ‘bob’, ‘jon’, ‘col’, ‘ian’, ‘fred’, ‘dan’]]

V guys = sorted(guyprefers.keys())
V gals = sorted(galprefers.keys())

F check(engaged)
   V inverseengaged = Dict(engaged.map((k, v) -> (v, k)))
   L(she, he) engaged
      V shelikes = :galprefers[she]
      V shelikesbetter = shelikes[0 .< shelikes.index(he)]
      V helikes = :guyprefers[he]
      V helikesbetter = helikes[0 .< helikes.index(she)]
      L(guy) shelikesbetter
         V guysgirl = inverseengaged[guy]
         V guylikes = :guyprefers[guy]
         I guylikes.index(guysgirl) > guylikes.index(she)
            print(‘#. and #. like each other better than their present partners: #. and #., respectively’.format(she, guy, he, guysgirl))
            R 0B
      L(gal) helikesbetter
         V girlsguy = engaged[gal]
         V gallikes = :galprefers[gal]
         I gallikes.index(girlsguy) > gallikes.index(he)
            print(‘#. and #. like each other better than their present partners: #. and #., respectively’.format(he, gal, she, girlsguy))
            R 0B
   R 1B

F matchmaker()
   V guysfree = copy(:guys)
   [String = String] engaged
   V guyprefers2 = copy(:guyprefers)
   V galprefers2 = copy(:galprefers)
   L !guysfree.empty
      V guy = guysfree.pop(0)
      V& guyslist = guyprefers2[guy]
      V gal = guyslist.pop(0)
      V fiance = engaged.get(gal, ‘’)
      I fiance == ‘’
         engaged[gal] = guy
         print(‘  #. and #.’.format(guy, gal))
      E
         V galslist = galprefers2[gal]
         I galslist.index(fiance) > galslist.index(guy)
            engaged[gal] = guy
            print(‘  #. dumped #. for #.’.format(gal, fiance, guy))
            I !guyprefers2[fiance].empty
               guysfree.append(fiance)
         E
            I !guyslist.empty
               guysfree.append(guy)
   R engaged

print("\nEngagements:")
V engaged = matchmaker()

print("\nCouples:")
print(‘  ’sorted(engaged.items()).map((couple_key, couple_val) -> ‘#. is engaged to #.’.format(couple_key, couple_val)).join(",\n  "))
print()
print(I check(engaged) {‘Engagement stability check PASSED’} E ‘Engagement stability check FAILED’)

print("\n\nSwapping two fiances to introduce an error")
swap(&engaged[gals[0]], &engaged[gals[1]])
L(gal) gals[0.<2]
   print(‘  #. is now engaged to #.’.format(gal, engaged[gal]))
print()
print(I check(engaged) {‘Engagement stability check PASSED’} E ‘Engagement stability check FAILED’)