MODE VALUE = INT;
PROC value repr = (VALUE value)STRING: whole(value, 0);

MODE NODES = STRUCT ( VALUE value, REF NODES left, right);
MODE NODE = REF NODES;

PROC tree = (VALUE value, NODE left, right)NODE:
  HEAP NODES := (value, left, right);

PROC preorder = (NODE node, PROC (VALUE)VOID action)VOID:
  IF node ISNT NODE(NIL) THEN
    action(value OF node);
    preorder(left OF node, action);
    preorder(right OF node, action)
  FI;

PROC inorder = (NODE node, PROC (VALUE)VOID action)VOID:
  IF node ISNT NODE(NIL) THEN
    inorder(left OF node, action);
    action(value OF node);
    inorder(right OF node, action)
  FI;

PROC postorder = (NODE node, PROC (VALUE)VOID action)VOID:
  IF node ISNT NODE(NIL) THEN
    postorder(left OF node, action);
    postorder(right OF node, action);
    action(value OF node)
  FI;

PROC destroy tree = (NODE node)VOID:
  postorder(node, (VALUE skip)VOID:
  # free(node) - PR garbage collect hint PR #
    node := (SKIP, NIL, NIL)
  );

# helper queue for level order #
MODE QNODES = STRUCT (REF QNODES next, NODE value);
MODE QNODE = REF QNODES;

MODE QUEUES = STRUCT (QNODE begin, end);
MODE QUEUE = REF QUEUES;

PROC enqueue = (QUEUE queue, NODE node)VOID:
(
  HEAP QNODES qnode := (NIL, node);
  IF end OF queue ISNT QNODE(NIL) THEN
    next OF end OF queue
  ELSE
    begin OF queue
  FI := end OF queue := qnode
);

PROC queue empty = (QUEUE queue)BOOL:
  begin OF queue IS QNODE(NIL);

PROC dequeue = (QUEUE queue)NODE:
(
  NODE out := value OF begin OF queue;
  QNODE second := next OF begin OF queue;
# free(begin OF queue); PR garbage collect hint PR #
  QNODE(begin OF queue) := (NIL, NIL);
  begin OF queue := second;
  IF queue empty(queue) THEN
    end OF queue := begin OF queue
  FI;
  out
);

PROC level order = (NODE node, PROC (VALUE)VOID action)VOID:
(
  HEAP QUEUES queue := (QNODE(NIL), QNODE(NIL));
  enqueue(queue, node);
  WHILE NOT queue empty(queue)
  DO
    NODE next := dequeue(queue);
    IF next ISNT NODE(NIL) THEN
      action(value OF next);
      enqueue(queue, left OF next);
      enqueue(queue, right OF next)
    FI
  OD
);

PROC print node = (VALUE value)VOID:
  print((" ",value repr(value)));

main: (
  NODE node := tree(1,
                tree(2,
                     tree(4,
                          tree(7, NIL, NIL),
                          NIL),
                     tree(5, NIL, NIL)),
                tree(3,
                     tree(6,
                          tree(8, NIL, NIL),
                          tree(9, NIL, NIL)),
                     NIL));

  MODE TEST = STRUCT(
    STRING name,
    PROC(NODE,PROC(VALUE)VOID)VOID order
  );

  PROC test = (TEST test)VOID:(
    STRING pad=" "*(12-UPB name OF test);
    print((name OF test,pad,": "));
    (order OF test)(node, print node);
    print(new line)
  );

  []TEST test list = (
    ("preorder",preorder),
    ("inorder",inorder),
    ("postorder",postorder),
    ("level order",level order)
  );

  FOR i TO UPB test list DO test(test list[i]) OD;

  destroy tree(node)
)


preorder ← {l r←⍺ ⍵⍵ ⍵ ⋄ (⊃r)∇⍨⍣(×≢r)⊢(⊃l)∇⍨⍣(×≢l)⊢⍺ ⍺⍺ ⍵}
inorder  ← {l r←⍺ ⍵⍵ ⍵ ⋄ (⊃r)∇⍨⍣(×≢r)⊢⍵ ⍺⍺⍨(⊃l)∇⍨⍣(×≢l)⊢⍺}
postorder← {l r←⍺ ⍵⍵ ⍵ ⋄ ⍵ ⍺⍺⍨(⊃r)∇⍨⍣(×≢r)⊢(⊃l)∇⍨⍣(×≢l)⊢⍺}
lvlorder ← {0=⍴⍵:⍺ ⋄ (⊃⍺⍺⍨/(⌽⍵),⊂⍺)∇⊃∘(,/)⍣2⊢⍺∘⍵⍵¨⍵}


on run
    -- Sample tree of integers
    set tree to node(1, ¬
        {node(2, ¬
            {node(4, {node(7, {})}), ¬
                node(5, {})}), ¬
            node(3, ¬
                {node(6, {node(8, {}), ¬
                    node(9, {})})})})

    -- Output of AppleScript code at Rosetta Code task
    -- 'Visualize a Tree':
    set strTree to unlines({¬
        "       ┌ 4 ─ 7", ¬
        "   ┌ 2 ┤", ¬
        "   │   └ 5", ¬
        " 1 ┤", ¬
        "   │       ┌ 8", ¬
        "   └ 3 ─ 6 ┤", ¬
        "           └ 9"})

    script tabulate
        on |λ|(s, xs)
            justifyRight(14, space, s & ": ") & unwords(xs)
        end |λ|
    end script

    set strResult to strTree & linefeed & unlines(zipWith(tabulate, ¬
        ["preorder", "inorder", "postorder", "level-order"], ¬
        apList([¬
            foldTree(preorder), ¬
            foldTree(inorder), ¬
            foldTree(postorder), ¬
            levelOrder], [tree])))

    set the clipboard to strResult
    return strResult
end run

---------------------- TREE TRAVERSAL ----------------------

-- preorder :: a -> [[a]] -> [a]
on preorder(x, xs)
    {x} & concat(xs)
end preorder

-- inorder :: a -> [[a]] -> [a]
on inorder(x, xs)
    if {} ≠ xs then
        item 1 of xs & x & concat(rest of xs)
    else
        {x}
    end if
end inorder

-- postorder :: a -> [[a]] -> [a]
on postorder(x, xs)
    concat(xs) & {x}
end postorder

-- levelOrder :: Tree a -> [a]
on levelOrder(tree)
    concat(levels(tree))
end levelOrder

-- foldTree :: (a -> [b] -> b) -> Tree a -> b
on foldTree(f)
    script
        on |λ|(tree)
            script go
                property g : |λ| of mReturn(f)
                on |λ|(oNode)
                    g(root of oNode, |λ|(nest of oNode) ¬
                        of map(go))
                end |λ|
            end script
            |λ|(tree) of go
        end |λ|
    end script
end foldTree

------------------------- GENERIC --------------------------

-- Node :: a -> [Tree a] -> Tree a
on node(v, xs)
    {type:"Node", root:v, nest:xs}
end node

-- e.g. [(*2),(/2), sqrt] <*> [1,2,3]
-- -->  ap([dbl, hlf, root], [1, 2, 3])
-- -->  [2,4,6,0.5,1,1.5,1,1.4142135623730951,1.7320508075688772]

-- Each member of a list of functions applied to
-- each of a list of arguments, deriving a list of new values
-- apList (<*>) :: [(a -> b)] -> [a] -> [b]
on apList(fs, xs)
    set lst to {}
    repeat with f in fs
        tell mReturn(contents of f)
            repeat with x in xs
                set end of lst to |λ|(contents of x)
            end repeat
        end tell
    end repeat
    return lst
end apList

-- concat :: [[a]] -> [a]
-- concat :: [String] -> String
on concat(xs)
    set lng to length of xs
    if 0 < lng and string is class of (item 1 of xs) then
        set acc to ""
    else
        set acc to {}
    end if
    repeat with i from 1 to lng
        set acc to acc & item i of xs
    end repeat
    acc
end concat

-- foldr :: (a -> b -> b) -> b -> [a] -> b
on foldr(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from lng to 1 by -1
            set v to |λ|(item i of xs, v, i, xs)
        end repeat
        return v
    end tell
end foldr

-- justifyRight :: Int -> Char -> String -> String
on justifyRight(n, cFiller, strText)
    if n > length of strText then
        text -n thru -1 of ((replicate(n, cFiller) as text) & strText)
    else
        strText
    end if
end justifyRight

-- length :: [a] -> Int
on |length|(xs)
    set c to class of xs
    if list is c or string is c then
        length of xs
    else
        (2 ^ 29 - 1) -- (maxInt - simple proxy for non-finite)
    end if
end |length|

-- levels :: Tree a -> [[a]]
on levels(tree)
    -- A list of lists, grouping the root
    -- values of each level of the tree.
    script go
        on |λ|(node, a)
            if {} ≠ a then
                tell a to set {h, t} to {item 1, rest}
            else
                set {h, t} to {{}, {}}
            end if

            {{root of node} & h} & foldr(go, t, nest of node)
        end |λ|
    end script

    |λ|(tree, {}) of go
end levels

-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    -- 2nd class handler function lifted into 1st class script wrapper.
    if script is class of f then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- map :: (a -> b) -> [a] -> [b]
on map(f)
    -- The list obtained by applying f
    -- to each element of xs.
    script
        on |λ|(xs)
            tell mReturn(f)
                set lng to length of xs
                set lst to {}
                repeat with i from 1 to lng
                    set end of lst to |λ|(item i of xs, i, xs)
                end repeat
                return lst
            end tell
        end |λ|
    end script
end map

-- min :: Ord a => a -> a -> a
on min(x, y)
    if y < x then
        y
    else
        x
    end if
end min

-- nest :: Tree a -> [a]
on nest(oTree)
    nest of oTree
end nest

-- Egyptian multiplication - progressively doubling a list, appending
-- stages of doubling to an accumulator where needed for binary
-- assembly of a target length
-- replicate :: Int -> a -> [a]
on replicate(n, a)
    set out to {}
    if 1 > n then return out
    set dbl to {a}

    repeat while (1 < n)
        if 0 < (n mod 2) then set out to out & dbl
        set n to (n div 2)
        set dbl to (dbl & dbl)
    end repeat
    return out & dbl
end replicate

-- root :: Tree a -> a
on root(oTree)
    root of oTree
end root

-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
    set c to class of xs
    if list is c then
        if 0 < n then
            items 1 thru min(n, length of xs) of xs
        else
            {}
        end if
    else if string is c then
        if 0 < n then
            text 1 thru min(n, length of xs) of xs
        else
            ""
        end if
    else if script is c then
        set ys to {}
        repeat with i from 1 to n
            set v to |λ|() of xs
            if missing value is v then
                return ys
            else
                set end of ys to v
            end if
        end repeat
        return ys
    else
        missing value
    end if
end take

-- unlines :: [String] -> String
on unlines(xs)
    -- A single string formed by the intercalation
    -- of a list of strings with the newline character.
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, linefeed}
    set str to xs as text
    set my text item delimiters to dlm
    str
end unlines

-- unwords :: [String] -> String
on unwords(xs)
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, space}
    set s to xs as text
    set my text item delimiters to dlm
    return s
end unwords

-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
on zipWith(f, xs, ys)
    set lng to min(|length|(xs), |length|(ys))
    if 1 > lng then return {}
    set xs_ to take(lng, xs) -- Allow for non-finite
    set ys_ to take(lng, ys) -- generators like cycle etc
    set lst to {}
    tell mReturn(f)
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs_, item i of ys_)
        end repeat
        return lst
    end tell
end zipWith


/* ARM assembly Raspberry PI  */
/*  program deftree2.s   */

/* Constantes    */
.equ STDOUT, 1                           @ Linux output console
.equ EXIT,   1                           @ Linux syscall
.equ READ,   3
.equ WRITE,  4

.equ NBVAL,    9

/*******************************************/
/* Structures                               */
/********************************************/
/* structure tree     */
    .struct  0
tree_root:                             @ root pointer
    .struct  tree_root + 4
tree_size:                             @ number of element of tree
    .struct  tree_size + 4
tree_fin:
/* structure node tree */
    .struct  0
node_left:                             @ left pointer
    .struct  node_left + 4
node_right:                            @ right pointer
    .struct  node_right + 4
node_value:                            @ element value
    .struct  node_value + 4
node_fin:
/* structure queue*/
    .struct  0
queue_begin:                           @ next pointer
    .struct  queue_begin + 4
queue_end:                             @ element value
    .struct  queue_end + 4
queue_fin:
/* structure node queue    */
    .struct  0
queue_node_next:                       @ next pointer
    .struct  queue_node_next + 4
queue_node_value:                      @ element value
    .struct  queue_node_value + 4
queue_node_fin:
/* Initialized data */
.data
szMessInOrder:        .asciz "inOrder :\n"
szMessPreOrder:       .asciz "PreOrder :\n"
szMessPostOrder:      .asciz "PostOrder :\n"
szMessLevelOrder:     .asciz "LevelOrder :\n"
szCarriageReturn:     .asciz "\n"
/* datas error display */
szMessErreur:         .asciz "Error detected.\n"
/* datas message display */
szMessResult:         .ascii "Element value :"
sValue:               .space 12,' '
                      .asciz "\n"

/* UnInitialized data */
.bss
stTree:               .skip tree_fin    @ place to structure tree
stQueue:              .skip queue_fin   @ place to structure queue
/*  code section */
.text
.global main
main:
    mov r1,#1                           @ node tree value
1:
    ldr r0,iAdrstTree                   @ structure tree address
    bl insertElement                    @ add element value r1
    cmp r0,#-1
    beq 99f
    add r1,#1                           @ increment value
    cmp r1,#NBVAL                       @ end ?
    ble 1b                              @ no -> loop

    ldr r0,iAdrszMessPreOrder
    bl affichageMess
    ldr r3,iAdrstTree                   @ tree root address (begin structure)
    ldr r0,[r3,#tree_root]
    ldr r1,iAdrdisplayElement           @ function to execute
    bl preOrder

    ldr r0,iAdrszMessInOrder
    bl affichageMess
    ldr r3,iAdrstTree
    ldr r0,[r3,#tree_root]
    ldr r1,iAdrdisplayElement           @ function to execute
    bl inOrder

    ldr r0,iAdrszMessPostOrder
    bl affichageMess
    ldr r3,iAdrstTree
    ldr r0,[r3,#tree_root]
    ldr r1,iAdrdisplayElement           @ function to execute
    bl postOrder

    ldr r0,iAdrszMessLevelOrder
    bl affichageMess
    ldr r3,iAdrstTree
    ldr r0,[r3,#tree_root]
    ldr r1,iAdrdisplayElement           @ function to execute
    bl levelOrder
    b 100f
99:                                     @ display error
    ldr r0,iAdrszMessErreur
    bl affichageMess
100:                                    @ standard end of the program
    mov r7, #EXIT                       @ request to exit program
    svc 0                               @ perform system call
iAdrszMessInOrder:         .int szMessInOrder
iAdrszMessPreOrder:        .int szMessPreOrder
iAdrszMessPostOrder:       .int szMessPostOrder
iAdrszMessLevelOrder:      .int szMessLevelOrder
iAdrszMessErreur:          .int szMessErreur
iAdrszCarriageReturn:      .int szCarriageReturn
iAdrstTree:                .int stTree
iAdrstQueue:               .int stQueue
iAdrdisplayElement:        .int displayElement
/******************************************************************/
/*     insert element in the tree                                 */
/******************************************************************/
/* r0 contains the address of the tree structure */
/* r1 contains the value of element              */
/* r0 returns address of element or - 1 if error */
insertElement:
    push {r1-r7,lr}                   @ save  registers
    mov r4,r0
    mov r0,#node_fin                  @ reservation place one element
    bl allocHeap
    cmp r0,#-1                        @ allocation error
    beq 100f
    mov r5,r0
    str r1,[r5,#node_value]           @ store value in address heap
    mov r1,#0
    str r1,[r5,#node_left]            @ init left pointer with zero
    str r1,[r5,#node_right]           @ init right pointer with zero
    ldr r2,[r4,#tree_size]            @ load tree size
    cmp r2,#0                         @ 0 element ?
    bne 1f
    str r5,[r4,#tree_root]            @ yes -> store in root
    b 4f
1:                                    @ else search free address in tree
    ldr r3,[r4,#tree_root]            @ start with address root
    add r6,r2,#1                      @ increment tree size
    clz r7,r6                         @ compute zeroes left bits
    add r7,#1                         @ for sustract the first left bit
    lsl r6,r7                         @ shift number in left
2:
    lsls r6,#1                        @ read left bit
    bcs 3f                            @ is 1 ?
    ldr r1,[r3,#node_left]            @ no store node address in left pointer
    cmp r1,#0                         @ if equal zero
    streq r5,[r3,#node_left]
    beq 4f
    mov r3,r1                         @ else loop with next node
    b 2b
3:                                    @ yes
    ldr r1,[r3,#node_right]           @ store node address in right pointer
    cmp r1,#0                         @ if equal zero
    streq r5,[r3,#node_right]
    beq 4f
    mov r3,r1                         @ else loop with next node
    b 2b
4:
    add r2,#1                         @ increment tree size
    str r2,[r4,#tree_size]
100:
    pop {r1-r7,lr}                    @ restaur registers
    bx lr                             @ return
/******************************************************************/
/*     preOrder                                  */
/******************************************************************/
/* r0 contains the address of the node */
/* r1 function address                 */
preOrder:
    push {r1-r2,lr}                       @ save  registers
    cmp r0,#0
    beq 100f
    mov r2,r0
    blx r1                                @ call function

    ldr r0,[r2,#node_left]
    bl preOrder
    ldr r0,[r2,#node_right]
    bl preOrder
100:
    pop {r1-r2,lr}                        @ restaur registers
    bx lr
/******************************************************************/
/*     inOrder                                  */
/******************************************************************/
/* r0 contains the address of the node */
/* r1 function address                 */
inOrder:
    push {r1-r3,lr}                    @ save  registers
    cmp r0,#0
    beq 100f
    mov r3,r0
    mov r2,r1
    ldr r0,[r3,#node_left]
    bl inOrder
    mov r0,r3
    blx r2                             @ call function

    ldr r0,[r3,#node_right]
    mov r1,r2
    bl inOrder
100:
    pop {r1-r3,lr}                     @ restaur registers
    bx lr                              @ return
/******************************************************************/
/*     postOrder                                  */
/******************************************************************/
/* r0 contains the address of the node */
/* r1 function address                 */
postOrder:
    push {r1-r3,lr}                    @ save  registers
    cmp r0,#0
    beq 100f
    mov r3,r0
    mov r2,r1
    ldr r0,[r3,#node_left]
    bl postOrder

    ldr r0,[r3,#node_right]
    mov r1,r2
    bl postOrder
    mov r0,r3
    blx r2                            @ call function
100:
    pop {r1-r3,lr}                    @ restaur registers
    bx lr                             @ return
/******************************************************************/
/*     levelOrder                                  */
/******************************************************************/
/* r0 contains the address of the node */
/* r1 function address                 */
levelOrder:
    push {r1-r4,lr}                       @ save  registers
    cmp r0,#0
    beq 100f
    mov r2,r1
    mov r1,r0
    ldr r0,iAdrstQueue                    @ adresse queue
    bl enqueueNode                        @ queue the node
1:                                        @ begin loop
    ldr r0,iAdrstQueue
    bl isEmptyQueue                       @ is queue empty
    cmp r0,#0
    beq 100f                              @ yes -> end
    ldr r0,iAdrstQueue
    bl dequeueNode
    mov r3,r0                             @ save node
    blx r2                                @ call function
    ldr r4,[r3,#node_left]                @ left node ok ?
    cmp r4,#0
    beq 2f                                @ no
    ldr r0,iAdrstQueue                    @ yes -> enqueue
    mov r1,r4
    bl enqueueNode
2:
    ldr r4,[r3,#node_right]               @ right node ok ?
    cmp r4,#0
    beq 3f                                @ no
    ldr r0,iAdrstQueue                    @ yes -> enqueue
    mov r1,r4
    bl enqueueNode
3:
    b 1b                                  @ and loop

100:
    pop {r1-r4,lr}                        @ restaur registers
    bx lr                                 @ return
/******************************************************************/
/*     display node                                               */
/******************************************************************/
/* r0 contains node  address          */
displayElement:
    push {r1,lr}                       @ save  registers
    ldr r0,[r0,#node_value]
    ldr r1,iAdrsValue
    bl conversion10S
    ldr r0,iAdrszMessResult
    bl affichageMess
100:
    pop {r1,lr}                        @ restaur registers
    bx lr                              @ return
iAdrszMessResult:          .int szMessResult
iAdrsValue:                .int sValue
/******************************************************************/
/*     enqueue node                                  */
/******************************************************************/
/* r0 contains the address of the queue */
/* r1 contains the value of element  */
/* r0 returns address of element or - 1 if error */
enqueueNode:
    push {r1-r5,lr}                       @ save  registers
    mov r4,r0
    mov r0,#queue_node_fin                @ allocation place heap
    bl allocHeap
    cmp r0,#-1                            @ allocation error
    beq 100f
    mov r5,r0                             @ save heap address
    str r1,[r5,#queue_node_value]         @ store node value
    mov r1,#0
    str r1,[r5,#queue_node_next]          @ init pointer next
    ldr r0,[r4,#queue_end]
    cmp r0,#0
    strne r5,[r0,#queue_node_next]
    streq r5,[r4,#queue_begin]
    str r5,[r4,#queue_end]
    mov r0,#0
    pop {r1-r5,lr}
    bx lr                             @ return
/******************************************************************/
/*     dequeue node                                  */
/******************************************************************/
/* r0 contains the address of the queue */
/* r0 returns address of element or - 1 if error */
dequeueNode:
    push {r1-r5,lr}                       @ save  registers
    ldr r4,[r0,#queue_begin]
    ldr r5,[r4,#queue_node_value]
    ldr r6,[r4,#queue_node_next]
    str r6,[r0,#queue_begin]
    cmp r6,#0
    streq r6,[r0,#queue_end]
    mov r0,r5
100:
    pop {r1-r5,lr}
    bx lr                             @ return
/******************************************************************/
/*     dequeue node                                  */
/******************************************************************/
/* r0 contains the address of the queue */
/* r0 returns 0 if empty else 1  */
isEmptyQueue:
    ldr r0,[r0,#queue_begin]
    cmp r0,#0
    movne r0,#1
    bx lr                             @ return
/******************************************************************/
/*     memory allocation on the heap                                  */
/******************************************************************/
/* r0 contains the size to allocate */
/* r0 returns address of memory heap or - 1 if error */
/* CAUTION : The size of the allowance must be a multiple of 4  */
allocHeap:
    push {r5-r7,lr}                   @ save  registers
    @ allocation
    mov r6,r0                         @ save size
    mov r0,#0                         @ read address start heap
    mov r7,#0x2D                      @ call system 'brk'
    svc #0
    mov r5,r0                         @ save address heap for return
    add r0,r6                         @ reservation place for size
    mov r7,#0x2D                      @ call system 'brk'
    svc #0
    cmp r0,#-1                        @ allocation error
    movne r0,r5                       @ return address memory heap
    pop {r5-r7,lr}                    @ restaur registers
    bx lr                             @ return
/******************************************************************/
/*     display text with size calculation                         */
/******************************************************************/
/* r0 contains the address of the message */
affichageMess:
    push {r0,r1,r2,r7,lr}                       @ save  registers
    mov r2,#0                                   @ counter length */
1:                                              @ loop length calculation
    ldrb r1,[r0,r2]                             @ read octet start position + index
    cmp r1,#0                                   @ if 0 its over
    addne r2,r2,#1                              @ else add 1 in the length
    bne 1b                                      @ and loop
                                                @ so here r2 contains the length of the message
    mov r1,r0                                   @ address message in r1
    mov r0,#STDOUT                              @ code to write to the standard output Linux
    mov r7, #WRITE                              @ code call system "write"
    svc #0                                      @ call system
    pop {r0,r1,r2,r7,lr}                        @ restaur registers
    bx lr                                       @ return
/***************************************************/
/*  Converting a register to a signed decimal      */
/***************************************************/
/* r0 contains value and r1 area address    */
conversion10S:
    push {r0-r4,lr}       @ save registers
    mov r2,r1             @ debut zone stockage
    mov r3,#'+'           @ par defaut le signe est +
    cmp r0,#0             @ negative number ?
    movlt r3,#'-'         @ yes
    mvnlt r0,r0           @ number inversion
    addlt r0,#1
    mov r4,#10            @ length area
1:                        @ start loop
    bl divisionpar10U
    add r1,#48            @ digit
    strb r1,[r2,r4]       @ store digit on area
    sub r4,r4,#1          @ previous position
    cmp r0,#0             @ stop if quotient = 0
    bne 1b

    strb r3,[r2,r4]       @ store signe
    subs r4,r4,#1         @ previous position
    blt  100f             @ if r4 < 0 -> end

    mov r1,#' '           @ space
2:
    strb r1,[r2,r4]       @store byte space
    subs r4,r4,#1         @ previous position
    bge 2b                @ loop if r4 > 0
100:
    pop {r0-r4,lr}        @ restaur registers
    bx lr
/***************************************************/
/*   division par 10   unsigned                    */
/***************************************************/
/* r0 dividende   */
/* r0 quotient    */
/* r1 remainder   */
divisionpar10U:
    push {r2,r3,r4, lr}
    mov r4,r0                                          @ save value
    //mov r3,#0xCCCD                                   @ r3 <- magic_number lower  raspberry 3
    //movt r3,#0xCCCC                                  @ r3 <- magic_number higter raspberry 3
    ldr r3,iMagicNumber                                @ r3 <- magic_number    raspberry 1 2
    umull r1, r2, r3, r0                               @ r1<- Lower32Bits(r1*r0) r2<- Upper32Bits(r1*r0)
    mov r0, r2, LSR #3                                 @ r2 <- r2 >> shift 3
    add r2,r0,r0, lsl #2                               @ r2 <- r0 * 5
    sub r1,r4,r2, lsl #1                               @ r1 <- r4 - (r2 * 2)  = r4 - (r0 * 10)
    pop {r2,r3,r4,lr}
    bx lr                                              @ leave function
iMagicNumber:  	.int 0xCCCCCCCD


#include
"share/atspre_staload.hats"
//
(* ****** ****** *)
//
datatype
tree (a:[email protected]) =
  | tnil of ()
  | tcons of (tree a, a, tree a)
//
(* ****** ****** *)

symintr ++
infixr (+) ++
overload ++ with list_append

(* ****** ****** *)

#define sing list_sing

(* ****** ****** *)

fun{
a:[email protected]
} preorder
  (t0: tree a): List0 a =
  case t0 of
  | tnil () => nil ()
  | tcons (tl, x, tr) => sing(x) ++ preorder(tl) ++ preorder(tr)

(* ****** ****** *)

fun{
a:[email protected]
} inorder
  (t0: tree a): List0 a =
  case t0 of
  | tnil () => nil ()
  | tcons (tl, x, tr) => inorder(tl) ++ sing(x) ++ inorder(tr)

(* ****** ****** *)

fun{
a:[email protected]
} postorder
  (t0: tree a): List0 a =
  case t0 of
  | tnil () => nil ()
  | tcons (tl, x, tr) => postorder(tl) ++ postorder(tr) ++ sing(x)

(* ****** ****** *)

fun{
a:[email protected]
} levelorder
  (t0: tree a): List0 a = let
//
fun auxlst
  (ts: List (tree(a))): List0 a =
  case ts of
  | list_nil () => list_nil ()
  | list_cons (t, ts) =>
    (
      case+ t of
      | tnil () => auxlst (ts)
      | tcons (tl, x, tr) => cons (x, auxlst (ts ++ $list{tree(a)}(tl, tr)))
    )
//
in
  auxlst (sing(t0))
end // end of [levelorder]

(* ****** ****** *)

macdef
tsing(x) = tcons (tnil, ,(x), tnil)

(* ****** ****** *)

implement
main0 () = let
//
val t0 =
tcons{int}
(
 tcons (tcons (tsing (7), 4, tnil ()), 2, tsing (5))
,
1
,
 tcons (tcons (tsing (8), 6, tsing (9)), 3, tnil ())
)
//
in
  println! ("preorder:\t", preorder(t0));
  println! ("inorder:\t", inorder(t0));
  println! ("postorder:\t", postorder(t0));
  println! ("level-order:\t", levelorder(t0));
end (* end of [main0] *)


V data = [
   ‘des_system_lib’ = Set(‘std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee’.split(‘ ’)),
   ‘dw01’           = Set(‘ieee dw01 dware gtech’.split(‘ ’)),
   ‘dw02’           = Set(‘ieee dw02 dware’.split(‘ ’)),
   ‘dw03’           = Set(‘std synopsys dware dw03 dw02 dw01 ieee gtech’.split(‘ ’)),
   ‘dw04’           = Set(‘dw04 ieee dw01 dware gtech’.split(‘ ’)),
   ‘dw05’           = Set(‘dw05 ieee dware’.split(‘ ’)),
   ‘dw06’           = Set(‘dw06 ieee dware’.split(‘ ’)),
   ‘dw07’           = Set(‘ieee dware’.split(‘ ’)),
   ‘dware’          = Set(‘ieee dware’.split(‘ ’)),
   ‘gtech’          = Set(‘ieee gtech’.split(‘ ’)),
   ‘ramlib’         = Set(‘std ieee’.split(‘ ’)),
   ‘std_cell_lib’   = Set(‘ieee std_cell_lib’.split(‘ ’)),
   ‘synopsys’       = Set[String]()
]

F toposort2(&data)
   L(k, v) data
      v.discard(k)

   Set[String] extra_items_in_deps
   L(v) data.values()
      extra_items_in_deps.update(v)
   extra_items_in_deps = extra_items_in_deps - Set(data.keys())

   L(item) extra_items_in_deps
      data[item] = Set[String]()

   [String] r
   L
      Set[String] ordered
      L(item, dep) data
         I dep.empty
            ordered.add(item)
      I ordered.empty
         L.break

      r.append(sorted(Array(ordered)).join(‘ ’))

      [String = Set[String]] new_data
      L(item, dep) data
         I item !C ordered
            new_data[item] = dep - ordered
      data = move(new_data)

   assert(data.empty, ‘A cyclic dependency exists’)
   R r

print(toposort2(&data).join("\n"))


AddNode(Tree,1,2,3,1) ; Build global Tree
AddNode(Tree,2,4,5,2)
AddNode(Tree,3,6,0,3)
AddNode(Tree,4,7,0,4)
AddNode(Tree,5,0,0,5)
AddNode(Tree,6,8,9,6)
AddNode(Tree,7,0,0,7)
AddNode(Tree,8,0,0,8)
AddNode(Tree,9,0,0,9)

MsgBox % "Preorder: "   PreOrder(Tree,1)  ; 1 2 4 7 5 3 6 8 9
MsgBox % "Inorder: "    InOrder(Tree,1)   ; 7 4 2 5 1 8 6 9 3
MsgBox % "postorder: "  PostOrder(Tree,1) ; 7 4 5 2 8 9 6 3 1
MsgBox % "levelorder: " LevOrder(Tree,1)  ; 1 2 3 4 5 6 7 8 9

AddNode(ByRef Tree,Node,Left,Right,Value) {
   if !isobject(Tree)
     Tree := object()

   Tree[Node, "L"] := Left
   Tree[Node, "R"] := Right
   Tree[Node, "V"] := Value
}

PreOrder(Tree,Node) {
ptree := Tree[Node, "V"] " "
        . ((L:=Tree[Node, "L"]) ? PreOrder(Tree,L) : "")
        . ((R:=Tree[Node, "R"]) ? PreOrder(Tree,R) : "")
return ptree
}
InOrder(Tree,Node) {
   Return itree := ((L:=Tree[Node, "L"]) ? InOrder(Tree,L) : "")
        . Tree[Node, "V"] " "
        . ((R:=Tree[Node, "R"]) ? InOrder(Tree,R) : "")
}
PostOrder(Tree,Node) {
   Return ptree := ((L:=Tree[Node, "L"]) ? PostOrder(Tree,L) : "")
        . ((R:=Tree[Node, "R"]) ? PostOrder(Tree,R) : "")
        . Tree[Node, "V"] " "
}
LevOrder(Tree,Node,Lev=1) {
   Static                        ; make node lists static
   i%Lev% .= Tree[Node, "V"] " " ; build node lists in every level
   If (L:=Tree[Node, "L"])
       LevOrder(Tree,L,Lev+1)
   If (R:=Tree[Node, "R"])
       LevOrder(Tree,R,Lev+1)
   If (Lev > 1)
      Return
   While i%Lev%                  ; concatenate node lists from all levels
      t .= i%Lev%, Lev++
   Return t
}


with Ada.Containers.Vectors; use Ada.Containers;

package Digraphs is

   type Node_Idx_With_Null is new Natural;
   subtype Node_Index is Node_Idx_With_Null range 1 .. Node_Idx_With_Null'Last;
   -- a Node_Index is a number from 1, 2, 3, ... and the representative of a node

   type Graph_Type is tagged private;

   -- make sure Node is in Graph (possibly without connections)
   procedure Add_Node
     (Graph: in out Graph_Type'Class; Node: Node_Index);

   -- insert an edge From->To into Graph; do nothing if already there
   procedure Add_Connection
     (Graph: in out Graph_Type'Class; From, To: Node_Index);

   -- get the largest Node_Index used in any Add_Node or Add_Connection op.
   -- iterate over all nodes of Graph: "for I in 1 .. Graph.Node_Count loop ..."
   function Node_Count(Graph: Graph_Type) return Node_Idx_With_Null;

   -- remove an edge From->To from Fraph; do nothing if not there
   -- Graph.Node_Count is not changed
   procedure Del_Connection
     (Graph: in out Graph_Type'Class; From, To: Node_Index);

   -- check if an edge From->to exists in Graph
   function Connected
     (Graph: Graph_Type; From, To: Node_Index) return Boolean;

   -- data structure to store a list of nodes
   package Node_Vec is new Vectors(Positive, Node_Index);

   -- get a list of all nodes From->Somewhere in Graph
   function All_Connections
     (Graph: Graph_Type; From: Node_Index) return Node_Vec.Vector;

   Graph_Is_Cyclic: exception;

   -- a depth-first search to find a topological sorting of the nodes
   -- raises Graph_Is_Cyclic if no topological sorting is possible
   function Top_Sort
     (Graph: Graph_Type) return Node_Vec.Vector;

private

   package Conn_Vec is new Vectors(Node_Index, Node_Vec.Vector, Node_Vec."=");

   type Graph_Type is new Conn_Vec.Vector with null record;

end Digraphs;


function preorder(tree, node, res,  child) {
    if (node == "")
        return
    res[res["count"]++] = node
    split(tree[node], child, ",")
    preorder(tree,child[1],res)
    preorder(tree,child[2],res)
}

function inorder(tree, node, res,   child) {
    if (node == "")
        return
    split(tree[node], child, ",")
    inorder(tree,child[1],res)
    res[res["count"]++] = node
    inorder(tree,child[2],res)
}

function postorder(tree, node, res,     child) {
    if (node == "")
        return
    split(tree[node], child, ",")
    postorder(tree,child[1], res)
    postorder(tree,child[2], res)
    res[res["count"]++] = node
}

function levelorder(tree, node, res,    nextnode, queue, child) {
    if (node == "")
        return

    queue["tail"] = 0
    queue[queue["head"]++] = node

    while (queue["head"] - queue["tail"] >= 1) {

        nextnode = queue[queue["tail"]]
        delete queue[queue["tail"]++]

        res[res["count"]++] = nextnode

        split(tree[nextnode], child, ",")
        if (child[1] != "")
            queue[queue["head"]++] = child[1]
        if (child[2] != "")
            queue[queue["head"]++] = child[2]
    }
    delete queue
}

BEGIN {
    tree["1"] = "2,3"
    tree["2"] = "4,5"
    tree["3"] = "6,"
    tree["4"] = "7,"
    tree["5"] = ","
    tree["6"] = "8,9"
    tree["7"] = ","
    tree["8"] = ","
    tree["9"] = ","

    preorder(tree,"1",result)
    printf "preorder:\t"
    for (n = 0; n < result["count"]; n += 1)
        printf result[n]" "
    printf "\n"
    delete result

    inorder(tree,"1",result)
    printf "inorder:\t"
    for (n = 0; n < result["count"]; n += 1)
        printf result[n]" "
    printf "\n"
    delete result

    postorder(tree,"1",result)
    printf "postorder:\t"
    for (n = 0; n < result["count"]; n += 1)
        printf result[n]" "
    printf "\n"
    delete result

    levelorder(tree,"1",result)
    printf "level-order:\t"
    for (n = 0; n < result["count"]; n += 1)
        printf result[n]" "
    printf "\n"
    delete result
}


(     ("des_system_lib".std synopsys "std_cell_lib" "des_system_lib" dw02 dw01 ramlib ieee)
      (dw01.ieee dw01 dware gtech)
      (dw02.ieee dw02 dware)
      (dw03.std synopsys dware dw03 dw02 dw01 ieee gtech)
      (dw04.dw04 ieee dw01 dware gtech)
      (dw05.dw05 ieee dware)
      (dw06.dw06 ieee dware)
      (dw07.ieee dware)
      (dware.ieee dware)
      (gtech.ieee gtech)
      (ramlib.std ieee)
      ("std_cell_lib".ieee "std_cell_lib")
      (synopsys.)
      (cycle-11.cycle-12)
      (cycle-12.cycle-11)
      (cycle-21.dw01 cycle-22 dw02 dw03)
      (cycle-22.cycle-21 dw01 dw04)
  : ?libdeps
& :?indeps
& ( toposort
  =   A Z res module dependants todo done
    .   !arg:(?todo.?done)
      & ( areDone
        =
          .   !arg:
            |     !arg
                :   ( %@
                    : [%( !module+!done+!indeps:?+(? !sjt ?)+?
                        |   ~(!libdeps:? (!sjt.?) ?)
                          & !sjt !indeps:?indeps
                        )
                    )
                    ?arg
              & areDone$!arg
        )
      & (     !todo
            :   ?A
                (?module.?dependants&areDone$!dependants)
                ( ?Z
                & toposort$(!A !Z.!done !module):?res
                )
          & !res
        | (!todo.!done)
        )
  )
& toposort$(!libdeps.):(?cycles.?res)
& out$("
compile order:" !indeps !res "\ncycles:" !cycles)
);


#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>

char input[] =
	"des_system_lib   std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee\n"
	"dw01             ieee dw01 dware gtech\n"
	"dw02             ieee dw02 dware\n"
	"dw03             std synopsys dware dw03 dw02 dw01 ieee gtech\n"
	"dw04             dw04 ieee dw01 dware gtech\n"
	"dw05             dw05 ieee dware\n"
	"dw06             dw06 ieee dware\n"
	"dw07             ieee dware\n"
	"dware            ieee dware\n"
	"gtech            ieee gtech\n"
	"ramlib           std ieee\n"
	"std_cell_lib     ieee std_cell_lib\n"
	"synopsys\n"
	"cycle_11	  cycle_12\n"
	"cycle_12	  cycle_11\n"
	"cycle_21	  dw01 cycle_22 dw02 dw03\n"
	"cycle_22	  cycle_21 dw01 dw04";

typedef struct item_t item_t, *item;
struct item_t { const char *name; int *deps, n_deps, idx, depth; };

int get_item(item *list, int *len, const char *name)
{
	int i;
	item lst = *list;

	for (i = 0; i < *len; i++)
		if (!strcmp(lst[i].name, name)) return i;

	lst = *list = realloc(lst, ++*len * sizeof(item_t));
	i = *len - 1;
	memset(lst + i, 0, sizeof(item_t));
	lst[i].idx = i;
	lst[i].name = name;
	return i;
}

void add_dep(item it, int i)
{
	if (it->idx == i) return;
	it->deps = realloc(it->deps, (it->n_deps + 1) * sizeof(int));
	it->deps[it->n_deps++] = i;
}

int parse_input(item *ret)
{
	int n_items = 0;
	int i, parent, idx;
	item list = 0;

	char *s, *e, *word, *we;
	for (s = input; ; s = 0) {
		if (!(s = strtok_r(s, "\n", &e))) break;

		for (i = 0, word = s; ; i++, word = 0) {
			if (!(word = strtok_r(word, " \t", &we))) break;
			idx = get_item(&list, &n_items, word);

			if (!i) parent = idx;
			else    add_dep(list + parent, idx);
		}
	}

	*ret = list;
	return n_items;
}

/* recursively resolve compile order; negative means loop */
int get_depth(item list, int idx, int bad)
{
	int max, i, t;

	if (!list[idx].deps)
		return list[idx].depth = 1;

	if ((t = list[idx].depth) < 0) return t;

	list[idx].depth = bad;
	for (max = i = 0; i < list[idx].n_deps; i++) {
		if ((t = get_depth(list, list[idx].deps[i], bad)) < 0) {
			max = t;
			break;
		}
		if (max < t + 1) max = t + 1;
	}
	return list[idx].depth = max;
}

int main()
{
	int i, j, n, bad = -1, max, min;
	item items;
	n = parse_input(&items);

	for (i = 0; i < n; i++)
		if (!items[i].depth && get_depth(items, i, bad) < 0) bad--;

	for (i = 0, max = min = 0; i < n; i++) {
		if (items[i].depth > max) max = items[i].depth;
		if (items[i].depth < min) min = items[i].depth;
	}

	printf("Compile order:\n");
	for (i = min; i <= max; i++) {
		if (!i) continue;

		if (i < 0) printf("   [unorderable]");
		else	   printf("%d:", i);

		for (j = 0; j < n || !putchar('\n'); j++)
			if (items[j].depth == i)
				printf(" %s", items[j].name);
	}

	return 0;
}


(
  ( tree
  =   1
    .   (2.(4.7.) (5.))
        (3.6.(8.) (9.))
  )
& ( preorder
  =   K sub
    .     !arg:(?K.?sub) ?arg
        & !K preorder$!sub preorder$!arg
      |
  )
& out$("preorder:   " preorder$!tree)
& ( inorder
  =   K lhs rhs
    .   !arg:(?K.?sub) ?arg
      & (   !sub:%?lhs ?rhs
          & inorder$!lhs !K inorder$!rhs inorder$!arg
        | !K
        )
  )
& out$("inorder:    " inorder$!tree)
& ( postorder
  =   K sub
    .     !arg:(?K.?sub) ?arg
        & postorder$!sub !K postorder$!arg
      |
  )
& out$("postorder:  " postorder$!tree)
& ( levelorder
  =   todo tree sub
    .   !arg:(.)&
      |   !arg:(?tree.?todo)
        & (   !tree:(?K.?sub) ?tree
            & !K levelorder$(!tree.!todo !sub)
          | levelorder$(!todo.)
          )
  )
& out$("level-order:" levelorder$(!tree.))
&
)


namespace Algorithms
{
    using System;
    using System.Collections.Generic;
    using System.Linq;

    public class TopologicalSorter<ValueType>
    {
        private class Relations
        {
            public int Dependencies = 0;
            public HashSet<ValueType> Dependents = new HashSet<ValueType>();
        }

        private Dictionary<ValueType, Relations> _map = new Dictionary<ValueType, Relations>();

        public void Add(ValueType obj)
        {
            if (!_map.ContainsKey(obj)) _map.Add(obj, new Relations());
        }

        public void Add(ValueType obj, ValueType dependency)
        {
            if (dependency.Equals(obj)) return;

            if (!_map.ContainsKey(dependency)) _map.Add(dependency, new Relations());

            var dependents = _map[dependency].Dependents;

            if (!dependents.Contains(obj))
            {
                dependents.Add(obj);

                if (!_map.ContainsKey(obj)) _map.Add(obj, new Relations());

                ++_map[obj].Dependencies;
            }
        }

        public void Add(ValueType obj, IEnumerable<ValueType> dependencies)
        {
            foreach (var dependency in dependencies) Add(obj, dependency);
        }

        public void Add(ValueType obj, params ValueType[] dependencies)
        {
            Add(obj, dependencies as IEnumerable<ValueType>);
        }

        public Tuple<IEnumerable<ValueType>, IEnumerable<ValueType>> Sort()
        {
            List<ValueType> sorted = new List<ValueType>(), cycled = new List<ValueType>();
            var map = _map.ToDictionary(kvp => kvp.Key, kvp => kvp.Value);

            sorted.AddRange(map.Where(kvp => kvp.Value.Dependencies == 0).Select(kvp => kvp.Key));

            for (int idx = 0; idx < sorted.Count; ++idx) sorted.AddRange(map[sorted[idx]].Dependents.Where(k => --map[k].Dependencies == 0));

            cycled.AddRange(map.Where(kvp => kvp.Value.Dependencies != 0).Select(kvp => kvp.Key));

            return new Tuple<IEnumerable<ValueType>, IEnumerable<ValueType>>(sorted, cycled);
        }

        public void Clear()
        {
            _map.Clear();
        }
    }

}

/*
	Example usage with Task object
*/

namespace ExampleApplication
{
    using Algorithms;
    using System;
    using System.Collections.Generic;
    using System.Linq;

    public class Task
    {
        public string Message;
    }

    class Program
    {
        static void Main(string[] args)
        {
            List<Task> tasks = new List<Task>
            {
                new Task{ Message = "A - depends on B and C" },    //0
                new Task{ Message = "B - depends on none" },       //1
                new Task{ Message = "C - depends on D and E" },    //2
                new Task{ Message = "D - depends on none" },       //3
                new Task{ Message = "E - depends on F, G and H" }, //4
                new Task{ Message = "F - depends on I" },          //5
                new Task{ Message = "G - depends on none" },       //6
                new Task{ Message = "H - depends on none" },       //7
                new Task{ Message = "I - depends on none" },       //8
            };

            TopologicalSorter<Task> resolver = new TopologicalSorter<Task>();

            // now setting relations between them as described above
            resolver.Add(tasks[0], new[] { tasks[1], tasks[2] });
            //resolver.Add(tasks[1]); // no need for this since the task was already mentioned as a dependency
            resolver.Add(tasks[2], new[] { tasks[3], tasks[4] });
            //resolver.Add(tasks[3]); // no need for this since the task was already mentioned as a dependency
            resolver.Add(tasks[4], tasks[5], tasks[6], tasks[7]);
            resolver.Add(tasks[5], tasks[8]);
            //resolver.Add(tasks[6]); // no need for this since the task was already mentioned as a dependency
            //resolver.Add(tasks[7]); // no need for this since the task was already mentioned as a dependency

            //resolver.Add(tasks[3], tasks[0]); // uncomment this line to test cycled dependency

            var result = resolver.Sort();
            var sorted = result.Item1;
            var cycled = result.Item2;

            if (!cycled.Any())
            {
                foreach (var d in sorted) Console.WriteLine(d.Message);
            }
            else
            {
                Console.Write("Cycled dependencies detected: ");

                foreach (var d in cycled) Console.Write($"{d.Message[0]} ");

                Console.WriteLine();
            }

            Console.WriteLine("exiting...");
        }
    }
}


#include <stdlib.h>
#include <stdio.h>

typedef struct node_s
{
  int value;
  struct node_s* left;
  struct node_s* right;
} *node;

node tree(int v, node l, node r)
{
  node n = malloc(sizeof(struct node_s));
  n->value = v;
  n->left  = l;
  n->right = r;
  return n;
}

void destroy_tree(node n)
{
  if (n->left)
    destroy_tree(n->left);
  if (n->right)
    destroy_tree(n->right);
  free(n);
}

void preorder(node n, void (*f)(int))
{
  f(n->value);
  if (n->left)
    preorder(n->left, f);
  if (n->right)
    preorder(n->right, f);
}

void inorder(node n, void (*f)(int))
{
  if (n->left)
    inorder(n->left, f);
  f(n->value);
  if (n->right)
    inorder(n->right, f);
}

void postorder(node n, void (*f)(int))
{
  if (n->left)
    postorder(n->left, f);
  if (n->right)
    postorder(n->right, f);
  f(n->value);
}

/* helper queue for levelorder */
typedef struct qnode_s
{
  struct qnode_s* next;
  node value;
} *qnode;

typedef struct { qnode begin, end; } queue;

void enqueue(queue* q, node n)
{
  qnode node = malloc(sizeof(struct qnode_s));
  node->value = n;
  node->next = 0;
  if (q->end)
    q->end->next = node;
  else
    q->begin = node;
  q->end = node;
}

node dequeue(queue* q)
{
  node tmp = q->begin->value;
  qnode second = q->begin->next;
  free(q->begin);
  q->begin = second;
  if (!q->begin)
    q->end = 0;
  return tmp;
}

int queue_empty(queue* q)
{
  return !q->begin;
}

void levelorder(node n, void(*f)(int))
{
  queue nodequeue = {};
  enqueue(&nodequeue, n);
  while (!queue_empty(&nodequeue))
  {
    node next = dequeue(&nodequeue);
    f(next->value);
    if (next->left)
      enqueue(&nodequeue, next->left);
    if (next->right)
      enqueue(&nodequeue, next->right);
  }
}

void print(int n)
{
  printf("%d ", n);
}

int main()
{
  node n = tree(1,
                tree(2,
                     tree(4,
                          tree(7, 0, 0),
                          0),
                     tree(5, 0, 0)),
                tree(3,
                     tree(6,
                          tree(8, 0, 0),
                          tree(9, 0, 0)),
                     0));

  printf("preorder:    ");
  preorder(n, print);
  printf("\n");

  printf("inorder:     ");
  inorder(n, print);
  printf("\n");

  printf("postorder:   ");
  postorder(n, print);
  printf("\n");

  printf("level-order: ");
  levelorder(n, print);
  printf("\n");

  destroy_tree(n);

  return 0;
}


#include <map>
#include <set>

template<typename Goal>
class topological_sorter {
protected:
    struct relations {
        std::size_t dependencies;
        std::set<Goal> dependents;
    };
    std::map<Goal, relations> map;
public:
    void add_goal(Goal const &goal) {
        map[goal];
    }
    void add_dependency(Goal const &goal, Goal const &dependency) {
        if (dependency == goal)
            return;
        auto &dependents = map[dependency].dependents;
        if (dependents.find(goal) == dependents.end()) {
            dependents.insert(goal);
            ++map[goal].dependencies;
        }
    }
    template<typename Container>
    void add_dependencies(Goal const &goal, Container const &dependencies) {
        for (auto const &dependency : dependencies)
            add_dependency(goal, dependency);
    }
    template<typename ResultContainer, typename CyclicContainer>
    void destructive_sort(ResultContainer &sorted, CyclicContainer &unsortable) {
        sorted.clear();
        unsortable.clear();
        for (auto const &lookup : map) {
            auto const &goal = lookup.first;
            auto const &relations = lookup.second;
            if (relations.dependencies == 0)
                sorted.push_back(goal);
        }
        for (std::size_t index = 0; index < sorted.size(); ++index)
            for (auto const &goal : map[sorted[index]].dependents)
                if (--map[goal].dependencies == 0)
                    sorted.push_back(goal);
        for (auto const &lookup : map) {
            auto const &goal = lookup.first;
            auto const &relations = lookup.second;
            if (relations.dependencies != 0)
                unsortable.push_back(goal);
        }
    }
    template<typename ResultContainer, typename CyclicContainer>
    void sort(ResultContainer &sorted, CyclicContainer &unsortable) {
        topological_sorter<Goal> temporary = *this;
        temporary.destructive_sort(sorted, unsortable);
    }
    void clear() {
        map.clear();
    }
};

/*
 Example usage with text strings
 */

#include <fstream>
#include <sstream>
#include <iostream>
#include <string>
#include <vector>

using namespace std;

void display_heading(string const &message) {
    cout << endl << "~ " << message << " ~" << endl;
}
void display_results(string const &input) {
    topological_sorter<string> sorter;
    vector<string> sorted, unsortable;
    stringstream lines(input);
    string line;
    while (getline(lines, line)) {
        stringstream buffer(line);
        string goal, dependency;
        buffer >> goal;
        sorter.add_goal(goal);
        while (buffer >> dependency)
            sorter.add_dependency(goal, dependency);
    }
    sorter.destructive_sort(sorted, unsortable);
    if (sorted.size() == 0)
        display_heading("Error: no independent variables found!");
    else {
        display_heading("Result");
        for (auto const &goal : sorted)
            cout << goal << endl;
    }
    if (unsortable.size() != 0) {
        display_heading("Error: cyclic dependencies detected!");
        for (auto const &goal : unsortable)
            cout << goal << endl;
    }
}
int main(int argc, char **argv) {
    if (argc == 1) {
        string example = "des_system_lib   std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee\n"
                "dw01             ieee dw01 dware gtech\n"
                "dw02             ieee dw02 dware\n"
                "dw03             std synopsys dware dw03 dw02 dw01 ieee gtech\n"
                "dw04             dw04 ieee dw01 dware gtech\n"
                "dw05             dw05 ieee dware\n"
                "dw06             dw06 ieee dware\n"
                "dw07             ieee dware\n"
                "dware            ieee dware\n"
                "gtech            ieee gtech\n"
                "ramlib           std ieee\n"
                "std_cell_lib     ieee std_cell_lib\n"
                "synopsys\n"
                "cycle_11     cycle_12\n"
                "cycle_12     cycle_11\n"
                "cycle_21     dw01 cycle_22 dw02 dw03\n"
                "cycle_22     cycle_21 dw01 dw04";
        display_heading("Example: each line starts with a goal followed by it's dependencies");
        cout << example << endl;
        display_results(example);
        display_heading("Enter lines of data (press enter when finished)");
        string line, data;
        while (getline(cin, line) && !line.empty())
            data += line + '\n';
        if (!data.empty())
            display_results(data);
    } else
        while (*(++argv)) {
            ifstream file(*argv);
            typedef istreambuf_iterator<char> iterator;
            display_results(string(iterator(file), iterator()));
        }
}


using System;
using System.Collections.Generic;
using System.Linq;

class Node
{
    int Value;
    Node Left;
    Node Right;

    Node(int value = default(int), Node left = default(Node), Node right = default(Node))
    {
        Value = value;
        Left = left;
        Right = right;
    }

    IEnumerable<int> Preorder()
    {
        yield return Value;
        if (Left != null)
            foreach (var value in Left.Preorder())
                yield return value;
        if (Right != null)
            foreach (var value in Right.Preorder())
                yield return value;
    }

    IEnumerable<int> Inorder()
    {
        if (Left != null)
            foreach (var value in Left.Inorder())
                yield return value;
        yield return Value;
        if (Right != null)
            foreach (var value in Right.Inorder())
                yield return value;
    }

    IEnumerable<int> Postorder()
    {
        if (Left != null)
            foreach (var value in Left.Postorder())
                yield return value;
        if (Right != null)
            foreach (var value in Right.Postorder())
                yield return value;
        yield return Value;
    }

    IEnumerable<int> LevelOrder()
    {
        var queue = new Queue<Node>();
        queue.Enqueue(this);
        while (queue.Any())
        {
            var node = queue.Dequeue();
            yield return node.Value;
            if (node.Left != null)
                queue.Enqueue(node.Left);
            if (node.Right != null)
                queue.Enqueue(node.Right);
        }
    }

    static void Main()
    {
        var tree = new Node(1, new Node(2, new Node(4, new Node(7)), new Node(5)), new Node(3, new Node(6, new Node(8), new Node(9))));
        foreach (var traversal in new Func<IEnumerable<int>>[] { tree.Preorder, tree.Inorder, tree.Postorder, tree.LevelOrder })
            Console.WriteLine("{0}:\t{1}", traversal.Method.Name, string.Join(" ", traversal()));
    }
}


(use 'clojure.set)
(use 'clojure.contrib.seq-utils)

(defn dep
  "Constructs a single-key dependence, represented as a map from
   item to a set of items, ensuring that item is not in the set."
  [item items]
  {item (difference (set items) (list item))})

(defn empty-dep
  "Constructs a single-key dependence from item to an empty set."
  [item]
  (dep item '()))

(defn pair-dep
  "Invokes dep after destructuring item and items from the argument."
  [[item items]]
  (dep item items))

(defn default-deps
  "Constructs a default dependence map taking every item
   in the argument to an empty set"
  [items]
  (apply merge-with union (map empty-dep (flatten items))))

(defn declared-deps
  "Constructs a dependence map from a list containaining
   alternating items and list of their predecessor items."
  [items]
  (apply merge-with union (map pair-dep (partition 2 items))))

(defn deps
  "Constructs a full dependence map containing both explicitly
   represented dependences and default empty dependences for
   items without explicit predecessors."
  [items]
  (merge (default-deps items) (declared-deps items)))

(defn no-dep-items
  "Returns all keys from the argument which have no (i.e. empty) dependences."
  [deps]
  (filter #(empty? (deps %)) (keys deps)))

(defn remove-items
  "Returns a dependence map with the specified items removed from keys
   and from all dependence sets of remaining keys."
  [deps items]
  (let [items-to-remove (set items)
        remaining-keys  (difference (set (keys deps)) items-to-remove)
        remaining-deps  (fn [x] (dep x (difference (deps x) items-to-remove)))]
    (apply merge (map remaining-deps remaining-keys))))

(defn topo-sort-deps
  "Given a dependence map, returns either a list of items in which each item
   follows all of its predecessors, or a string showing the items among which
   there is a cyclic dependence preventing a linear order."
  [deps]
  (loop [remaining-deps deps
         result         '()]
    (if (empty? remaining-deps)
        (reverse result)
        (let [ready-items (no-dep-items remaining-deps)]
          (if (empty? ready-items)
              (str "ERROR: cycles remain among " (keys remaining-deps))
              (recur (remove-items remaining-deps ready-items)
                     (concat ready-items result)))))))

(defn topo-sort
  "Given a list of alternating items and predecessor lists, constructs a
   full dependence map and then applies topo-sort-deps to that map."
  [items]
  (topo-sort-deps (deps items)))


#include <boost/scoped_ptr.hpp>
#include <iostream>
#include <queue>

template<typename T>
class TreeNode {
public:
  TreeNode(const T& n, TreeNode* left = NULL, TreeNode* right = NULL)
    : mValue(n),
      mLeft(left),
      mRight(right) {}

  T getValue() const {
    return mValue;
  }

  TreeNode* left() const {
    return mLeft.get();
  }

  TreeNode* right() const {
    return mRight.get();
  }

  void preorderTraverse() const {
    std::cout << " " << getValue();
    if(mLeft)  { mLeft->preorderTraverse();  }
    if(mRight) { mRight->preorderTraverse(); }
  }

  void inorderTraverse() const {
    if(mLeft)  { mLeft->inorderTraverse();  }
    std::cout << " " << getValue();
    if(mRight) { mRight->inorderTraverse(); }
  }

  void postorderTraverse() const {
    if(mLeft)  { mLeft->postorderTraverse();  }
    if(mRight) { mRight->postorderTraverse(); }
    std::cout << " " << getValue();
  }

  void levelorderTraverse() const {
    std::queue<const TreeNode*> q;
    q.push(this);

    while(!q.empty()) {
      const TreeNode* n = q.front();
      q.pop();
      std::cout << " " << n->getValue();

      if(n->left())  { q.push(n->left());  }
      if(n->right()) { q.push(n->right()); }
    }
  }

protected:
  T mValue;
  boost::scoped_ptr<TreeNode> mLeft;
  boost::scoped_ptr<TreeNode> mRight;

private:
  TreeNode();
};

int main() {
  TreeNode<int> root(1,
    new TreeNode<int>(2,
      new TreeNode<int>(4,
        new TreeNode<int>(7)),
      new TreeNode<int>(5)),
    new TreeNode<int>(3,
      new TreeNode<int>(6,
        new TreeNode<int>(8),
        new TreeNode<int>(9))));

  std::cout << "preorder:   ";
  root.preorderTraverse();
  std::cout << std::endl;

  std::cout << "inorder:    ";
  root.inorderTraverse();
  std::cout << std::endl;

  std::cout << "postorder:  ";
  root.postorderTraverse();
  std::cout << std::endl;

  std::cout << "level-order:";
  root.levelorderTraverse();
  std::cout << std::endl;

  return 0;
}


toposort = (targets) ->
  # targets is hash of sets, where keys are parent nodes and
  # where values are sets that contain nodes that must precede the parent

  # Start by identifying obviously independent nodes
  independents = []
  do ->
    for k of targets
      if targets[k].cnt == 0
        delete targets[k]
        independents.push k

  # Note reverse dependencies for theoretical O(M+N) efficiency.
  reverse_deps = []
  do ->
    for k of targets
      for child of targets[k].v
        reverse_deps[child] ?= []
        reverse_deps[child].push k

  # Now be greedy--start with independent nodes, then start
  # breaking dependencies, and keep going as long as we still
  # have independent nodes left.
  result = []
  while independents.length > 0
    k = independents.pop()
    result.push k
    for parent in reverse_deps[k] or []
      set_remove targets[parent], k
      if targets[parent].cnt == 0
        independents.push parent
        delete targets[parent]

  # Show unresolvable dependencies
  for k of targets
    console.log "WARNING: node #{k} is part of cyclical dependency"
  result

parse_deps = ->
  # parse string data, remove self-deps, and fill in gaps
  #
  # e.g. this would transform {a: "a b c", d: "e"} to this:
  #   a: set(b, c)
  #   b: set()
  #   c: set()
  #   d: set(e)
  #   e: set()
  targets = {}
  deps = set()
  for k, v of data
    targets[k] = set()
    children = v.split(' ')
    for child in children
      continue if child == ''
      set_add targets[k], child unless child == k
      set_add deps, child

  # make sure even leaf nodes are in targets
  for dep of deps.v
    if dep not of targets
      targets[dep] = set()
  targets

set = ->
  cnt: 0
  v: {}

set_add = (s, e) ->
  return if s.v[e]
  s.cnt += 1
  s.v[e] = true

set_remove = (s, e) ->
  return if !s.v[e]
  s.cnt -= 1
  delete s.v[e]

data =
  des_system_lib:   "std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee"
  dw01:             "ieee dw01 dware gtech"
  dw02:             "ieee dw02 dware"
  dw03:             "std synopsys dware dw03 dw02 dw01 ieee gtech"
  dw04:             "dw04 ieee dw01 dware gtech"
  dw05:             "dw05 ieee dware"
  dw06:             "dw06 ieee dware"
  dw07:             "ieee dware"
  dware:            "ieee dware"
  gtech:            "ieee gtech"
  ramlib:           "std ieee"
  std_cell_lib:     "ieee std_cell_lib"
  synopsys:         ""

targets = parse_deps()
console.log toposort targets


import ceylon.collection {
	ArrayList
}

shared void run() {

	class Node(label, left = null, right = null) {
		shared Integer label;
		shared Node? left;
		shared Node? right;
		string => label.string;
	}

	void preorder(Node node) {
		process.write(node.string + " ");
		if(exists left = node.left) {
			preorder(left);
		}
		if(exists right = node.right) {
			preorder(right);
		}
	}

	void inorder(Node node) {
		if(exists left = node.left) {
			inorder(left);
		}
		process.write(node.string + " ");
		if(exists right = node.right) {
			inorder(right);
		}
	}

	void postorder(Node node) {
		if(exists left = node.left) {
			postorder(left);
		}
		if(exists right = node.right) {
			postorder(right);
		}
		process.write(node.string + " ");
	}

	void levelOrder(Node node) {
		value nodes = ArrayList<Node> {node};
		while(exists current = nodes.accept()) {
			process.write(current.string + " ");
			if(exists left = current.left) {
				nodes.offer(left);
			}
			if(exists right = current.right) {
				nodes.offer(right);
			}
		}
	}

	value tree = Node {
		label = 1;
		left = Node {
			label = 2;
			left = Node {
				label = 4;
				left = Node {
					label = 7;
				};
			};
			right = Node {
				label = 5;
			};
		};
		right = Node {
			label = 3;
			left = Node {
				label = 6;
				left = Node {
					label = 8;
				};
				right = Node {
					label = 9;
				};
			};
		};
	};

	process.write("preorder:   ");
	preorder(tree);
	print("");
	process.write("inorder:    ");
	inorder(tree);
	print("");
	process.write("postorder:  ");
	postorder(tree);
	print("");
	process.write("levelorder: ");
	levelOrder(tree);
	print("");
}


(defun topological-sort (graph &key (test 'eql))
  "Graph is an association list whose keys are objects and whose
values are lists of objects on which the corresponding key depends.
Test is used to compare elements, and should be a suitable test for
hash-tables.  Topological-sort returns two values.  The first is a
list of objects sorted toplogically.  The second is a boolean
indicating whether all of the objects in the input graph are present
in the topological ordering (i.e., the first value)."
  (let ((entries (make-hash-table :test test)))
    (flet ((entry (vertex)
             "Return the entry for vertex.  Each entry is a cons whose
              car is the number of outstanding dependencies of vertex
              and whose cdr is a list of dependants of vertex."
             (multiple-value-bind (entry presentp) (gethash vertex entries)
               (if presentp entry
                 (setf (gethash vertex entries) (cons 0 '()))))))
      ;; populate entries initially
      (dolist (vertex graph)
        (destructuring-bind (vertex &rest dependencies) vertex
          (let ((ventry (entry vertex)))
            (dolist (dependency dependencies)
              (let ((dentry (entry dependency)))
                (unless (funcall test dependency vertex)
                  (incf (car ventry))
                  (push vertex (cdr dentry))))))))
      ;; L is the list of sorted elements, and S the set of vertices
      ;; with no outstanding dependencies.
      (let ((L '())
            (S (loop for entry being each hash-value of entries
                     using (hash-key vertex)
                     when (zerop (car entry)) collect vertex)))
        ;; Until there are no vertices with no outstanding dependencies,
        ;; process vertices from S, adding them to L.
        (do* () ((endp S))
          (let* ((v (pop S)) (ventry (entry v)))
            (remhash v entries)
            (dolist (dependant (cdr ventry) (push v L))
              (when (zerop (decf (car (entry dependant))))
                (push dependant S)))))
        ;; return (1) the list of sorted items, (2) whether all items
        ;; were sorted, and (3) if there were unsorted vertices, the
        ;; hash table mapping these vertices to their dependants
        (let ((all-sorted-p (zerop (hash-table-count entries))))
          (values (nreverse L)
                  all-sorted-p
                  (unless all-sorted-p
                    entries)))))))


(defn walk [node f order]
  (when node
   (doseq [o order]
     (if (= o :visit)
       (f (:val node))
       (walk (node o) f order)))))

(defn preorder [node f]
  (walk node f [:visit :left :right]))

(defn inorder [node f]
  (walk node f [:left :visit :right]))

(defn postorder [node f]
  (walk node f [:left :right :visit]))

(defn queue [& xs]
  (when (seq xs)
   (apply conj clojure.lang.PersistentQueue/EMPTY xs)))

(defn level-order [root f]
  (loop [q (queue root)]
    (when-not (empty? q)
      (if-let [node (first q)]
        (do
          (f (:val node))
          (recur (conj (pop q) (:left node) (:right node))))
        (recur (pop q))))))

(defn vec-to-tree [t]
  (if (vector? t)
    (let [[val left right] t]
      {:val val
       :left (vec-to-tree left)
       :right (vec-to-tree right)})
    t))

(let [tree (vec-to-tree [1 [2 [4 [7]] [5]] [3 [6 [8] [9]]]])
      fs   '[preorder inorder postorder level-order]
      pr-node #(print (format "%2d" %))]
  (doseq [f fs]
    (print (format "%-12s" (str f ":")))
    ((resolve f) tree pr-node)
    (println)))


def dfs_topo_visit(n, g, tmp, permanent, l)
    if permanent.includes?(n)
        return
    elsif tmp.includes?(n)
        raise "unorderable: circular dependency detected involving '#{n}'"
    end
    tmp.add(n)

    g[n].each { |m|
        dfs_topo_visit(m, g, tmp, permanent, l)
    }

    tmp.delete(n)
    permanent.add(n)
    l.insert(0, n)
end

def dfs_topo_sort(g)
    tmp = Set(String).new
    permanent = Set(String).new
    l = Array(String).new

    while true
        keys = g.keys.to_set - permanent
        if keys.empty?
            break
        end

        n = keys.first
        dfs_topo_visit(n, g, tmp, permanent, l)
    end

    return l
end

def build_graph(deps)
    g = {} of String => Set(String)
    deps.split("\n").each { |line|
        line_split = line.strip.split
        line_split.each { |dep|
            unless g.has_key?(dep)
                g[dep] = Set(String).new
            end
            unless line_split[0] == dep
                g[dep].add(line_split[0])
            end
        }
    }
    return g
end

data = "des_system_lib   std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee
dw01             ieee dw01 dware gtech
dw02             ieee dw02 dware
dw03             std synopsys dware dw03 dw02 dw01 ieee gtech
dw04             dw04 ieee dw01 dware gtech
dw05             dw05 ieee dware
dw06             dw06 ieee dware
dw07             ieee dware
dware            ieee dware
gtech            ieee gtech
ramlib           std ieee
std_cell_lib     ieee std_cell_lib
synopsys"

circular_deps = "\ncyc01             cyc02
                   cyc02             cyc01"

puts dfs_topo_sort(build_graph(data)).join(" -> ")
puts ""
puts dfs_topo_sort(build_graph(data + circular_deps)).join(" -> ")


import std.stdio, std.string, std.algorithm, std.range;

final class ArgumentException : Exception {
    this(string text) pure nothrow @safe /*@nogc*/ {
        super(text);
    }
}

alias TDependencies = string[][string];

string[][] topoSort(TDependencies d) pure /*nothrow @safe*/ {
    foreach (immutable k, v; d)
        d[k] = v.sort().uniq.filter!(s => s != k).array;
    foreach (immutable s; d.byValue.join.sort().uniq)
        if (s !in d)
            d[s] = [];

    string[][] sorted;
    while (true) {
        string[] ordered;

        foreach (immutable item, const dep; d)
            if (dep.empty)
                ordered ~= item;
        if (!ordered.empty)
            sorted ~= ordered.sort().release;
        else
            break;

        TDependencies dd;
        foreach (immutable item, const dep; d)
            if (!ordered.canFind(item))
                dd[item] = dep.dup.filter!(s => !ordered.canFind(s)).array;
        d = dd;
    }

    //if (!d.empty)
    if (d.length > 0)
        throw new ArgumentException(format(
            "A cyclic dependency exists amongst:\n%s", d));

    return sorted;
}

void main() {
    immutable data =
"des_system_lib std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee
dw01           ieee dw01 dware gtech
dw02           ieee dw02 dware
dw03           std synopsys dware dw03 dw02 dw01 ieee gtech
dw04           dw04 ieee dw01 dware gtech
dw05           dw05 ieee dware
dw06           dw06 ieee dware
dw07           ieee dware
dware          ieee dware
gtech          ieee gtech
ramlib         std ieee
std_cell_lib   ieee std_cell_lib
synopsys";

    TDependencies deps;
    foreach (immutable line; data.splitLines)
        deps[line.split[0]] = line.split[1 .. $];

    auto depw = deps.dup;
    foreach (immutable idx, const subOrder; depw.topoSort)
        writefln("#%d : %s", idx + 1,  subOrder);

    writeln;
    depw = deps.dup;
    depw["dw01"] ~= "dw04";
    foreach (const subOrder; depw.topoSort) // Should throw.
        subOrder.writeln;
}


bintree = cluster [T: type] is leaf, node,
                               pre_order, post_order, in_order, level_order
    branch = struct[left, right: bintree[T], val: T]
    rep = oneof[br: branch, leaf: null]

    leaf = proc () returns (cvt)
        return(rep$make_leaf(nil))
    end leaf

    node = proc (val: T, l,r: cvt) returns (cvt)
        return(rep$make_br(branch${left:up(l), right:up(r), val:val}))
    end node

    pre_order = iter (n: cvt) yields (T)
        tagcase n
            tag br (b: branch):
                yield(b.val)
                for v: T in pre_order(b.left) do yield(v) end
                for v: T in pre_order(b.right) do yield(v) end
            tag leaf:
        end
    end pre_order

    in_order = iter (n: cvt) yields (T)
        tagcase n
            tag br (b: branch):
                for v: T in in_order(b.left) do yield(v) end
                yield(b.val)
                for v: T in in_order(b.right) do yield(v) end
            tag leaf:
        end
    end in_order

    post_order = iter (n: cvt) yields (T)
        tagcase n
            tag br (b: branch):
                for v: T in post_order(b.left) do yield(v) end
                for v: T in post_order(b.right) do yield(v) end
                yield(b.val)
            tag leaf:
        end
    end post_order

    level_order = iter (n: cvt) yields (T)
        bfs: array[rep] := array[rep]$[n]
        while ~array[rep]$empty(bfs) do
            cur: rep := array[rep]$reml(bfs)
            tagcase cur
                tag br (b: branch):
                    yield(b.val)
                    array[rep]$addh(bfs,down(b.left))
                    array[rep]$addh(bfs,down(b.right))
                tag leaf:
            end
        end
    end level_order
end bintree

start_up = proc ()
    bt = bintree[int]

    po: stream := stream$primary_output()
    tree: bt := bt$node(1,
                    bt$node(2,
                        bt$node(4,
                            bt$node(7, bt$leaf(), bt$leaf()),
                            bt$leaf()),
                        bt$node(5, bt$leaf(), bt$leaf())),
                    bt$node(3,
                        bt$node(6,
                            bt$node(8, bt$leaf(), bt$leaf()),
                            bt$node(9, bt$leaf(), bt$leaf())),
                        bt$leaf()))

    stream$puts(po, "preorder:   ")
    for i: int in bt$pre_order(tree) do
        stream$puts(po, " " || int$unparse(i))
    end

    stream$puts(po, "\ninorder:    ")
    for i: int in bt$in_order(tree) do
        stream$puts(po, " " || int$unparse(i))
    end

    stream$puts(po, "\npostorder:  ")
    for i: int in bt$post_order(tree) do
        stream$puts(po, " " || int$unparse(i))
    end

    stream$puts(po, "\nlevel-order:")
    for i: int in bt$level_order(tree) do
        stream$puts(po, " " || int$unparse(i))
    end
end start_up


def makeQueue := <elib:vat.makeQueue>

def topoSort(data :Map[any, Set[any]]) {
    # Tables of nodes and edges
    def forwardEdges := [].asMap().diverge()
    def reverseCount := [].asMap().diverge()

    def init(node) {
      reverseCount[node] := 0
      forwardEdges[node] := [].asSet().diverge()
    }
    for node => deps in data {
        init(node)
        for dep in deps { init(dep) }
    }

    # 'data' holds the dependencies. Compute the other direction.
    for node => deps in data {
        for dep ? (dep != node) in deps {
            forwardEdges[dep].addElement(node)
            reverseCount[node] += 1
        }
    }

    # Queue containing all elements that have no (initial or remaining) incoming edges
    def ready := makeQueue()
    for node => ==0 in reverseCount {
      ready.enqueue(node)
    }

    var result := []

    while (ready.optDequeue() =~ node :notNull) {
        result with= node
        for next in forwardEdges[node] {
            # Decrease count of incoming edges and enqueue if none
            if ((reverseCount[next] -= 1).isZero()) {
                ready.enqueue(next)
            }
        }
        forwardEdges.removeKey(node)
    }

    if (forwardEdges.size().aboveZero()) {
        throw(`Topological sort failed: $forwardEdges remains`)
    }

    return result
}


# In this example, we don't encapsulate binary trees as objects; instead, we have a
# convention on how to store them as arrays, and we namespace the functions that
# operate on those data structures.
binary_tree =
  preorder: (tree, visit) ->
    return unless tree?
    [node, left, right] = tree
    visit node
    binary_tree.preorder left, visit
    binary_tree.preorder right, visit

  inorder: (tree, visit) ->
    return unless tree?
    [node, left, right] = tree
    binary_tree.inorder left, visit
    visit node
    binary_tree.inorder right, visit

  postorder: (tree, visit) ->
    return unless tree?
    [node, left, right] = tree
    binary_tree.postorder left, visit
    binary_tree.postorder right, visit
    visit node

  levelorder: (tree, visit) ->
    q = []
    q.push tree
    while q.length > 0
      t = q.shift()
      continue unless t?
      [node, left, right] = t
      visit node
      q.push left
      q.push right

do ->
  tree = [1, [2, [4, [7]], [5]], [3, [6, [8],[9]]]]
  test_walk = (walk_function_name) ->
    output = []
    binary_tree[walk_function_name] tree, output.push.bind(output)
    console.log walk_function_name, output.join ' '
  test_walk "preorder"
  test_walk "inorder"
  test_walk "postorder"
  test_walk "levelorder"


(define dependencies
'((des_system_lib   std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee)
(dw01             ieee dw01 dware gtech) ;; bad graph add dw04
(dw02             ieee dw02 dware )
(dw03             std synopsys dware dw03 dw02 dw01 ieee gtech)
(dw04             dw04 ieee dw01 dware gtech)
(dw05             dw05 ieee dware)
(dw06             dw06 ieee dware)
(dw07             ieee dware)
(dware            ieee dware)
(gtech            ieee gtech)
(ramlib           std ieee )
(std_cell_lib     ieee std_cell_lib)
(synopsys         )))

;; build dependency graph
;;  a depends on b
;;  add arc (arrow) a --> b
(lib 'graph.lib)
(define (a->b  g a b)
		(unless (equal? a b)
		(graph-make-arc g (graph-make-vertex g a) (graph-make-vertex g b))))

(define (add-dependencies g dep-list)
(for* ((dep dep-list)  (b (rest dep))) (a->b  g b (first dep))))


/* ARM assembly AARCH64 Raspberry PI 3B or android 64 bits */
/* program tonshan64.s   */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"

/*******************************************/
/* Initialized data                        */
/*******************************************/
.data
szMessStartPgm:          .asciz "Program 64 bits start \n"
szMessEndPgm:            .asciz "Program normal end.\n"
szMessError:             .asciz "\033[31mError  !!!\n"
szMessErrGen:            .asciz "Error end program.\n"
szMessOverflow:          .asciz "Overflow function modulo.\n"
szMessNoSolution:        .asciz "No solution.\n"
szCarriageReturn:        .asciz "\n"

/* datas message display */
szMessEntry:             .asciz "Number : @ modulo : @ ==> "
szMessResult:            .asciz "Racine 1 : @ Racine 2 : @  \n"

qNumberN:            .quad 44402
qNumberP:            .quad 100049
/*******************************************/
/* UnInitialized data                      */
/*******************************************/
.bss
.align 4
sZoneConv:               .skip 24
/*******************************************/
/*  code section                           */
/*******************************************/
.text
.global main
main:                               // program start
    ldr x0,qAdrszMessStartPgm       // display start message
    bl affichageMess

    mov x0,10
    mov x1,13
    bl displayEntry
    bl computeTonSha
    bl displayResult

    mov x0,56
    mov x1,101
    bl displayEntry
    bl computeTonSha
    bl displayResult

    mov x0,1030
    mov x1,10009
    bl displayEntry
    bl computeTonSha
    bl displayResult

    mov x0,1032
    mov x1,10009
    bl displayEntry
    bl computeTonSha
    bcs 1f
    bl displayResult
1:
    ldr x4,qAdrqNumberN
    ldr x0,[x4]
    ldr x4,qAdrqNumberP
    ldr x1,[x4]
    bl displayEntry
    bl computeTonSha
    bl displayResult

    ldr x0,qAdrszMessEndPgm         // display end message
    bl affichageMess
    b 100f
99:                                 // display error message
    ldr x0,qAdrszMessError
    bl affichageMess
100:                                // standard end of the program
    mov x0, #0                      // return code
    mov x8, #EXIT                   // request to exit program
    svc 0                           // perform system call
qAdrszMessStartPgm:        .quad szMessStartPgm
qAdrszMessEndPgm:          .quad szMessEndPgm
qAdrszMessError:           .quad szMessError
qAdrszMessNoSolution:      .quad szMessNoSolution
qAdrszCarriageReturn:      .quad szCarriageReturn
qAdrqNumberN:              .quad qNumberN
qAdrqNumberP:              .quad qNumberP

qAdrszMessResult:          .quad szMessResult
qAdrsZoneConv:             .quad sZoneConv

/******************************************************************/
/*     algorithm Tonelli–Shanks                                   */
/******************************************************************/
/* x0 contains number */
/* x1 contains modulus */
/* x0 return root 1 */
/* x1 return root 2 */
computeTonSha:
    stp x10,lr,[sp,-16]!    // save  registres
    stp x2,x3,[sp,-16]!     // save  registres
    stp x4,x5,[sp,-16]!     // save  registres
    stp x6,x7,[sp,-16]!     // save  registres
    stp x8,x9,[sp,-16]!     // save  registres
    stp x11,x12,[sp,-16]!   // save  registres
    mov x9,x0               // save number
    mov x10,x1              // save modulo p
    mov x2,x10
    sub x1,x2,1
    lsr x1,x1,1
    bl moduloPuR64
    bcs 100f                // error ?
    cmp x0,#1
    bne 20f
    sub x5,x10,1
    mov x6,#1               // s
1:
    lsr x5,x5,#1            // div by 2
    tst x5,1                // even ?
    cinc x6,x6,eq           // yes count
    beq 1b                  // and loop
                            // x5 = q
    cmp x6,#1               // s = 1 ?
    bne 3f
    add x1,x10,1            // compute root 1
    lsr x1,x1,#2            // p + 1 / 4
    mov x0,x9               // n
    mov x2,x10              // p
    bl moduloPuR64
    bcs 100f                // error ?
    neg x1,x0               // compute root 2 = - root 1
    b 100f                  // and end
3:
    mov x7,#3               // z
4:
    mov x0,x7
    mov x2,x10              //  p
    sub x1,x2,1
    lsr x1,x1,1             // power = p - 1 / 2
    bl moduloPuR64
    bcs 100f                // error ?
    cmp x0,#1
    cinc x7,x7,eq           // si égal à 1
    cinc x7,x7,eq
    beq 4b
    cmp x0,0
    cinc x7,x7,eq           // si egal à 0
    cinc x7,x7,eq
    beq 4b
    mov x0,x7               // z
    mov x1,x5               // q
    mov x2,x10              // p
    bl moduloPuR64
    bcs 100f                // error ?
    mov x12,x0              // c = z pow q mod p

    add x1,x5,1             // = q +1
    lsr x1,x1,1             // div 2
    mov x0,x9               // n
    mov x2,x10              // p
    bl moduloPuR64
    mov x4,x0               // r =  n puis (q+1)/2 mod p

    mov x0,x9               // n
    mov x1,x5               // = q
    mov x2,x10              // p
    bl moduloPuR64
    bcs 100f                // error ?
    mov x5,x0               // reuse r5 = t = n pow q mod p

8:                          // begin loop
    cmp x5,1
    beq 10f
    mov x0,x5               // t
    mov x1,x6               // m
    mov x2,x10              // p
    bl searchI              // search i for t puis 2 puis i = 1 mod p
    cmp x0,-1               // not find -> no solution
    beq 20f
    mov x9,x0               // i
    sub x8,x6,x0            // compute b
    sub x8,x8,1             // m - i - 1
    mov x1,1
    lsl x1,x1,x8
    mov x0,x12
    mov x2,x10              // p
    bl moduloPuR64
    bcs 100f                // error ?
    mov x7,x0               // b = c puis 2 puis 2 puis m-i-1  à verifier

    mul x0,x7,x4            // r = r * b mod p
    umulh x1,x7,x4
    mov x2,x10
    bl divisionReg128U
    mov x4,x3               // r mod p
    mul x0,x7,x7
    umulh x1,x7,x7
    mov x2,x10
    bl divisionReg128U
    mov x12,x3              // c mod p

    mul x0,x5,x12
    umulh x1,x5,x12
    mov x2,x10
    bl divisionReg128U
    mov x5,x3               // t mod p

    mov x6,x9               // m = i
    b 8b
9:

10:
    mov x0,x4               // x0 return root 1
    sub x1,x10,x0           //  x1 return root 2
    cmn x0,0                // carry à zero roots ok
   b 100f
20:
    ldr x0,qAdrszMessNoSolution
    bl affichageMess

    mov x0,0
    mov x1,0
    cmp x0,0               // carry to 1 No solution
100:
    ldp x11,x12,[sp],16
    ldp x8,x9,[sp],16
    ldp x6,x7,[sp],16
    ldp x4,x5,[sp],16
    ldp x2,x3,[sp],16
    ldp x10,lr,[sp],16      // restaur des  2 registres
    ret                     // retour adresse lr x30

/******************************************************************/
/*     search i                                               */
/******************************************************************/
// x0 contains t
// x1 contains maxi
// x2 contains modulo
searchI:
    stp x1,lr,[sp,-16]!    // save  registres
    stp x2,x3,[sp,-16]!    // save  registres
    stp x4,x5,[sp,-16]!    // save  registres
    stp x6,x7,[sp,-16]!    // save  registres
    mov x4,x0              // t
    mov x6,x1              // m
    mov x3,1               // i
1:
    mov x5,1
    lsl x5,x5,x3           // compute 2 power i

    mov x0,x4
    mov x1,x5
    bl moduloPuR64         // compute t pow 2 pow i mod p
    cmp x0,1               // = 1 ?
    beq 3f                 // yes it is ok
    add x3,x3,1            // next i
    cmp x3,x6
    blt 1b                 // loop
    mov x0,-1              // not find
    b 100f
3:
    mov x0,x3              // return i
100:
    ldp x6,x7,[sp],16
    ldp x4,x5,[sp],16
    ldp x2,x3,[sp],16
    ldp x1,lr,[sp],16         // restaur des  2 registres
    ret                       // retour adresse lr x30
/******************************************************************/
/*     display numbers                                             */
/******************************************************************/
/* x0 contains number */
/* x1 contains modulo */
displayEntry:
    stp x0,lr,[sp,-16]!        // save  registres
    stp x1,x2,[sp,-16]!        // save  registres
    mov x2,x1                  // root 2
    ldr x1,qAdrsZoneConv       // convert root 1 in r0
    bl conversion10S           // convert ascii string
    ldr x0,qAdrszMessEntry
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc      // and put in message
    mov x3,x0
    mov x0,x2                  // racine 2
    ldr x1,qAdrsZoneConv
    bl conversion10S           // convert ascii string
    mov x0,x3
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc      // and put in message
    bl affichageMess
100:
    ldp x1,x2,[sp],16
    ldp x0,lr,[sp],16          // restaur des  2 registres
    ret                        // retour adresse lr x30
qAdrszMessEntry:   .quad szMessEntry
/******************************************************************/
/*     display roots                                               */
/******************************************************************/
/* x0 contains root 1 */
/* x1 contains root 2 */
displayResult:
    stp x1,lr,[sp,-16]!        // save  registres
    stp x2,x3,[sp,-16]!        // save  registres
    mov x2,x1                  // root 2
    ldr x1,qAdrsZoneConv       // convert root 1 in r0
    bl conversion10S           // convert ascii string
    ldr x0,qAdrszMessResult
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc      // and put in message
    mov x3,x0
    mov x0,x2                  // racine 2
    ldr x1,qAdrsZoneConv
    bl conversion10S           // convert ascii string
    mov x0,x3
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc      // and put in message
    bl affichageMess
100:
    ldp x2,x3,[sp],16
    ldp x1,lr,[sp],16          // restaur des  2 registres
    ret                        // retour adresse lr x30
/**************************************************************/
/********************************************************/
/*   Calcul modulo de b puissance e modulo m  */
/*    Exemple 4 puissance 13 modulo 497 = 445         */
/********************************************************/
/* x0  nombre  */
/* x1 exposant */
/* x2 modulo   */
moduloPuR64:
    stp x1,lr,[sp,-16]!        // save  registres
    stp x3,x4,[sp,-16]!        // save  registres
    stp x5,x6,[sp,-16]!        // save  registres
    stp x7,x8,[sp,-16]!        // save  registres
    stp x9,x10,[sp,-16]!        // save  registres
    cbz x0,100f
    cbz x1,100f
    mov x8,x0
    mov x7,x1
    mov x6,1                   // resultat
    udiv x4,x8,x2
    msub x9,x4,x2,x8           // contient le reste
1:
    tst x7,1
    beq 2f
    mul x4,x9,x6
    umulh x5,x9,x6
    mov x6,x4
    mov x0,x6
    mov x1,x5
    bl divisionReg128U
    cbnz x1,99f                // overflow
    mov x6,x3
2:
    mul x8,x9,x9
    umulh x5,x9,x9
    mov x0,x8
    mov x1,x5
    bl divisionReg128U
    cbnz x1,99f                // overflow
    mov x9,x3
    lsr x7,x7,1
    cbnz x7,1b
    cmn x0,0                   // carry à zero pas d'erreur
    mov x0,x6                  // result
    b 100f
99:
    ldr x0,qAdrszMessOverflow
    bl  affichageMess
    cmp x0,0                   // carry à un car erreur
    mov x0,-1                  // code erreur

100:
    ldp x9,x10,[sp],16          // restaur des  2 registres
    ldp x7,x8,[sp],16          // restaur des  2 registres
    ldp x5,x6,[sp],16          // restaur des  2 registres
    ldp x3,x4,[sp],16          // restaur des  2 registres
    ldp x1,lr,[sp],16          // restaur des  2 registres
    ret                        // retour adresse lr x30
qAdrszMessOverflow:         .quad  szMessOverflow
/***************************************************/
/*   division d un nombre de 128 bits par un nombre de 64 bits */
/***************************************************/
/* x0 contient partie basse dividende */
/* x1 contient partie haute dividente */
/* x2 contient le diviseur */
/* x0 retourne partie basse quotient */
/* x1 retourne partie haute quotient */
/* x3 retourne le reste */
divisionReg128U:
    stp x6,lr,[sp,-16]!        // save  registres
    stp x4,x5,[sp,-16]!        // save  registres
    mov x5,#0                  // raz du reste R
    mov x3,#128                // compteur de boucle
    mov x4,#0                  // dernier bit
1:
    lsl x5,x5,#1               // on decale le reste de 1
    tst x1,1<<63               // test du bit le plus à gauche
    lsl x1,x1,#1               // on decale la partie haute du quotient de 1
    beq 2f
    orr  x5,x5,#1              // et on le pousse dans le reste R
2:
    tst x0,1<<63
    lsl x0,x0,#1               // puis on decale la partie basse
    beq 3f
    orr x1,x1,#1               // et on pousse le bit de gauche dans la partie haute
3:
    orr x0,x0,x4               // position du dernier bit du quotient
    mov x4,#0                  // raz du bit
    cmp x5,x2
    blt 4f
    sub x5,x5,x2                // on enleve le diviseur du reste
    mov x4,#1                   // dernier bit à 1
4:
                               // et boucle
    subs x3,x3,#1
    bgt 1b
    lsl x1,x1,#1               // on decale le quotient de 1
    tst x0,1<<63
    lsl x0,x0,#1              // puis on decale la partie basse
    beq 5f
    orr x1,x1,#1
5:
    orr x0,x0,x4                  // position du dernier bit du quotient
    mov x3,x5
100:
    ldp x4,x5,[sp],16          // restaur des  2 registres
    ldp x6,lr,[sp],16          // restaur des  2 registres
    ret                        // retour adresse lr x30

/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"