import random, sequtils, strutils

type Node = ref object
  value: int
  left, right: Node

proc add(tree: var Node; value: int) =
  ## Add a node to a tree (or subtree), insuring values are in increasing order.
  if tree.isNil:
    tree = Node(value: value)
  elif value <= tree.value:
    tree.left.add value
  else:
    tree.right.add value

proc newTree(list: varargs[int]): Node =
  ## Create a new tree with the given nodes.
  for value in list:
    result.add value

proc `$`(tree: Node): string =
  # Display a tree.
  if tree.isNil: return
  result = '(' & $tree.left & $tree.value & $tree.right & ')'

iterator nodes(tree: Node): Node =
  ## Yield the successive leaves of a tree.
  ## Iterators cannot be recursive, so we have to manage a stack.
  ## Note: with Nim 1.4 a bug prevents to use a closure iterator,
  ## so we use an inline iterator which is not optimal here.

  type
    Direction {.pure.} = enum Up, Down
    Item = (Node, Direction)

  var stack: seq[Item]
  stack.add (nil, Down) # Sentinel to avoid checking for empty stack.

  var node = tree
  var dir = Down

  while not node.isNil:
    if dir == Down and not node.left.isNil:
      # Process left subtree.
      stack.add (node, Up)
      node = node.left
    else:
      yield node
      # Process right subtree of pop an element form stack.
      (node, dir) = if node.right.isNil: stack.pop() else: (node.right, Down)

proc haveSameFringe(tree1, tree2: Node): bool =
  ## Return true if the trees have the same fringe.
  ## Check is done node by node and terminates as soon as
  ## a difference is encountered.
  let iter1 = iterator: Node = (for node in tree1.nodes: yield node)
  let iter2 = iterator: Node = (for node in tree2.nodes: yield node)
  while true:
    let node1 = iter1()
    let node2 = iter2()
    if iter1.finished and iter2.finished: return true # Both terminates at same round.
    if iter1.finished or iter2.finished: return false # One terminates  before the other.
    if node1.value != node2.value: return false

when isMainModule:
  randomize()
  var values = [1, 2, 3, 4, 5, 6, 7, 8, 9]

  values.shuffle()
  let tree1 = newTree(values)
  echo "First tree:  ", tree1

  values.shuffle()
  let tree2 = newTree(values)
  echo "Second tree: ", tree2

  let s = if haveSameFringe(tree1, tree2): "have " else: "don’t have "
  echo "The trees ", s, "same fringe: ", toSeq(tree1.nodes()).mapIt(it.value).join(", ")


type 'a btree = Leaf of 'a | BTree of ('a btree * 'a btree)

let rec next = function
  | [] -> None
  | h :: t -> match h with
    | Leaf x -> Some (x,t)
    | BTree(a,b) -> next (a::b::t)

let samefringe t1 t2 =
  let rec aux s1 s2 = match (next s1, next s2) with
    | None, None -> true
    | None, _ | _, None -> false
    | Some(a,b), Some(c,d) -> (a=c) && aux b d in
  aux [t1] [t2]

(* Test: *)
let () =
  let u = BTree(Leaf 1, BTree(Leaf 2, Leaf 3)) in
  let v = BTree(BTree(Leaf 1, Leaf 2), Leaf 3) in
  let w = BTree(BTree(Leaf 3, Leaf 2), Leaf 1) in
  let check a b =
    print_endline (if samefringe a b then "same" else "different") in
  check u v; check v u; check v w;


#!/usr/bin/perl
use strict;

my @trees = (
    # 0..2 are same
    [ 'd', [ 'c', [ 'a', 'b', ], ], ],
    [ [ 'd', 'c' ], [ 'a', 'b' ] ],
    [ [ [ 'd', 'c', ], 'a', ], 'b', ],
    # and this one's different!
    [ [ [ [ [ [ 'a' ], 'b' ], 'c', ], 'd', ], 'e', ], 'f' ],
);

for my $tree_idx (1 .. $#trees) {
    print "tree[",$tree_idx-1,"] vs tree[$tree_idx]: ",
           cmp_fringe($trees[$tree_idx-1], $trees[$tree_idx]), "\n";
}

sub cmp_fringe {
    my $ti1 = get_tree_iterator(shift);
    my $ti2 = get_tree_iterator(shift);
    while (1) {
        my ($L, $R) = ($ti1->(), $ti2->());
        next if defined($L) and defined($R) and $L eq $R;
        return "Same" if !defined($L) and !defined($R);
        return "Different";
    }
}

sub get_tree_iterator {
    my @rtrees = (shift);
    my $tree;
    return sub {
        $tree = pop @rtrees;
        ($tree, $rtrees[@rtrees]) = @$tree while ref $tree;
        return $tree;
    }
}


--
-- demo\rosetta\Same_Fringe.exw
-- ============================
--
--  In some cases it may help to replace the single res with a table, such
--  that if you have concurrent task pairs {1,2} and {3,4} with a table of
--  result indexes ridx = {1,1,2,2}, then each updates res[ridx[tidx]]. In
--  other words if extending tasks[] rather than overwriting it, you would
--  also extend res[] and ridx[] and sdata[], and need freelist handling.
--
without js -- (multitasking)

constant tests = {{0,1,{0,2,0}},
                  {{0,1,0},2,0},
                  {{0,1,0},2,{0,3,0}},
                 }

sequence tasks,
         sdata = repeat(0,2)
integer res = 0,
        active_tasks
bool show_details = true

procedure scan(sequence tree, integer level, integer tidx)
    object {left,data,right} = tree
    if res=0 then
        if left!=0 then scan(left,level+1,tidx) end if
        sdata[tidx] = data
        if show_details then
            printf(1,"task[%d] sets sdata[%d] to %v\n",{tidx,tidx,data})
        end if
        if res=0 then
            task_suspend(task_self())
            task_yield()
        end if
        if right!=0 then scan(right,level+1,tidx) end if
    end if
    if level=1 then
        if show_details then
            printf(1,"task[%d] ends\n",tidx)
        end if
        active_tasks -= 1
        tasks[tidx] = 0
        sdata[tidx] = -1 -- (or use a separate flag or tasks[tidx])
    end if
end procedure

procedure test(integer t1, t2)
    tasks = {task_create(routine_id("scan"),{tests[t1],1,1}),
             task_create(routine_id("scan"),{tests[t2],1,2})}
    active_tasks = 2
    res = 0
    while active_tasks>0 do
        for i=1 to 2 do
            if tasks[i] then
                task_schedule(tasks[i],1)
                task_yield()
            end if
        end for
        if res=0 then
            -- (nb next might only be valid for active_tasks==2)
            res = compare(sdata[1],sdata[2])
            if show_details then
                printf(1,"compare(%v,%v) ==> %d, active tasks:%d\n",
                         {sdata[1],sdata[2],res,active_tasks})
            end if
        end if
    end while
    printf(1,"test(%d,%d):%d\n",{t1,t2,res})
end procedure

?"started"
for l=1 to 3 do
    for r=1 to 3 do
        test(l,r)
        show_details = 0
    end for
end for

?"done"
{} = wait_key()


(de nextLeaf (Rt Tree)
   (co Rt
      (recur (Tree)
         (when Tree
            (recurse (cadr Tree))
            (yield (car Tree))
            (recurse (cddr Tree)) ) ) ) )

(de cmpTrees (Tree1 Tree2)
   (prog1
      (use (Node1 Node2)
         (loop
            (setq
               Node1 (nextLeaf "rt1" Tree1)
               Node2 (nextLeaf "rt2" Tree2) )
            (T (nor Node1 Node2) T)
            (NIL (= Node1 Node2)) ) )
      (co "rt1")
      (co "rt2") ) )


try:
    from itertools import zip_longest as izip_longest # Python 3.x
except:
    from itertools import izip_longest                # Python 2.6+

def fringe(tree):
    """Yield tree members L-to-R depth first,
    as if stored in a binary tree"""
    for node1 in tree:
        if isinstance(node1, tuple):
            for node2 in fringe(node1):
                yield node2
        else:
            yield node1

def same_fringe(tree1, tree2):
    return all(node1 == node2 for node1, node2 in
               izip_longest(fringe(tree1), fringe(tree2)))

if __name__ == '__main__':
    a = 1, 2, 3, 4, 5, 6, 7, 8
    b = 1, (( 2, 3 ), (4, (5, ((6, 7), 8))))
    c = (((1, 2), 3), 4), 5, 6, 7, 8

    x = 1, 2, 3, 4, 5, 6, 7, 8, 9
    y = 0, 2, 3, 4, 5, 6, 7, 8
    z = 1, 2, (4, 3), 5, 6, 7, 8

    assert same_fringe(a, a)
    assert same_fringe(a, b)
    assert same_fringe(a, c)

    assert not same_fringe(a, x)
    assert not same_fringe(a, y)
    assert not same_fringe(a, z)


F primes_upto(limit)
   V is_prime = [0B]*2 [+] [1B]*(limit - 1)
   L(n) 0 .< Int(limit ^ 0.5 + 1.5)
      I is_prime[n]
         L(i) (n*n..limit).step(n)
            is_prime[i] = 0B
   R enumerate(is_prime).filter((i, prime) -> prime).map((i, prime) -> i)

print(primes_upto(100))


#lang racket

(module same-fringe lazy
  (provide same-fringe?)
  (define (same-fringe? t1 t2)
    (! (equal? (flatten t1) (flatten t2))))
  (define (flatten tree)
    (if (list? tree)
      (apply append (map flatten tree))
      (list tree))))

(require 'same-fringe)

(module+ test
  (require rackunit)
  (check-true (same-fringe? '((1 2 3) ((4 5 6) (7 8)))
                            '(((1 2 3) (4 5 6)) (7 8))))
  (check-false (same-fringe? '((1 2 3) ((4 5 6) (7 8)))
                             '(((1 2 3) (4 6)) (8)))))


sub fringe ($tree) {
    multi sub fringey (Pair $node) { fringey $_ for $node.kv; }
    multi sub fringey ( Any $leaf) { take $leaf; }

    gather fringey $tree;
}

sub samefringe ($a, $b) { fringe($a) eqv fringe($b) }

# Testing:

my $a = 1 => 2 => 3 => 4 => 5 => 6 => 7 => 8;
my $b = 1 => (( 2 => 3 ) => (4 => (5 => ((6 => 7) => 8))));
my $c = (((1 => 2) => 3) => 4) => 5 => 6 => 7 => 8;

my $x = 1 => 2 => 3 => 4 => 5 => 6 => 7 => 8 => 9;
my $y = 0 => 2 => 3 => 4 => 5 => 6 => 7 => 8;
my $z = 1 => 2 => (4 => 3) => 5 => 6 => 7 => 8;

say  so samefringe $a, $a;
say  so samefringe $a, $b;
say  so samefringe $a, $c;

say not samefringe $a, $x;
say not samefringe $a, $y;
say not samefringe $a, $z;


*        Sieve of Eratosthenes
ERATOST  CSECT
         USING  ERATOST,R12
SAVEAREA B      STM-SAVEAREA(R15)
         DC     17F'0'
         DC     CL8'ERATOST'
STM      STM    R14,R12,12(R13) save calling context
         ST     R13,4(R15)
         ST     R15,8(R13)
         LR     R12,R15         set addessability
*        ----   CODE
         LA     R4,1            I=1
         LA     R6,1            increment
         L      R7,N            limit
LOOPI    BXH    R4,R6,ENDLOOPI  do I=2 to N
         LR     R1,R4           R1=I
         BCTR   R1,0
         LA     R14,CRIBLE(R1)
         CLI    0(R14),X'01'
         BNE    ENDIF           if not CRIBLE(I)
         LR     R5,R4           J=I
         LR     R8,R4
         LR     R9,R7
LOOPJ    BXH    R5,R8,ENDLOOPJ  do J=I*2 to N by I
         LR     R1,R5           R1=J
         BCTR   R1,0
         LA     R14,CRIBLE(R1)
         MVI    0(R14),X'00'    CRIBLE(J)='0'B
         B      LOOPJ
ENDLOOPJ EQU    *
ENDIF    EQU    *
         B      LOOPI
ENDLOOPI EQU    *
         LA     R4,1            I=1
         LA     R6,1
         L      R7,N
LOOP     BXH    R4,R6,ENDLOOP   do I=1 to N
         LR     R1,R4           R1=I
         BCTR   R1,0
         LA     R14,CRIBLE(R1)
         CLI    0(R14),X'01'
         BNE    NOTPRIME        if not CRIBLE(I)
         CVD    R4,P            P=I
         UNPK   Z,P             Z=P
         MVC    C,Z             C=Z
         OI     C+L'C-1,X'F0'   zap sign
         MVC    WTOBUF(8),C+8
         WTO    MF=(E,WTOMSG)
NOTPRIME EQU    *
         B      LOOP
ENDLOOP  EQU    *
RETURN   EQU    *
         LM     R14,R12,12(R13) restore context
         XR     R15,R15         set return code to 0
         BR     R14             return to caller
*        ----   DATA
I        DS     F
J        DS     F
         DS     0F
P        DS     PL8             packed
Z        DS     ZL16            zoned
C        DS     CL16            character
WTOMSG   DS     0F
         DC     H'80'           length of WTO buffer
         DC     H'0'            must be binary zeroes
WTOBUF   DC     80C' '
         LTORG
N        DC     F'100000'
CRIBLE   DC     100000X'01'
         YREGS
         END    ERATOST


/* REXX ***************************************************************
* Same Fringe
*           1                A                 A
*          / \              / \               / \
*         /   \            /   \             /   \
*        /     \          /     \           /     \
*       2       3        B       C         B       C
*      / \     /        / \     /         / \     /
*     4   5   6        D   E   F         D   E   F
*    /       / \      /       / \       /       / \
*   7       8   9    G       H   I     G       *   I
*
* 23.08.2012 Walter Pachl derived from
*                            http://rosettacode.org/wiki/Tree_traversal
* Tree A: A B D G E C F H I
* Tree B: A B D G E C F * I
**********************************************************************/
debug=0
node.=0
lvl=0

Call mktree 'A'
Call mktree 'B'

done.=0
za=root.a; leafa=node.a.za.0name
zb=root.a; leafb=node.b.zb.0name
done.a.za=1
done.b.zb=1
Do i=1 To 12
  if leafa=leafb Then Do
    If leafa=0 Then Do
      Say 'Fringes are equal'
      Leave
      End
    Say leafa '=' leafb
    Do j=1 To 12 Until done.a.za=0
      za=go_next(za,'A'); leafa=node.a.za.0name
      End
    done.a.za=1
    Do j=1 To 12 Until done.b.zb=0
      zb=go_next(zb,'B'); leafb=node.b.zb.0name
      End
    done.b.zb=1
    End
  Else Do
    Select
      When leafa=0 Then
        Say leafb 'exceeds leaves in tree A'
      When leafb=0 Then
        Say leafa 'exceeds leaves in tree B'
      Otherwise
        Say 'First difference' leafa '<>' leafb
      End
    Leave
    End
  End
Exit

note:
/**********************************************************************
* add the node to the preorder list unless it's already there
* add the node to the level list
**********************************************************************/
  Parse Arg z,t
  If z<>0 &,                           /* it's a node                */
     done.z=0 Then Do                  /* not yet done               */
    wl.t=wl.t z                        /* add it to the preorder list*/
    ll.lvl=ll.lvl z                    /* add it to the level list   */
    done.z=1                           /* remember it's done         */
    leafl=leafl node.t.z.0name
    End
  Return

go_next: Procedure Expose node. lvl
/**********************************************************************
* find the next node to visit in the treewalk
**********************************************************************/
  next=0
  Parse arg z,t
  If node.t.z.0left<>0 Then Do         /* there is a left son        */
    If node.t.z.0left.done=0 Then Do   /* we have not visited it     */
      next=node.t.z.0left              /* so we go there             */
      node.t.z.0left.done=1            /* note we were here          */
      lvl=lvl+1                        /* increase the level         */
      End
    End
  If next=0 Then Do                    /* not moved yet              */
    If node.t.z.0rite<>0 Then Do       /* there is a right son       */
      If node.t.z.0rite.done=0 Then Do /* we have not visited it     */
        next=node.t.z.0rite            /* so we go there             */
        node.t.z.0rite.done=1          /* note we were here          */
        lvl=lvl+1                      /* increase the level         */
        End
      End
    End
  If next=0 Then Do                    /* not moved yet              */
    next=node.t.z.0father              /* go to the father           */
    lvl=lvl-1                          /* decrease the level         */
    End
  Return next                          /* that's the next node       */
                                       /* or zero if we are done     */

mknode: Procedure Expose node.
/**********************************************************************
* create a new node
**********************************************************************/
  Parse Arg name,t
  z=node.t.0+1
  node.t.z.0name=name
  node.t.z.0father=0
  node.t.z.0left =0
  node.t.z.0rite =0
  node.t.0=z
  Return z                        /* number of the node just created */

attleft: Procedure Expose node.
/**********************************************************************
* make son the left son of father
**********************************************************************/
  Parse Arg son,father,t
  node.t.son.0father=father
  z=node.t.father.0left
  If z<>0 Then Do
    node.t.z.0father=son
    node.t.son.0left=z
    End
  node.t.father.0left=son
  Return

attrite: Procedure Expose node.
/**********************************************************************
* make son the right son of father
**********************************************************************/
  Parse Arg son,father,t
  node.t.son.0father=father
  z=node.t.father.0rite
  If z<>0 Then Do
    node.t.z.0father=son
    node.t.son.0rite=z
    End
  node.t.father.0rite=son
  le=node.t.father.0left
  If le>0 Then
    node.t.le.0brother=node.t.father.0rite
  Return

mktree: Procedure Expose node. root.
/**********************************************************************
* build the tree according to the task
**********************************************************************/
  Parse Arg t
  If t='A' Then Do
    a=mknode('A',t); root.t=a
    b=mknode('B',t); Call attleft b,a,t
    c=mknode('C',t); Call attrite c,a,t
    d=mknode('D',t); Call attleft d,b,t
    e=mknode('E',t); Call attrite e,b,t
    f=mknode('F',t); Call attleft f,c,t
    g=mknode('G',t); Call attleft g,d,t
    h=mknode('H',t); Call attleft h,f,t
    i=mknode('I',t); Call attrite i,f,t
    End
  Else Do
    a=mknode('A',t); root.t=a
    b=mknode('B',t); Call attleft b,a,t
    c=mknode('C',t); Call attrite c,a,t
    d=mknode('D',t); Call attleft d,b,t
    e=mknode('E',t); Call attrite e,b,t
    f=mknode('F',t); Call attleft f,c,t
    g=mknode('G',t); Call attleft g,d,t
    h=mknode('*',t); Call attleft h,f,t
    i=mknode('I',t); Call attrite i,f,t
    End
  Return


ERATOS: STA  $D0      ; value of n
        LDA  #$00
        LDX  #$00
SETUP:  STA  $1000,X  ; populate array
        ADC  #$01
        INX
        CPX  $D0
        BPL  SET
        JMP  SETUP
SET:    LDX  #$02
SIEVE:  LDA  $1000,X  ; find non-zero
        INX
        CPX  $D0
        BPL  SIEVED
        CMP  #$00
        BEQ  SIEVE
        STA  $D1      ; current prime
MARK:   CLC
        ADC  $D1
        TAY
        LDA  #$00
        STA  $1000,Y
        TYA
        CMP  $D0
        BPL  SIEVE
        JMP  MARK
SIEVED: LDX  #$01
        LDY  #$00
COPY:   INX
        CPX  $D0
        BPL  COPIED
        LDA  $1000,X
        CMP  #$00
        BEQ  COPY
        STA  $2000,Y
        INY
        JMP  COPY
COPIED: TYA           ; how many found
        RTS


; binary tree helpers from "Structure and Interpretation of Computer Programs" 2.3.3
(define (entry tree) (car tree))
(define (left-branch tree) (cadr tree))
(define (right-branch tree) (caddr tree))
(define (make-tree entry left right)
  (list entry left right))

; returns a list of leftmost nodes from each level of the tree
(define (descend tree ls)
  (if (null? (left-branch tree))
    (cons tree ls)
    (descend (left-branch tree) (cons tree ls))))

; updates the list to contain leftmost nodes from each remaining level
(define (ascend ls)
  (cond
    ((and (null? (cdr ls)) (null? (right-branch (car ls)))) '())
    ((null? (right-branch (car ls))) (cdr ls))
    (else
      (let ((ls (cons (right-branch (car ls))
		  (cdr ls))))
	    (if (null? (left-branch (car ls)))
	      ls
	      (descend (left-branch (car ls)) ls))))))

; loops thru each list until the end (true) or nodes are unequal (false)
(define (same-fringe? t1 t2)
  (let next ((l1 (descend t1 '()))
	     (l2 (descend t2 '())))
    (cond
      ((and (null? l1) (null? l2)) #t)
      ((or (null? l1)
	   (null? l2)
	   (not (eq? (entry (car l1)) (entry (car l2))))) #f)
      (else (next (ascend l1) (ascend l2))))))


var trees = [
    # 0..2 are same
    [ 'd', [ 'c', [ 'a', 'b', ], ], ],
    [ [ 'd', 'c' ], [ 'a', 'b' ] ],
    [ [ [ 'd', 'c', ], 'a', ], 'b', ],
    # and this one's different!
    [ [ [ [ [ [ 'a' ], 'b' ], 'c', ], 'd', ], 'e', ], 'f' ],
]

func get_tree_iterator(*rtrees) {
    var tree
    func {
        tree = rtrees.pop
        while (defined(tree) && tree.kind_of(Array)) {
            rtrees.append(tree[1])
            tree = tree[0]
        }
        return tree
    }
}

func cmp_fringe(a, b) {
    var ti1 = get_tree_iterator(a)
    var ti2 = get_tree_iterator(b)
    loop {
        var (L, R) = (ti1(), ti2())
         defined(L) &&  defined(R) && (L == R) && next
        !defined(L) && !defined(R) && return "Same"
        return "Different"
    }
}

for idx in ^(trees.end) {
    say ("tree[#{idx}] vs tree[#{idx+1}]: ",
           cmp_fringe(trees[idx], trees[idx+1]))
}


*-----------------------------------------------------------
* Title      : BitSieve
* Written by : G. A. Tippery
* Date       : 2014-Feb-24, 2013-Dec-22
* Description: Prime number sieve
*-----------------------------------------------------------
    	ORG    $1000

**	---- Generic macros ----	**
PUSH	MACRO
	MOVE.L	\1,-(SP)
	ENDM

POP	MACRO
	MOVE.L	(SP)+,\1
	ENDM

DROP	MACRO
	ADDQ	#4,SP
	ENDM

PUTS	MACRO
	** Print a null-terminated string w/o CRLF **
	** Usage: PUTS stringaddress
	** Returns with D0, A1 modified
	MOVEQ	#14,D0	; task number 14 (display null string)
	LEA	\1,A1	; address of string
	TRAP	#15	; display it
	ENDM

GETN	MACRO
	MOVEQ	#4,D0	; Read a number from the keyboard into D1.L.
	TRAP	#15
	ENDM

**	---- Application-specific macros ----	**

val	MACRO		; Used by bit sieve. Converts bit address to the number it represents.
	ADD.L	\1,\1	; double it because odd numbers are omitted
	ADDQ	#3,\1	; add offset because initial primes (1, 2) are omitted
	ENDM

* ** ================================================================================ **
* ** Integer square root routine, bisection method **
* ** IN: D0, should be 0<D0<$10000 (65536) -- higher values MAY work, no guarantee
* ** OUT: D1
*
SquareRoot:
*
	MOVEM.L	D2-D4,-(SP)	; save registers needed for local variables
*	DO == n
*	D1 == a
*	D2 == b
*	D3 == guess
*	D4 == temp
*
*		a = 1;
*		b = n;
	MOVEQ	#1,D1
	MOVE.L	D0,D2
*		do {
	REPEAT
*		guess = (a+b)/2;
	MOVE.L	D1,D3
	ADD.L	D2,D3
	LSR.L	#1,D3
*		if (guess*guess > n) {	// inverse function of sqrt is square
	MOVE.L	D3,D4
	MULU	D4,D4		; guess^2
	CMP.L	D0,D4
	BLS	.else
*		b = guess;
	MOVE.L	D3,D2
	BRA	.endif
*		} else {
.else:
*		a = guess;
	MOVE.L	D3,D1
*		} //if
.endif:
*		} while ((b-a) > 1);	; Same as until (b-a)<=1 or until (a-b)>=1
	MOVE.L	D2,D4
	SUB.L	D1,D4	; b-a
	UNTIL.L	  D4 <LE> #1 DO.S
*		return (a)	; Result is in D1
*		} //LongSqrt()
	MOVEM.L	(SP)+,D2-D4	; restore saved registers
	RTS
*
* ** ================================================================================ **

** ======================================================================= **
*
**  Prime-number Sieve of Eratosthenes routine using a big bit field for flags  **
*  Enter with D0 = size of sieve (bit array)
*  Prints found primes 10 per line
*  Returns # prime found in D6
*
*   Register usage:
*
*	D0 == n
*	D1 == prime
*	D2 == sqroot
*	D3 == PIndex
*	D4 == CIndex
*	D5 == MaxIndex
*	D6 == PCount
*
*	A0 == PMtx[0]
*
*   On return, all registers above except D0 are modified. Could add MOVEMs to save and restore D2-D6/A0.
*

**	------------------------	**

GetBit:		** sub-part of Sieve subroutine **
		** Entry: bit # is on TOS
		** Exit: A6 holds the byte number, D7 holds the bit number within the byte
		** Note: Input param is still on TOS after return. Could have passed via a register, but
                **  wanted to practice with stack. :)
*
	MOVE.L	(4,SP),D7	; get value from (pre-call) TOS
	ASR.L	#3,D7	; /8
	MOVEA	D7,A6	; byte #
	MOVE.L	(4,SP),D7	; get value from (pre-call) TOS
	AND.L	#$7,D7	; bit #
	RTS

**	------------------------	**

Sieve:
	MOVE	D0,D5
	SUBQ	#1,D5
	JSR	SquareRoot	; sqrt D0 => D1
	MOVE.L	D1,D2
	LEA	PArray,A0
	CLR.L	D3
*
PrimeLoop:
	MOVE.L	D3,D1
	val	D1
	MOVE.L	D3,D4
	ADD.L	D1,D4
*
CxLoop:		; Goes through array marking multiples of d1 as composite numbers
	CMP.L	D5,D4
	BHI	ExitCx
	PUSH	D4	; set D7 as bit # and A6 as byte pointer for D4'th bit of array
	JSR GetBit
	DROP
	BSET	D7,0(A0,A6.L)	; set bit to mark as composite number
	ADD.L	D1,D4	; next number to mark
	BRA	CxLoop
ExitCx:
	CLR.L	D1	; Clear new-prime-found flag
	ADDQ	#1,D3	; Start just past last prime found
PxLoop:		; Searches for next unmarked (not composite) number
	CMP.L	D2,D3	; no point searching past where first unmarked multiple would be past end of array
	BHI	ExitPx	; if past end of array
	TST.L	D1
	BNE	ExitPx	; if flag set, new prime found
	PUSH D3		; check D3'th bit flag
	JSR	GetBit	; sets D7 as bit # and A6 as byte pointer
	DROP		; drop TOS
	BTST	D7,0(A0,A6.L)	; read bit flag
	BNE	IsSet	; If already tagged as composite
	MOVEQ	#-1,D1	; Set flag that we've found a new prime
IsSet:
	ADDQ	#1,D3	; next PIndex
	BRA	PxLoop
ExitPx:
	SUBQ	#1,D3	; back up PIndex
	TST.L	D1	; Did we find a new prime #?
	BNE	PrimeLoop	; If another prime # found, go process it
*
		; fall through to print routine

**	------------------------	**

* Print primes found
*
*	D4 == Column count
*
*	Print header and assumed primes (#1, #2)
    	PUTS	Header	; Print string @ Header, no CR/LF
	MOVEQ	#2,D6	; Start counter at 2 because #1 and #2 are assumed primes
	MOVEQ	#2,D4
*
	MOVEQ	#0,D3
PrintLoop:
	CMP.L	D5,D3
	BHS	ExitPL
	PUSH	D3
	JSR	GetBit	; sets D7 as bit # and A6 as byte pointer
	DROP		; drop TOS
	BTST	D7,0(A0,A6.L)
	BNE		NotPrime
*		printf(" %6d", val(PIndex)
	MOVE.L	D3,D1
	val	D1
	AND.L	#$0000FFFF,D1
	MOVEQ	#6,D2
	MOVEQ	#20,D0	; display signed RJ
	TRAP	#15
	ADDQ	#1,D4
	ADDQ	#1,D6
*	*** Display formatting ***
*		if((PCount % 10) == 0) printf("\n");
	CMP	#10,D4
	BLO	NoLF
	PUTS	CRLF
	MOVEQ	#0,D4
NoLF:
NotPrime:
	ADDQ	#1,D3
	BRA	PrintLoop
ExitPL:
	RTS

** ======================================================================= **

N	EQU	5000	; *** Size of boolean (bit) array ***
SizeInBytes	EQU	(N+7)/8
*
START:                  	; first instruction of program
	MOVE.L	#N,D0	; # to test
	JSR	Sieve
*		printf("\n %d prime numbers found.\n", D6); ***
	PUTS	Summary1,A1
	MOVE	#3,D0	; Display signed number in D1.L in decimal in smallest field.
	MOVE.W	D6,D1
	TRAP	#15
	PUTS	Summary2,A1

	SIMHALT             	; halt simulator

** ======================================================================= **

* Variables and constants here

	ORG	$2000
CR	EQU	13
LF	EQU	10
CRLF	DC.B	CR,LF,$00

PArray:	DCB.B	SizeInBytes,0

Header:	DC.B	CR,LF,LF,' Primes',CR,LF,' ======',CR,LF
		DC.B	'     1     2',$00

Summary1:	DC.B	CR,LF,' ',$00
Summary2:	DC.B	' prime numbers found.',CR,LF,$00

    END    START        	; last line of source


package require Tcl 8.6
package require struct::tree

# A wrapper round a coroutine for iterating over the leaves of a tree in order
proc leafiterator {tree} {
    coroutine coro[incr ::coroutines] apply {tree {
	yield [info coroutine]
	$tree walk [$tree rootname] node {
	    if {[$tree isleaf $node]} {
		yield $node
	    }
	}
	yieldto break
    }} $tree
}

# Compare two trees for equality of their leaf node names
proc samefringe {tree1 tree2} {
    set c1 [leafiterator $tree1]
    set c2 [leafiterator $tree2]
    try {
	while 1 {
	    if {[set l1 [$c1]] ne [set l2 [$c2]]} {
		puts "$l1 != $l2";    # Just so we can see where we failed
		return 0
	    }
	}
	return 1
    } finally {
	rename $c1 {}
	rename $c2 {}
    }
}


import "/dynamic" for Struct

var Node = Struct.create("Node", ["key", "left", "right"])

// 'leaves' returns a fiber that yields the leaves of the tree
//  until all leaves have been received.
var leaves = Fn.new { |t|
    // recursive function to walk tree
    var f
    f = Fn.new { |n|
        if (!n) return
        // leaves are identified by having no children
        if (!n.left && !n.right) {
            Fiber.yield(n.key)
        } else {
            f.call(n.left)
            f.call(n.right)
        }
    }
    // return a fiber which walks the tree
    return Fiber.new { f.call(t) }
}

var sameFringe = Fn.new { |t1, t2|
    var f1 = leaves.call(t1)
    var f2 = leaves.call(t2)
    var l1
    while (l1 = f1.call()) {
        // both trees must yield a leaf, and the leaves must be equal
        var l2
        if ((l2 = f2.call()) && (!l2 || l1 != l2)) return false
    }
    // there must be nothing left in f2 after consuming all of f1
    return !f2.call()
}

// the different shapes of the trees is shown with indention,
// the leaves being easy to spot by the key
var t1 = Node.new(3,
             Node.new(1,
                 Node.new(1, null, null),
                 Node.new(2, null, null)
             ),
             Node.new(8,
                 Node.new(5, null, null),
                 Node.new(13, null, null)
             )
         )
// t2 with negative values for internal nodes that can't possibly match
// positive values in t1, just to show that only leaves are being compared.
var t2 = Node.new(-8,
             Node.new(-3,
                 Node.new(-1,
                     Node.new(1, null, null),
                     Node.new(2, null, null)
                 ),
                 Node.new(5, null,null)
             ),
             Node.new(13, null, null)
         )
// t3 as t2 but with a different leave
var t3 = Node.new(-8,
             Node.new(-3,
                 Node.new(-1,
                     Node.new(1, null, null),
                     Node.new(2, null, null)
                 ),
                 Node.new(5, null,null)
             ),
             Node.new(14, null, null) // 14 instead of 13
         )
System.print("tree 1 and tree 2 have the same leaves: %(sameFringe.call(t1, t2))")
System.print("tree 1 and tree 3 have the same leaves: %(sameFringe.call(t1, t3))")
System.print("tree 2 and tree 3 have the same leaves: %(sameFringe.call(t2, t3))")


MAXPRM:	equ	5000		; Change this value for more primes
	cpu	8086
	bits	16
	org	100h
section	.text
erato:	mov	cx,MAXPRM	; Initialize array (set all items to prime)
	mov	bp,cx		; Keep a copy in BP
	mov	di,sieve
	mov	al,1
	rep	stosb
	;;;	Sieve
	mov	bx,sieve	; Set base register to array
	inc	cx		; CX=1 (CH=0, CL=1); CX was 0 before
	mov	si,cx		; Start at number 2 (1+1)
.next:	inc	si		; Next number
	cmp	cl,[bx+si]	; Is this number marked as prime?
	jne	.next		; If not, try next number
	mov	ax,si		; Otherwise, calculate square,
	mul	si
	mov	di,ax		; and put it in DI
	cmp	di,bp		; Check array bounds
	ja	output		; We're done when SI*SI>MAXPRM
.mark:	mov	[bx+di],ch	; Mark byte as composite
	add	di,si		; Next composite
	cmp 	di,bp		; While maximum not reached
	jbe	.mark
	jmp	.next
	;;;	Output
output:	mov	si,2		; Start at 2
.test:	dec	byte [bx+si]	; Prime?
	jnz	.next		; If not, try next number
	mov	ax,si		; Otherwise, print number
	call	prax
.next:	inc	si
	cmp	si,MAXPRM
	jbe	.test
	ret
	;;;	Write number in AX to standard output (using MS-DOS)
prax:	push	bx		; Save BX
	mov	bx,numbuf
	mov	bp,10		; Divisor
.loop:	xor	dx,dx		; Divide AX by 10, modulus in DX
	div	bp
	add	dl,'0'		; ASCII digit
	dec	bx
	mov	[bx],dl		; Store ASCII digit
	test	ax,ax		; More digits?
	jnz	.loop
	mov	dx,bx		; Print number
	mov	ah,9		; 9 = MS-DOS syscall to print string
	int	21h
	pop	bx		; Restore BX
	ret
section	.data
	db	'*****'		; Room for number
numbuf:	db	13,10,'$'
section	.bss
sieve:	resb	MAXPRM


var G=Utils.Generator;
//Tree: (node,left,right) or (leaf) or (node,left) ...
aTree := T(1, T(2, T(4, T(7)), T(5)), T(3, T(6, T(8), T(9))));
bTree := aTree;
println("aTree and bTree ",sameFringe(aTree,bTree) and "have" or "don't have",
          " the same leaves.");
cTree := T(1, T(2, T(4, T(7)), T(5)), T(3, T(6, T(8))));
dTree := T(1, T(2, T(4, T(7)), T(5)), T(3, T(6, T(8), T(9))));
println("cTree and dTree ",sameFringe(cTree,dTree) and "have"or"don't have",
          " the same leaves.");

fcn sameFringe(a,b){ same(G(genLeaves,a),G(genLeaves,b)) }

fcn same(g1,g2){ //(Generator,Generator)
   foreach n1,n2 in (g1.zip(g2)){ //-->(int,int) ...
      if(n1 != n2) return(); // == return(Void)
   }
   return(not (g2._next() or g2._next())); //-->False if g1 or g2 has leaves
}

fcn genLeaves(tree){
   switch(tree.len()){ // (), (leaf), (node,left, [right])
      case(1){ vm.yield(tree[0]) } // leaf: int
      case(2){ genLeaves(tree[1]); }
      else   { genLeaves(tree[1]); genLeaves(tree[2]); }
   }
}


type Interval is record
   Lower : Float;
   Upper : Float;
end record;


Msgbox % IntervalAdd(1,2) ; [2.999999,3.000001]

SetFormat, FloatFast, 0.20
Msgbox % IntervalAdd(1,2) ; [2.99999999999999910000,3.00000000000000090000]

;In v1.0.48+, floating point variables have about 15 digits of precision internally
;unless SetFormat Float (i.e. the slow mode) is present anywhere in the script.
;In that case, the stored precision of floating point numbers is determined by A_FormatFloat.
;As there is no way for this function to know whether this is the case or not,
;it conservatively uses A_FormatFloat in all cases.
IntervalAdd(a,b){
	err:=0.1**(SubStr(A_FormatFloat,3) > 15 ? 15 : SubStr(A_FormatFloat,3))
	Return "[" a+b-err ","a+b+err "]"
}


T City
   String name
   Float population

   F (name, population)
      .name = name
      .population = population

V cities = [
        City(‘Lagos’, 21),
        City(‘Cairo’, 15.2),
        City(‘Kinshasa-Brazzaville’, 11.3),
        City(‘Greater Johannesburg’, 7.55),
        City(‘Mogadishu’, 5.85),
        City(‘Khartoum-Omdurman’, 4.98),
        City(‘Dar Es Salaam’, 4.7),
        City(‘Alexandria’, 4.58),
        City(‘Abidjan’, 4.4),
        City(‘Casablanca’, 3.98)
    ]

F first_index(cities, condition)
   L(city) cities
      I condition(city)
         R L.index

F first(cities, condition)
   L(city) cities
      I condition(city)
         R city

print(first_index(cities, city -> city.name == ‘Dar Es Salaam’))
print(first(cities, city -> city.population < 5.0).name)
print(first(cities, city -> city.name[0] == ‘A’).population)


with: n

\ create a new buffer which will function as a bit vector
: bit-vec SED: n -- b
    dup 3 shr swap 7 band if 1+ then b:new b:clear ;

\ given a buffer, sieving prime, and limit, cross off multiples
\ of the sieving prime.
: +composites SED: b n n -- b
    >r dup sqr rot \ want: -- n index b
    repeat
        over 1- true b:bit!
        >r over + r>
    over [email protected] > until!
    rdrop nip nip ;

\ SoE algorithm proper
: make-sieve SED: n -- b
    dup>r bit-vec 2
    repeat
        tuck 1- b:[email protected] not
        if
            over [email protected] +composites
        then swap 1+
    dup sqr [email protected] < while!
    rdrop drop ;

\ traverse the final buffer, creating an array of primes
: sieve>a SED: b n -- a
    >r a:new swap
    ( 1- b:[email protected] not if >r I a:push r> then ) 2 r> loop drop ;

;with

: sieve SED: n -- a
    dup make-sieve swap sieve>a ;


#include <fenv.h>	/* fegetround(), fesetround() */
#include <stdio.h>	/* printf() */

/*
 * Calculates an interval for a + b.
 *   interval[0] <= a + b
 *   a + b <= interval[1]
 */
void
safe_add(volatile double interval[2], volatile double a, volatile double b)
{
#pragma STDC FENV_ACCESS ON
	unsigned int orig;

	orig = fegetround();
	fesetround(FE_DOWNWARD);	/* round to -infinity */
	interval[0] = a + b;
	fesetround(FE_UPWARD);		/* round to +infinity */
	interval[1] = a + b;
	fesetround(orig);
}

int
main()
{
	const double nums[][2] = {
		{1, 2},
		{0.1, 0.2},
		{1e100, 1e-100},
		{1e308, 1e308},
	};
	double ival[2];
	int i;

	for (i = 0; i < sizeof(nums) / sizeof(nums[0]); i++) {
		/*
		 * Calculate nums[i][0] + nums[i][1].
		 */
		safe_add(ival, nums[i][0], nums[i][1]);

		/*
		 * Print the result. %.17g gives the best output.
		 * %.16g or plain %g gives not enough digits.
		 */
		printf("%.17g + %.17g =\n", nums[i][0], nums[i][1]);
		printf("    [%.17g, %.17g]\n", ival[0], ival[1]);
		printf("    size %.17g\n\n", ival[1] - ival[0]);
	}
	return 0;
}


using System;

namespace SafeAddition {
    class Program {
        static float NextUp(float d) {
            if (d == 0.0) return float.Epsilon;
            if (float.IsNaN(d) || float.IsNegativeInfinity(d) || float.IsPositiveInfinity(d)) return d;

            byte[] bytes = BitConverter.GetBytes(d);
            int dl = BitConverter.ToInt32(bytes, 0);
            dl++;
            bytes = BitConverter.GetBytes(dl);

            return BitConverter.ToSingle(bytes, 0);
        }

        static float NextDown(float d) {
            if (d == 0.0) return -float.Epsilon;
            if (float.IsNaN(d) || float.IsNegativeInfinity(d) || float.IsPositiveInfinity(d)) return d;

            byte[] bytes = BitConverter.GetBytes(d);
            int dl = BitConverter.ToInt32(bytes, 0);
            dl--;
            bytes = BitConverter.GetBytes(dl);

            return BitConverter.ToSingle(bytes, 0);
        }

        static Tuple<float, float> SafeAdd(float a, float b) {
            return new Tuple<float, float>(NextDown(a + b), NextUp(a + b));
        }

        static void Main(string[] args) {
            float a = 1.20f;
            float b = 0.03f;

            Console.WriteLine("({0} + {1}) is in the range {2}", a, b, SafeAdd(a, b));
        }
    }
}


	.model small
	.stack 1024

	.data
Africa     WORD LAGOS   ;"jagged" arrays are the bane of assembly programming, so store the string's pointer here instead.
	   WORD 2100H	;this is a bit cheaty but it's easier to store these as BCD whole numbers
	   WORD CAIRO
	   WORD 1520H
	   WORD KB
	   WORD 1130H
	   WORD GJ
	   WORD 0755H
	   WORD MOGADISHU
	   WORD 0585H
	   WORD KO
	   WORD 0498H
	   WORD DES
	   WORD 0470H
	   WORD ALEXANDRIA
	   WORD 0458H
	   WORD ABIDJAN
	   WORD 0440H
	   WORD CASABLANCA
	   WORD 0398H

LAGOS BYTE "Lagos",0
CAIRO BYTE "Cairo",0
KB BYTE "Kinshasa-Brazzaville",0
GJ BYTE "Greater Johannesburg",0
MOGADISHU BYTE "Mogadishu",0
KO BYTE "Khartoum-Omdurman",0
DES BYTE "Dar Es Salaam",0
ALEXANDRIA BYTE "Alexandria"
ABIDJAN BYTE "Abidjan",0
CASABLANCA BYTE "Casablanca",0

	.code
start:

	mov ax,@data
	mov ds,ax

	mov ax,@code
	mov es,ax

	cld	;String functions are set to auto-increment

	mov ax,2  ;clear screen by reloading the video mode we're in
	int 10h

	mov si,offset Africa

;test 1: find the index of the city whose name is Dar-Es-Salaam

	mov di,offset DES ;it's easier to test the equality of two pointers than of two strings.
	mov cx,10	  ;ten cities to check
	mov bx,0	  ;our counter

test_case_1:
	lodsw
	cmp ax,di		;compare to the pointer of Dar-Es_Salaam
	je done_test_case_1
	add si,2	        ;we know populations aren't going to match so skip them
	inc bx			;increment the counter
	loop test_case_1

done_test_case_1:
	mov al,bl
	call Printhex	        ;print the index of Dar-Es-Salaam
	call Newline		;print CRLF

;test 2: print the name of the first city whose population is less than 5 million.
	mov si,offset Africa
	mov cx,10

test_case_2:
	lodsw		;we know that the struct goes city:pop so skip the first word.
	lodsw
	cmp ax,0500h
	jae skip
		sub si,4		;point SI back to the city name
		mov si,[ds:si]
		call PrintString
		call NewLine
		jmp done_test_case_2

skip:
	loop test_case_2
done_test_case_2:

;test 3: find the population of the first city in this list whose name starts with A
	mov si,offset Africa
	mov cx,10

test_case_3:
	lodsw
	push si
		mov si,ax
		lodsb
		cmp al,'A'
	pop si
	je FoundIt		;popping SI won't affect the compare result.

	add si,2		;skip population
	loop test_case_3

ExitDOS:
	mov ax,4C00h		;return to dos
	int 21h

FoundIt:
	lodsw
	mov dx,ax
	mov al,dh
	call Printhex_NoLeadingZeroes
	mov al,'.'             ;we're faking floating point for simplicity's sake
	call PrintChar
	mov al,dl
	call PrintHex
	jmp ExitDos

end start


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program cribleEras64.s   */

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

.equ MAXI,      100

/*********************************/
/* Initialized data              */
/*********************************/
.data
sMessResult:        .asciz "Prime  : @ \n"
szCarriageReturn:   .asciz "\n"

/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:                  .skip 24
TablePrime:                 .skip   8 * MAXI
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                               // entry of program
    ldr x4,qAdrTablePrime           // address prime table
    mov x0,#2                       // prime 2
    bl displayPrime
    mov x1,#2
    mov x2,#1
1:                                  // loop for multiple of 2
    str x2,[x4,x1,lsl #3]           // mark  multiple of 2
    add x1,x1,#2
    cmp x1,#MAXI                    // end ?
    ble 1b                          // no loop
    mov x1,#3                       // begin indice
    mov x3,#1
2:
    ldr x2,[x4,x1,lsl #3]           // load table élément
    cmp x2,#1                       // is prime ?
    beq 4f
    mov x0,x1                       // yes -> display
    bl displayPrime
    mov x2,x1
3:                                  // and loop to mark multiples of this prime
    str x3,[x4,x2,lsl #3]
    add x2,x2,x1                    // add the prime
    cmp x2,#MAXI                    // end ?
    ble 3b                          // no -> loop
4:
    add x1,x1,2                     // other prime in table
    cmp x1,MAXI                     // end table ?
    ble 2b                          // no -> loop

100:                                // standard end of the program
    mov x0,0                        // return code
    mov x8,EXIT                     // request to exit program
    svc 0                           // perform the system call
qAdrszCarriageReturn:    .quad szCarriageReturn
qAdrsMessResult:         .quad sMessResult
qAdrTablePrime:          .quad TablePrime

/******************************************************************/
/*      Display prime table elements                                */
/******************************************************************/
/* x0 contains the prime */
displayPrime:
    stp x1,lr,[sp,-16]!             // save  registers
    ldr x1,qAdrsZoneConv
    bl conversion10                 // call décimal conversion
    ldr x0,qAdrsMessResult
    ldr x1,qAdrsZoneConv            // insert conversion in message
    bl strInsertAtCharInc
    bl affichageMess                // display message
100:
    ldp x1,lr,[sp],16               // restaur  2 registers
    ret                             // return to address lr x30
qAdrsZoneConv:                   .quad sZoneConv

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


#include <iostream>
#include <tuple>

union conv {
    int i;
    float f;
};

float nextUp(float d) {
    if (isnan(d) || d == -INFINITY || d == INFINITY) return d;
    if (d == 0.0) return FLT_EPSILON;

    conv c;
    c.f = d;
    c.i++;

    return c.f;
}

float nextDown(float d) {
    if (isnan(d) || d == -INFINITY || d == INFINITY) return d;
    if (d == 0.0) return -FLT_EPSILON;

    conv c;
    c.f = d;
    c.i--;

    return c.f;
}

auto safeAdd(float a, float b) {
    return std::make_tuple(nextDown(a + b), nextUp(a + b));
}

int main() {
    float a = 1.20f;
    float b = 0.03f;

    auto result = safeAdd(a, b);
    printf("(%f + %f) is in the range (%0.16f, %0.16f)\n", a, b, std::get<0>(result), std::get<1>(result));

    return 0;
}


import std.traits;
auto safeAdd(T)(T a, T b)
if (isFloatingPoint!T) {
    import std.math;     // nexDown, nextUp
    import std.typecons; // tuple
    return tuple!("d", "u")(nextDown(a+b), nextUp(a+b));
}

import std.stdio;
void main() {
    auto a = 1.2;
    auto b = 0.03;

    auto r = safeAdd(a, b);
    writefln("(%s + %s) is in the range %0.16f .. %0.16f", a, b, r.d, r.u);
}


def makeInterval(a :float64, b :float64) {
    require(a <= b)
    def interval {
        to least() { return a }
        to greatest() { return b }
        to __printOn(out) {
            out.print("[", a, ", ", b, "]")
        }
        to add(other) {
            require(a <=> b)
            require(other.least() <=> other.greatest())
            def result := a + other.least()
            return makeInterval(result.previous(), result.next())
        }
    }
    return interval
}


[
  { "name": "Lagos",                "population": 21.0  },
  { "name": "Cairo",                "population": 15.2  },
  { "name": "Kinshasa-Brazzaville", "population": 11.3  },
  { "name": "Greater Johannesburg", "population":  7.55 },
  { "name": "Mogadishu",            "population":  5.85 },
  { "name": "Khartoum-Omdurman",    "population":  4.98 },
  { "name": "Dar Es Salaam",        "population":  4.7  },
  { "name": "Alexandria",           "population":  4.58 },
  { "name": "Abidjan",              "population":  4.4  },
  { "name": "Casablanca",           "population":  3.98 }
] var, cities-raw

"Index of first occurrence of 'Dar Es Salaam': " .
"Dar Es Salaam" >r cities-raw @
(
  "name" m:@ [email protected] s:= if
    drop . cr ;;
  then
  2drop
) a:each drop rdrop

"The name of the first city in this list whose population is less than 5 million: " .
5 >r cities-raw @
(
  nip
  "population" m:@ [email protected] n:< if
    "name" m:@ . cr break
  then
  drop
) a:each drop rdrop

"The population of the first city in this list whose name starts with the letter \"A\": " .
'A >r cities-raw @
(
  nip
  "name" m:@ 0 s:@ [email protected] n:= if
    drop "population" m:@ . cr break
  then
  2drop
) a:each drop rdrop

bye


INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit

DEFINE PTR="CARD"
DEFINE ENTRY_SIZE="4"
DEFINE STX="$8E"
DEFINE STA="$8D"
DEFINE JSR="$20"
DEFINE RTS="$60"

TYPE City=[
  CARD
    name, ;CHAR ARRAY
    population] ;REAL POINTER

BYTE ARRAY cities(100)
BYTE count=[0]

CHAR ARRAY nameParam ;param for name predicate
REAL popParam ;param for population predicate
CHAR letterParam ;param for letter predicate
CITY POINTER c ;city used in predicates and actions
BYTE index ;index of city used in index action

PTR FUNC GetItemAddr(BYTE index)
  PTR addr

  addr=cities+index*ENTRY_SIZE
RETURN (addr)

PROC Append(CHAR ARRAY n REAL POINTER p)
  City POINTER dst

  dst=GetItemAddr(count)
  dst.name=n
  dst.population=p
  count==+1
RETURN

PROC InitData()
  REAL lg,ca,ki,gr,mo,kh,da,al,ab,cs

  ValR("21.0",lg) ValR("15.2",ca)
  ValR("11.3",ki) ValR("7.53",gr)
  ValR("5.85",mo) ValR("4.98",kh)
  ValR("4.7",da)  ValR("4.58",al)
  ValR("4.4",ab)  ValR("3.98",cs)

  Append("Lagos",lg)
  Append("Cairo",ca)
  Append("Kinshasa-Brazzaville",ki)
  Append("Greater Johannesburg",gr)
  Append("Mogadishu",mo)
  Append("Khartoum-Omdurman",kh)
  Append("Dar Es Salaam",da)
  Append("Alexandria",al)
  Append("Abidjan",ab)
  Append("Casablanca",cs)
RETURN

BYTE FUNC NameEquals()
RETURN (SCompare(c.name,nameParam)+1)

BYTE FUNC PopulationLess()
  REAL diff
  BYTE ARRAY x

  RealSub(popParam,c.population,diff)
  x=diff
  IF (x(0)&$80)=$00 THEN
    RETURN (1)
  FI
RETURN (0)

BYTE FUNC FirstLetter()
  CHAR ARRAY n

  n=c.name
  IF n(0)>=1 AND n(1)=letterParam THEN
    RETURN (1)
  FI
RETURN (0)

;jump addr is stored in X and A registers
BYTE FUNC Predicate=*(PTR jumpAddr)
 [STX Predicate+8
  STA Predicate+7
  JSR $00 $00
  RTS]

PROC PrintIndex()
  PrintF("index=%I%E",index)
RETURN

PROC PrintName()
  PrintF("name=%S%E",c.name)
RETURN

PROC PrintPopulation()
  Print("population=")
  PrintRE(c.population)
RETURN

;jump addr is stored in X and A registers
PROC Action=*(PTR jumpAddr)
  [STX Action+8
   STA Action+7
   JSR $00 $00
   RTS]

PROC Find(PTR predicateFun,actionFun)
  FOR index=0 TO count-1
  DO
    c=GetItemAddr(index)
    IF Predicate(predicateFun) THEN
      Action(actionFun)
      EXIT
    FI
  OD
RETURN

PROC Main()
  Put(125) PutE() ;clear screen
  InitData()

  nameParam="Dar Es Salaam"
  Find(NameEquals,PrintIndex)

  ValR("5.0",popParam)
  Find(PopulationLess,PrintName)

  letterParam='A
  Find(FirstLetter,PrintPopulation)
RETURN


with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_IO;

procedure Search_A_List_Of_Records
is
   function "+"(input : in String) return Unbounded_String renames To_Unbounded_String;
   function "+"(input : in Unbounded_String) return String renames To_String;

   type City is record
      name : Unbounded_String;
      population : Float;
   end record;

   type City_Array is array(Positive range <>) of City;
   type City_Array_Access is access City_Array;

   type Cursor is record
      container : City_Array_Access;
      index : Natural;
   end record;

   function Element(C : in Cursor) return City is
   begin
      if C.container = null or C.index = 0 then
         raise Constraint_Error with "No element.";
      end if;

      return C.container.all(C.index);
   end Element;

   function Index_0(C : in Cursor) return Natural is
   begin
      if C.container = null or C.index = 0 then
         raise Constraint_Error with "No element.";
      end if;

      return C.index - C.container.all'First;
   end Index_0;

   function Find
     (container : in City_Array;
      check : not null access function(Element : in City) return Boolean)
      return Cursor
   is
   begin
      for I in container'Range loop
         if check.all(container(I)) then
            return (new City_Array'(container), I);
         end if;
      end loop;
      return (null, 0);
   end;

   function Dar_Es_Salaam(Element : in City) return Boolean is
   begin
      return Element.name = "Dar Es Salaam";
   end Dar_Es_Salaam;

   function Less_Than_Five_Million(Element : in City) return Boolean is
   begin
      return Element.population < 5.0;
   end Less_Than_Five_Million;

   function Starts_With_A(Item : in City) return Boolean is
   begin
      return Element(Item.name, 1) = 'A';
   end Starts_With_A;

   cities : constant City_Array :=
     ((+"Lagos",                21.0),
      (+"Cairo",                15.2),
      (+"Kinshasa-Brazzaville", 11.3),
      (+"Greater Johannesburg", 7.55),
      (+"Mogadishu",            5.85),
      (+"Khartoum-Omdurman",    4.98),
      (+"Dar Es Salaam",        4.7 ),
      (+"Alexandria",           4.58),
      (+"Abidjan",              4.4 ),
      (+"Casablanca",           3.98));
begin
   Ada.Text_IO.Put_Line(Index_0(Find(cities, Dar_Es_Salaam'Access))'Img);
   Ada.Text_IO.Put_Line(+Element(Find(cities, Less_Than_Five_Million'Access)).name);
   Ada.Text_IO.Put_Line(Element(Find(cities, Starts_With_A'Access)).population'Img);
end Search_A_List_Of_Records;


PARAMETERS: p_limit TYPE i OBLIGATORY DEFAULT 100.

AT SELECTION-SCREEN ON p_limit.
  IF p_limit LE 1.
    MESSAGE 'Limit must be higher then 1.' TYPE 'E'.
  ENDIF.

START-OF-SELECTION.
  FIELD-SYMBOLS: <fs_prime> TYPE flag.
  DATA: gt_prime TYPE TABLE OF flag,
        gv_prime TYPE flag,
        gv_i     TYPE i,
        gv_j     TYPE i.

  DO p_limit TIMES.
    IF sy-index > 1.
      gv_prime = abap_true.
    ELSE.
      gv_prime = abap_false.
    ENDIF.

    APPEND gv_prime TO gt_prime.
  ENDDO.

  gv_i = 2.
  WHILE ( gv_i <= trunc( sqrt( p_limit ) ) ).
    IF ( gt_prime[ gv_i ] EQ abap_true ).
      gv_j =  gv_i ** 2.
      WHILE ( gv_j <= p_limit ).
        gt_prime[ gv_j ] = abap_false.
        gv_j = ( gv_i ** 2 ) + ( sy-index * gv_i ).
      ENDWHILE.
    ENDIF.
    gv_i = gv_i + 1.
  ENDWHILE.

  LOOP AT gt_prime INTO gv_prime.
    IF gv_prime = abap_true.
      WRITE: / sy-tabix.
    ENDIF.
  ENDLOOP.


c-library m
s" m" add-lib
\c #include <math.h>
c-function fnextafter nextafter r r -- r
end-c-library

s" MAX-FLOAT" environment? drop fconstant MAX-FLOAT

: fstepdown ( F: r1 -- r2 )
   MAX-FLOAT fnegate fnextafter ;
: fstepup ( F: r1 -- r2 )
   MAX-FLOAT fnextafter ;

: savef+ ( F: r1 r2 -- r3 r4 ) \ r4 <= r1+r2 <= r3
   f+  fdup fstepup  fswap fstepdown ;


package main

import (
    "fmt"
    "math"
)

// type requested by task
type interval struct {
    lower, upper float64
}

// a constructor
func stepAway(x float64) interval {
    return interval {
        math.Nextafter(x, math.Inf(-1)),
        math.Nextafter(x, math.Inf(1))}
}

// function requested by task
func safeAdd(a, b float64) interval {
    return stepAway(a + b)

}

// example
func main() {
    a, b := 1.2, .03
    fmt.Println(a, b, safeAdd(a, b))
}


use fmt;
use math;

type interval = struct {a: f64, b: f64};

export fn main() void = {
	const a: [_](f64, f64) = [
		(1.0f64, 2.0f64),
		(0.1f64, 0.2f64),
		(1e100f64, 1e-100f64),
		(1e308f64, 1e308f64)];

	for (let i = 0z; i < len(a); i += 1) {
		let res = safe_add(a[i].0, a[i].1);
		fmt::printfln("{} + {} is within ({}, {})", a[i].0, a[i].1, res.a, res.b)!;
	};
};

fn safe_add(a: f64, b: f64) interval = {
	let orig = math::getround();
	math::setround(math::fround::DOWNWARD);
	let r0 = a + b;
	math::setround(math::fround::UPWARD);
	let r1 = a + b;
	math::setround(orig);
	return interval{a = r0, b = r1};
};


   err =. 2^ 53-~ 2 <[email protected]^. |   NB. get the size of one-half unit in the last place
   safeadd =. + (-,+) +&err
   0j15": 1.14 safeadd 2000.0 NB. print with 15 digits after the decimal
2001.139999999999873 2001.140000000000327


public class SafeAddition {
    private static double stepDown(double d) {
        return Math.nextAfter(d, Double.NEGATIVE_INFINITY);
    }

    private static double stepUp(double d) {
        return Math.nextUp(d);
    }

    private static double[] safeAdd(double a, double b) {
        return new double[]{stepDown(a + b), stepUp(a + b)};
    }

    public static void main(String[] args) {
        double a = 1.2;
        double b = 0.03;
        double[] result = safeAdd(a, b);
        System.out.printf("(%.2f + %.2f) is in the range %.16f..%.16f", a, b, result[0], result[1]);
    }
}


# Algol 68 doesn't have generic array searches but we can easily provide #
# type specific ones                                                     #

# mode to hold the city/population info #
MODE CITYINFO = STRUCT( STRING name, REAL population in millions );

# array of cities and populations #
[ 1 : 10 ]CITYINFO cities := ( ( "Lagos",                21.0 )
                             , ( "Cairo",                15.2 )
                             , ( "Kinshasa-Brazzaville", 11.3 )
                             , ( "Greater Johannesburg", 7.55 )
                             , ( "Mogadishu",            5.85 )
                             , ( "Khartoum-Omdurman",    4.98 )
                             , ( "Dar Es Salaam",        4.7  )
                             , ( "Alexandria",           4.58 )
                             , ( "Abidjan",              4.4  )
                             , ( "Casablanca",           3.98 )
                             );

# operator to find the first city with the specified criteria, expressed as a procedure #
# returns the index of the CITYINFO. We can also overload FIND so it can be applied to  #
# arrays of other types                                                                 #
# If there is no city matching the criteria, a value greater than the upper bound of    #
# the cities array is returned                                                          #
PRIO FIND = 1;
OP   FIND = ( REF[]CITYINFO cities, PROC( REF CITYINFO )BOOL criteria )INT:
     BEGIN
         INT  result := UPB cities + 1;
         BOOL found  := FALSE;
         FOR pos FROM LWB cities TO UPB cities WHILE NOT found DO
             IF criteria( cities[ pos ] )
             THEN
                 found  := TRUE;
                 result := pos
             FI
         OD;
         result
     END # FIND # ;

# convenience operator to determine whether a STRING starts with a particular character #
# returns TRUE if s starts with c, FALSE otherwise                                      #
PRIO STARTSWITH = 9;
OP   STARTSWITH = ( STRING s, CHAR c )BOOL:
     IF LWB s > UPB s THEN FALSE # empty string                                         #
     ELSE s[ LWB s ] = c
     FI # STARTSWITH # ;

# find the 0-based index of Dar Es Salaam #
# ( if we remove the "[ @ 0 ]", it would find the 1-based index ) #
# NB - this assumes there is one - would get a subscript bound error if there isn't #
print( ( "index of Dar Es Salaam (from 0): "
       , whole( cities[ @ 0 ] FIND ( ( REF CITYINFO city )BOOL: name OF city = "Dar Es Salaam" ), 0 )
       , newline
       )
     );

# find the first city with population under 5M #
# NB - this assumes there is one - would get a subscript bound error if there isn't #
print( ( name OF cities[ cities FIND ( ( REF CITYINFO city )BOOL: population in millions OF city < 5.0 ) ]
       , " has a population under 5M"
       , newline
       )
     );

# find the population of the first city whose name starts with "A" #
# NB - this assumes there is one - would get a subscript bound error if there isn't #
print( ( "The population of a city named ""A..."" is: "
       , fixed( population in millions OF cities[ cities FIND ( ( REF CITYINFO city )BOOL: name OF city STARTSWITH "A" ) ], 0, 2 )
       , newline
       )
     )


(defun nats-to-from (n i)
   (declare (xargs :measure (nfix (- n i))))
   (if (zp (- n i))
       nil
       (cons i (nats-to-from n (+ i 1)))))

(defun remove-multiples-up-to-r (factor limit xs i)
   (declare (xargs :measure (nfix (- limit i))))
   (if (or (> i limit)
           (zp (- limit i))
           (zp factor))
       xs
       (remove-multiples-up-to-r
        factor
        limit
        (remove i xs)
        (+ i factor))))

(defun remove-multiples-up-to (factor limit xs)
   (remove-multiples-up-to-r factor limit xs (* factor 2)))

(defun sieve-r (factor limit)
   (declare (xargs :measure (nfix (- limit factor))))
   (if (zp (- limit factor))
       (nats-to-from limit 2)
       (remove-multiples-up-to factor (+ limit 1)
                               (sieve-r (1+ factor) limit))))

(defun sieve (limit)
   (sieve-r 2 limit))


// version 1.1.2

fun stepDown(d: Double) = Math.nextAfter(d, Double.NEGATIVE_INFINITY)

fun stepUp(d: Double) = Math.nextUp(d)

fun safeAdd(a: Double, b: Double) = stepDown(a + b).rangeTo(stepUp(a + b))

fun main(args: Array<String>) {
    val a = 1.2
    val b = 0.03
    println("($a + $b) is in the range ${safeAdd(a, b)}")
}


import fenv, strutils

proc `++`(a, b: float): tuple[lower, upper: float] =
  let
    a {.volatile.} = a
    b {.volatile.} = b
    orig = fegetround()
  discard fesetround FE_DOWNWARD
  result.lower = a + b
  discard fesetround FE_UPWARD
  result.upper = a + b
  discard fesetround orig

proc ff(a: float): string = a.formatFloat(ffDefault, 17)

for x, y in [(1.0, 2.0), (0.1, 0.2), (1e100, 1e-100), (1e308, 1e308)].items:
  let (d,u) = x ++ y
  echo x.ff, " + ", y.ff, " ="
  echo "    [", d.ff, ", ", u.ff, "]"
  echo "    size ", (u - d).ff, "\n"


use strict;
use warnings;
use Data::IEEE754::Tools <nextUp nextDown>;

sub safe_add {
    my($a,$b) = @_;
    my $c = $a + $b;
    return $c, nextDown($c), nextUp($c)
}

printf "%.17f (%.17f, %.17f)\n", safe_add (1/9,1/7);


include builtins\VM\pFPU.e  -- :%down53 etc

function safe_add(atom a, atom b)
atom low,high
    -- NB: be sure to restore the usual/default rounding!
    #ilASM{
        [32]
            lea esi,[a]
            call :%pLoadFlt
            lea esi,[b]
            call :%pLoadFlt
            fld st0
            call :%down53
            fadd st0,st2
            lea edi,[low]
            call :%pStoreFlt
            call :%up53
            faddp
            lea edi,[high]
            call :%pStoreFlt
            call :%near53       -- usual/default
        [64]
            lea rsi,[a]
            call :%pLoadFlt
            lea rsi,[b]
            call :%pLoadFlt
            fld st0
            call :%down64
            fadd st0,st2
            lea rdi,[low]
            call :%pStoreFlt
            call :%up64
            faddp
            lea rdi,[high]
            call :%pStoreFlt
            call :%near64   -- usual/default
        []
          }
    return {low,high}
end function

constant nums = {{1, 2},
                 {0.1, 0.2},
                 {1e100, 1e-100},
                 {1e308, 1e308}}

    for i=1 to length(nums) do
        atom {a,b} = nums[i]
        atom {low,high} = safe_add(a,b)
        printf(1,"%.16g + %.16g =\n", {a, b});
        printf(1,"    [%.16g, %.16g]\n", {low, high});
        printf(1,"    size %.16g\n\n", high - low);
    end for


-- RECORDS

property lstCities : [¬
    {|name|:"Lagos", population:21.0}, ¬
    {|name|:"Cairo", population:15.2}, ¬
    {|name|:"Kinshasa-Brazzaville", population:11.3}, ¬
    {|name|:"Greater Johannesburg", population:7.55}, ¬
    {|name|:"Mogadishu", population:5.85}, ¬
    {|name|:"Khartoum-Omdurman", population:4.98}, ¬
    {|name|:"Dar Es Salaam", population:4.7}, ¬
    {|name|:"Alexandria", population:4.58}, ¬
    {|name|:"Abidjan", population:4.4}, ¬
    {|name|:"Casablanca", population:3.98}]

-- SEARCHES

-- nameIsDar :: Record -> Bool
on nameIsDar(rec)
    |name| of rec = "Dar Es Salaam"
end nameIsDar

-- popBelow :: Record -> Bool
on popBelow5M(rec)
    population of rec < 5
end popBelow5M

-- nameBeginsWith :: Record -> Bool
on nameBeginsWithA(rec)
    text 1 of |name| of rec = "A"
end nameBeginsWithA

-- TEST
on run

    return {¬
        findIndex(nameIsDar, lstCities), ¬
        ¬
            |name| of find(popBelow5M, lstCities), ¬
        ¬
            population of find(nameBeginsWithA, lstCities)}

end run

-- GENERIC FUNCTIONS

-- find :: (a -> Bool) -> [a] -> Maybe a
on find(f, xs)
    tell mReturn(f)
        set lng to length of xs
        repeat with i from 1 to lng
            if lambda(item i of xs) then return item i of xs
        end repeat
        return missing value
    end tell
end find

-- findIndex :: (a -> Bool) -> [a] -> Maybe Int
on findIndex(f, xs)
    tell mReturn(f)
        set lng to length of xs
        repeat with i from 1 to lng
            if lambda(item i of xs) then return i
        end repeat
        return missing value
    end tell
end findIndex

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property lambda : f
        end script
    end if
end mReturn


define :city [name population][]

records: map [
    ["Lagos" 21.0]
    ["Cairo" 15.2]
    ["Kinshasa-Brazzaville" 11.3]
    ["Greater Johannesburg" 7.55]
    ["Mogadishu" 5.85]
    ["Khartoum-Omdurman" 4.98]
    ["Dar Es Salaam" 4.7]
    ["Alexandria" 4.58]
    ["Abidjan" 4.4]
    ["Casablanca" 3.98]
] => [to :city]

find: function [block f][
    loop.with: 'i block 'elt [
        if f elt -> return @[elt i]
    ]
    return false
]

; Print the index of the first city named Dar Es Salaam.
print last find records $[c][equal? c\name "Dar Es Salaam"]

; Print the name of the first city with under 5 million people.
print get first find records $[c][less? c\population 5] 'name

; Print the population of the first city starting with 'A'.
print get first find records $[c][equal? first c\name `A`] 'population


DEFINE MAX="1000"

PROC Main()
  BYTE ARRAY t(MAX+1)
  INT i,j,k,first

  FOR i=0 TO MAX
  DO
    t(i)=1
  OD

  t(0)=0
  t(1)=0

  i=2 first=1
  WHILE i<=MAX
  DO
    IF t(i)=1 THEN
      IF first=0 THEN
        Print(", ")
      FI
      PrintI(i)
      FOR j=2*i TO MAX STEP i
      DO
        t(j)=0
      OD
      first=0
    FI
    i==+1
  OD
RETURN


#lang racket

;; 1. Racket has exact unlimited integers and fractions, which can be
;;    used to perform exact operations.  For example, given an inexact
;;    flonum, we can convert it to an exact fraction and work with that:
(define (exact+ x y)
  (+ (inexact->exact x) (inexact->exact y)))
;; (A variant of this would be to keep all numbers exact, so the default
;; operations never get to inexact numbers)

;; 2. We can implement the required operation using a bunch of
;;    functionality provided by the math library, for example, use
;;    `flnext' and `flprev' to get the surrounding numbers for both
;;    inputs and use them to produce the resulting interval:
(require math)
(define (interval+ x y)
  (cons (+ (flprev x) (flprev y)) (+ (flnext x) (flnext y))))
(interval+ 1.14 2000.0) ; -> '(2001.1399999999999 . 2001.1400000000003)
;; (Note: I'm not a numeric expert in any way, so there must be room for
;; improvement here...)

;; 3. Yet another option is to use the math library's bigfloats, with an
;;    arbitrary precision:
(bf-precision 1024) ; 1024 bit floats
;; add two numbers, specified as strings to avoid rounding of number
;; literals
(bf+ (bf "1.14") (bf "2000.0"))


say "Floating points: (Nums)";
say "Error: " ~ (2**-53).Num;

sub infix:<±+> (Num $a, Num $b) {
    my \ε = (2**-53).Num;
    $a - ε + $b, $a + ε + $b,
}

printf "%4.16f .. %4.16f\n", (1.14e0 ±+ 2e3);

say "\nRationals:";

say ".1 + .2 is exactly equal to .3: ", .1 + .2 === .3;

say "\nLarge denominators require explicit coercion to FatRats:";
say "Sum of inverses of the first 500 natural numbers:";
my $sum = sum (1..500).map: { FatRat.new(1,$_) };
say $sum;
say $sum.nude;

{
    say "\nRat stringification may not show full precision for terminating fractions by default.";
    say "Use a module to get full precision.";
    use Rat::Precise; # module loading is scoped to the enclosing block
    my $rat = 1.5**63;
    say "\nRaku default stringification for 1.5**63:\n" ~ $rat; # standard stringification
    say "\nRat::Precise stringification for 1.5**63:\n" ~$rat.precise; # full precision
}


100 nc=0
110 read n$
120 if n$="" then 160
130 read p$
140 nc=nc+1
150 goto 110
160 restore
170 dim ci$(nc-1,1)
180 for i=0 to nc-1
190 : for j=0 to 1
200 :  read ci$(i,j)
210 : next j
220 next i
230 :
240 print chr$(14);:rem text mode
250 print: print "Test 1. name='Dar Es Salaam':"
260 rem search uses query function fnq
270 def fnq(i) = ci$(i,0) = "Dar Es Salaam"
280 gosub 500
290 if i<0 then print "  None found.":goto 310
300 print "  Index="i"."
310 print: print "Test 2. population < 5M:"
320 def fnq(i) = val(ci$(i,1)) < 5
330 gosub 500
340 if i<0 then print "  None found.":goto 360
350 print "  Name="ci$(i,0)"."
360 print: print "Test 3. name like 'A%':"
370 def fnq(i) = left$(ci$(i,0),1)="A"
380 gosub 500
390 if i<0 then print "  None found.":goto 410
400 print "  Population="ci$(i,1)"."
410 end
420 :
500 for i=0 to nc-1
510 : if fnq(i) then return
520 next i
530 i=-1
540 return
550 :
560 data "Lagos", 21.0
570 data "Cairo", 15.2
580 data "Kinshasa-Brazzaville", 11.3
590 data "Greater Johannesburg",  7.55
600 data "Mogadishu",  5.85
610 data "Khartoum-Omdurman",  4.98
620 data "Dar Es Salaam",  4.7
630 data "Alexandria",  4.58
640 data "Abidjan",  4.4
650 data "Casablanca",  3.98
660 data ""


function eratosthenes(limit:int):Array
{
	var primes:Array = new Array();
	if (limit >= 2) {
		var sqrtlmt:int = int(Math.sqrt(limit) - 2);
		var nums:Array = new Array(); // start with an empty Array...
		for (var i:int = 2; i <= limit; i++) // and
			nums.push(i); // only initialize the Array once...
		for (var j:int = 0; j <= sqrtlmt; j++) {
			var p:int = nums[j]
			if (p)
				for (var t:int = p * p - 2; t < nums.length; t += p)
					nums[t] = 0;
		}
		for (var m:int = 0; m < nums.length; m++) {
			var r:int = nums[m];
			if (r)
				primes.push(r);
		}
	}
	return primes;
}
var e:Array = eratosthenes(1000);
trace(e);


numeric digits 1000           /*defines precision to be 1,000 decimal digits. */

y=digits()                    /*sets  Y  to existing number of decimal digits.*/

numeric digits y + y%10       /*increase the  (numeric) decimal digits by 10%.*/


require 'bigdecimal'
require 'bigdecimal/util'  # String#to_d

def safe_add(a, b, prec)
  a, b = a.to_d, b.to_d
  rm = BigDecimal::ROUND_MODE
  orig = BigDecimal.mode(rm)

  BigDecimal.mode(rm, BigDecimal::ROUND_FLOOR)
  low = a.add(b, prec)

  BigDecimal.mode(rm, BigDecimal::ROUND_CEILING)
  high = a.add(b, prec)

  BigDecimal.mode(rm, orig)
  low..high
end

[["1", "2"],
 ["0.1", "0.2"],
 ["0.1", "0.00002"],
 ["0.1", "-0.00002"],
].each { |a, b| puts "#{a} + #{b} = #{safe_add(a, b, 3)}" }


object SafeAddition extends App {
  val (a, b) = (1.2, 0.03)
  val result = safeAdd(a, b)

  private def safeAdd(a: Double, b: Double) = Seq(stepDown(a + b), stepUp(a + b))

  private def stepDown(d: Double) = Math.nextAfter(d, Double.NegativeInfinity)

  private def stepUp(d: Double) = Math.nextUp(d)

  println(f"($a%.2f + $b%.2f) is in the range ${result.head}%.16f .. ${result.last}%.16f")

}


let a = 1.2
let b = 0.03

print("\(a) + \(b) is in the range \((a + b).nextDown)...\((a + b).nextUp)")


package require critcl
package provide stepaway 1.0
critcl::ccode {
    #include <math.h>
    #include <float.h>
}
critcl::cproc stepup {double value} double {
    return nextafter(value, DBL_MAX);
}
critcl::cproc stepdown {double value} double {
    return nextafter(value, -DBL_MAX);
}


#lang transd

MainModule : {
    a: 1.2,
    b: 0.03,

    safeAdd: (λ d Double() e Double()
                 (ret [(decr (+ d e)), (incr (+ d e))])),

    _start: (λ
       (lout "(+ " a " " b ") is in the range: " prec: 20 (safeAdd a b))
    )
}


#include <stdint.h> /* intptr_t */
#include <stdio.h>
#include <stdlib.h> /* bsearch */
#include <string.h>
#include <search.h> /* lfind */

#define LEN(x) (sizeof(x) / sizeof(x[0]))

struct cd {
    char *name;
    double population;
};

/* Return -1 if name could not be found */
int search_get_index_by_name(const char *name, const struct cd *data, const size_t data_length,
        int (*cmp_func)(const void *, const void *))
{
    struct cd key = { (char *) name, 0 };
    struct cd *match = bsearch(&key, data, data_length,
            sizeof(struct cd), cmp_func);

    if (match == NULL)
        return -1;
    else
        return ((intptr_t) match - (intptr_t) data) / sizeof(struct cd);
}

/* Return -1 if no matching record can be found */
double search_get_pop_by_name(const char *name, const struct cd *data, size_t data_length,
        int (*cmp_func)(const void *, const void *))
{
    struct cd key = { (char *) name, 0 };
    struct cd *match = lfind(&key, data, &data_length,
            sizeof(struct cd), cmp_func);

    if (match == NULL)
        return -1;
    else
        return match->population;
}

/* Return NULL if no value satisfies threshold */
char* search_get_pop_threshold(double pop_threshold, const struct cd *data, size_t data_length,
        int (*cmp_func)(const void *, const void *))
{
    struct cd key = { NULL, pop_threshold };
    struct cd *match = lfind(&key, data, &data_length,
            sizeof(struct cd), cmp_func);

    if (match == NULL)
        return NULL;
    else
        return match->name;
}

int cd_nameChar_cmp(const void *a, const void *b)
{
    struct cd *aa = (struct cd *) a;
    struct cd *bb = (struct cd *) b;

	int i,len = strlen(aa->name);

	for(i=0;i<len;i++)
		if(bb->name[i]!=aa->name[i])
			return -1;
	return 0;
}

int cd_name_cmp(const void *a, const void *b)
{
    struct cd *aa = (struct cd *) a;
    struct cd *bb = (struct cd *) b;
    return strcmp(bb->name, aa->name);
}

int cd_pop_cmp(const void *a, const void *b)
{
    struct cd *aa = (struct cd *) a;
    struct cd *bb = (struct cd *) b;
    return bb->population >= aa->population;
}

int main(void)
{
    const struct cd citydata[] = {
        { "Lagos", 21 },
        { "Cairo", 15.2 },
        { "Kinshasa-Brazzaville", 11.3 },
        { "Greater Johannesburg", 7.55 },
        { "Mogadishu", 5.85 },
        { "Khartoum-Omdurman", 4.98 },
        { "Dar Es Salaam", 4.7 },
        { "Alexandria", 4.58 },
        { "Abidjan", 4.4 },
        { "Casablanca", 3.98 }
    };

    const size_t citydata_length = LEN(citydata);

    printf("%d\n", search_get_index_by_name("Dar Es Salaam", citydata, citydata_length, cd_name_cmp));
    printf("%s\n", search_get_pop_threshold(5, citydata, citydata_length, cd_pop_cmp));
    printf("%lf\n", search_get_pop_by_name("A", citydata, citydata_length, cd_nameChar_cmp));

    return 0;
}


with Ada.Text_IO, Ada.Command_Line;

procedure Eratos is

   Last: Positive := Positive'Value(Ada.Command_Line.Argument(1));
   Prime: array(1 .. Last) of Boolean := (1 => False, others => True);
   Base: Positive := 2;
   Cnt: Positive;
begin
   while Base * Base <= Last loop
      if Prime(Base) then
         Cnt := Base + Base;
         while Cnt <= Last loop
            Prime(Cnt) := False;
            Cnt := Cnt + Base;
         end loop;
      end if;
      Base := Base + 1;
   end loop;
   Ada.Text_IO.Put("Primes less or equal" & Positive'Image(Last) &" are:");
   for Number in Prime'Range loop
      if Prime(Number) then
         Ada.Text_IO.Put(Positive'Image(Number));
      end if;
   end loop;
end Eratos;


/* safe_addition.wren */
class Interval {
    construct new(lower, upper) {
        if (lower.type != Num || upper.type != Num) {
            Fiber.abort("Arguments must be numbers.")
        }
        _lower = lower
        _upper = upper
    }

    lower { _lower }
    upper { _upper }

    static stepAway(x) { new(nextAfter_(x, -1/0), nextAfter_(x, 1/0)) }

    static safeAdd(x, y) { stepAway(x + y) }

    foreign static nextAfter_(x, y) // the code for this is written in C

    toString { "[%(_lower), %(_upper)]" }
}

var a = 1.2
var b = 0.03
System.print("(%(a) + %(b)) is in the range %(Interval.safeAdd(a,b))")


using System;
using System.Collections.Generic;

namespace RosettaSearchListofRecords
{
    class Program
    {
        static void Main(string[] args)
        {
            var dataset = new List<Dictionary<string, object>>() {
                new Dictionary<string, object>   {{ "name" , "Lagos"},                {"population", 21.0  }},
                new Dictionary<string, object>   {{ "name" , "Cairo"},                {"population", 15.2  }},
                new Dictionary<string, object>   {{ "name" , "Kinshasa-Brazzaville"}, {"population", 11.3  }},
                new Dictionary<string, object>   {{ "name" , "Greater Johannesburg"}, {"population",  7.55 }},
                new Dictionary<string, object>   {{ "name" , "Mogadishu"},            {"population",  5.85 }},
                new Dictionary<string, object>   {{ "name" , "Khartoum-Omdurman"},    {"population",  4.98 }},
                new Dictionary<string, object>   {{ "name" , "Dar Es Salaam"},        {"population",  4.7  }},
                new Dictionary<string, object>   {{ "name" , "Alexandria"},           {"population",  4.58 }},
                new Dictionary<string, object>   {{ "name" , "Abidjan"},              {"population",  4.4  }},
                new Dictionary<string, object>   {{ "name" , "Casablanca"},           {"population",  3.98 }}
            };

            // Find the (zero-based) index of the first city in the list whose name is "Dar Es Salaam"
            var index = dataset.FindIndex(x => ((string)x["name"]) == "Dar Es Salaam");
            Console.WriteLine(index);

            // Find the name of the first city in this list whose population is less than 5 million
            var name = (string)dataset.Find(x => (double)x["population"] < 5.0)["name"];
            Console.WriteLine(name);

            // Find the population of the first city in this list whose name starts with the letter "A"
            var aNamePopulation = (double)dataset.Find(x => ((string)x["name"]).StartsWith("A"))["population"];
            Console.WriteLine(aNamePopulation);
        }
    }
}


-- imports
open import Data.Nat as ℕ     using (ℕ; suc; zero; _+_; _∸_)
open import Data.Vec as Vec   using (Vec; _∷_; []; tabulate; foldr)
open import Data.Fin as Fin   using (Fin; suc; zero)
open import Function          using (_∘_; const; id)
open import Data.List as List using (List; _∷_; [])
open import Data.Maybe        using (Maybe; just; nothing)

-- Without square cutoff optimization
module Simple where
  primes : ∀ n → List (Fin n)
  primes zero = []
  primes (suc zero) = []
  primes (suc (suc zero)) = []
  primes (suc (suc (suc m))) = sieve (tabulate (just ∘ suc))
    where
    sieve : ∀ {n} → Vec (Maybe (Fin (2 + m))) n → List (Fin (3 + m))
    sieve [] = []
    sieve (nothing ∷ xs) =         sieve xs
    sieve (just x  ∷ xs) = suc x ∷ sieve (foldr B remove (const []) xs x)
      where
      B = λ n → ∀ {i} → Fin i → Vec (Maybe (Fin (2 + m))) n

      remove : ∀ {n} → Maybe (Fin (2 + m)) → B n → B (suc n)
      remove _ ys zero    = nothing ∷ ys x
      remove y ys (suc z) = y       ∷ ys z

-- With square cutoff optimization
module SquareOpt where
  primes : ∀ n → List (Fin n)
  primes zero = []
  primes (suc zero) = []
  primes (suc (suc zero)) = []
  primes (suc (suc (suc m))) = sieve 1 m (Vec.tabulate (just ∘ Fin.suc ∘ Fin.suc))
    where
    sieve : ∀ {n} → ℕ → ℕ → Vec (Maybe (Fin (3 + m))) n → List (Fin (3 + m))
    sieve _ zero = List.mapMaybe id ∘ Vec.toList
    sieve _ (suc _) [] = []
    sieve i (suc l) (nothing ∷ xs) =     sieve (suc i) (l ∸ i ∸ i) xs
    sieve i (suc l) (just x  ∷ xs) = x ∷ sieve (suc i) (l ∸ i ∸ i) (Vec.foldr B remove (const []) xs i)
      where
      B = λ n → ℕ → Vec (Maybe (Fin (3 + m))) n

      remove : ∀ {i} → Maybe (Fin (3 + m)) → B i → B (suc i)
      remove _ ys zero    = nothing ∷ ys i
      remove y ys (suc j) = y       ∷ ys j


#include <iostream>
#include <string>
#include <vector>
#include <algorithm>

struct city {
    std::string name;
    float population;
};

int main()
{
    std::vector<city> cities = {
        { "Lagos", 21 },
        { "Cairo", 15.2 },
        { "Kinshasa-Brazzaville", 11.3 },
        { "Greater Johannesburg", 7.55 },
        { "Mogadishu", 5.85 },
        { "Khartoum-Omdurman", 4.98 },
        { "Dar Es Salaam", 4.7 },
        { "Alexandria", 4.58 },
        { "Abidjan", 4.4 },
        { "Casablanca", 3.98 },
    };

    auto i1 = std::find_if( cities.begin(), cities.end(),
        [](city c){ return c.name == "Dar Es Salaam"; } );
    if (i1 != cities.end()) {
        std::cout << i1 - cities.begin() << "\n";
    }

    auto i2 = std::find_if( cities.begin(), cities.end(),
        [](city c){ return c.population < 5.0; } );
    if (i2 != cities.end()) {
        std::cout << i2->name << "\n";
    }

    auto i3 = std::find_if( cities.begin(), cities.end(),
        [](city c){ return c.name.length() > 0 && c.name[0] == 'A'; } );
    if (i3 != cities.end()) {
        std::cout << i3->population << "\n";
    }
}


# Sieve of Eratosthenes

# generate and return a sequence containing the primes up to sieveSize
sieve := proc( sieveSize :: number ) :: sequence is
    local sieve, result;

    result := seq(); # sequence of primes - initially empty
    create register sieve( sieveSize ); # "vector" to be sieved

    sieve[ 1 ] := false;
    for sPos from 2 to sieveSize do sieve[ sPos ] := true od;

    # sieve the primes
    for sPos from 2 to entier( sqrt( sieveSize ) ) do
        if sieve[ sPos ] then
            for p from sPos * sPos to sieveSize by sPos do
                sieve[ p ] := false
            od
        fi
    od;

    # construct the sequence of primes
    for sPos from 1 to sieveSize do
        if sieve[ sPos ] then insert sPos into result fi
    od

return result
end; # sieve

# test the sieve proc
for i in sieve( 100 ) do write( " ", i ) od; print();


(def records [{:idx 8, :name "Abidjan",              :population  4.4}
              {:idx 7, :name "Alexandria",           :population  4.58}
              {:idx 1, :name "Cairo",                :population 15.2}
              {:idx 9, :name "Casablanca",           :population  3.98}
              {:idx 6, :name "Dar Es Salaam",        :population  4.7}
              {:idx 3, :name "Greater Johannesburg", :population  7.55}
              {:idx 5, :name "Khartoum-Omdurman",    :population  4.98}
              {:idx 2, :name "Kinshasa-Brazzaville", :population 11.3}
              {:idx 0, :name "Lagos",                :population 21.0}
              {:idx 4, :name "Mogadishu",            :population  5.85}])

(defn city->idx [recs city]
  (-> (some #(when (= city (:name %)) %)
            recs)
      :idx))

(defn rec-with-max-population-below-n [recs limit]
  (->> (sort-by :population > recs)
       (drop-while (fn [r] (>= (:population r) limit)))
       first))

(defn most-populous-city-below-n [recs limit]
  (:name (rec-with-max-population-below-n recs limit)))


(defstruct city
  (name nil :type string)
  (population nil :type number))

(defparameter *cities*
  (list (make-city :name "Lagos"                :population 21.0)
        (make-city :name "Cairo"                :population 15.2)
        (make-city :name "Kinshasa-Brazzaville" :population 11.3)
        (make-city :name "Greater Johannesburg" :population  7.55)
        (make-city :name "Mogadishu"            :population  5.85)
        (make-city :name "Khartoum-Omdurman"    :population  4.98)
        (make-city :name "Dar Es Salaam"        :population  4.7)
        (make-city :name "Alexandria"           :population  4.58)
        (make-city :name "Abidjan"              :population  4.4)
        (make-city :name "Casablanca"           :population  3.98)))

(defun main ()
  (let ((answer1 (position "Dar Es Salaam" *cities* :key #'city-name :test #'string=))
        (answer2 (city-name (find-if (lambda (population) (< population 5))
                                     *cities* :key #'city-population)))
        (answer3 (city-population (find-if (lambda (name) (char= (char name 0) #\A))
                                           *cities* :key #'city-name))))
    (format t "Answer 1: ~A~%" answer1)
    (format t "Answer 2: ~A~%" answer2)
    (format t "Answer 3: ~A~%" answer3)))


comment Sieve of Eratosthenes;
begin
   integer array t[0:1000];
   integer i,j,k;
   for i:=0 step 1 until 1000 do t[i]:=1;
   t[0]:=0; t[1]:=0; i:=0;
   for i:=i while i<1000 do
   begin
       for i:=i while i<1000 and t[i]=0 do i:=i+1;
       if i<1000 then
       begin
           j:=2;
           k:=j*i;
           for k:=k while k<1000 do
           begin
               t[k]:=0;
               j:=j+1;
               k:=j*i
           end;
           i:=i+1
       end
   end;
   for i:=0 step 1 until 999 do
   if t[i]≠0 then print(i,ꞌ is primeꞌ)
end


(require 'struct)
(require 'json)

;; importing data
(define cities
#<<
[{"name":"Lagos", "population":21}, {"name":"Cairo", "population":15.2}, {"name":"Kinshasa-Brazzaville", "population":11.3}, {"name":"Greater Johannesburg", "population":7.55}, {"name":"Mogadishu", "population":5.85}, {"name":"Khartoum-Omdurman", "population":4.98}, {"name":"Dar Es Salaam", "population":4.7}, {"name":"Alexandria", "population":4.58}, {"name":"Abidjan", "population":4.4}, {"name":"Casablanca", "population":3.98}]
>>#)

;; define a structure matching data
;; heterogenous  slots values
(struct city (name population))

;; convert JSON to EchoLisp instances of structures
(set! cities
	(vector-map (lambda(x) (json->struct x struct:city)) (json-import cities)))

;; search by name, case indifferent
(define (city-index name)
	(vector-search (lambda(x) (string-ci=? (city-name x) name)) cities))

;; returns first city name such as population < seuil
(define (city-pop seuil)
	(define idx (vector-search (lambda(x) (< (city-population x) seuil)) cities))
	(if idx
		(city-name (vector-ref cities idx))
		(cons seuil 'not-found)))

(city-index "Dar Es Salaam") → 6
(city-pop 5) → "Khartoum-Omdurman"
(city-pop -666) → (-666 . not-found)
(city-index "alexandra") → #f


import extensions;
import system'routines;

public program()
{
    var dataset := new object[]
    {
        new { Name = "Lagos";  Population = 21.0r; },
        new { Name = "Cairo";  Population = 15.2r; },
        new { Name = "Kinshasa-Brazzaville";  Population = 11.3r; },
        new { Name = "Greater Johannesburg";  Population = 7.55r; },
        new { Name = "Mogadishu";  Population = 5.85r; },
        new { Name = "Khartoum-Omdurman";  Population = 4.98r; },
        new { Name = "Dar Es Salaam";  Population = 4.7r; },
        new { Name = "Alexandria";  Population = 4.58r; },
        new { Name = "Abidjan";  Population = 4.4r; },
        new { Name = "Casablanca";  Population = 3.98r; }
    };

    var index := dataset.selectBy:(r => r.Name).toArray().indexOfElement("Dar Es Salaam");
    console.printLine(index);

    var name := dataset.filterBy:(c => c.Population < 5.0r).toArray().FirstMember.Name;
    console.printLine(name);

    var namePopulation := dataset.filterBy:(c => c.Name.startingWith("A")).toArray().FirstMember.Population;
    console.printLine(namePopulation)
}


BOOL prime = TRUE, non prime = FALSE;
PROC eratosthenes = (INT n)[]BOOL:
(
  [n]BOOL sieve;
  FOR i TO UPB sieve DO sieve[i] := prime OD;
  INT m = ENTIER sqrt(n);
  sieve[1] := non prime;
  FOR i FROM 2 TO m DO
    IF sieve[i] = prime THEN
      FOR j FROM i*i BY i TO n DO
        sieve[j] := non prime
      OD
    FI
  OD;
  sieve
);

 print((eratosthenes(80),new line))


cities = [
  [name: "Lagos",                 population: 21.0 ],
  [name: "Cairo",                 population: 15.2 ],
  [name: "Kinshasa-Brazzaville",  population: 11.3 ],
  [name: "Greater Johannesburg",  population:  7.55],
  [name: "Mogadishu",             population:  5.85],
  [name: "Khartoum-Omdurman",     population:  4.98],
  [name: "Dar Es Salaam",         population:  4.7 ],
  [name: "Alexandria",            population:  4.58],
  [name: "Abidjan",               population:  4.4 ],
  [name: "Casablanca",            population:  3.98]
]

IO.puts Enum.find_index(cities, fn city -> city[:name] == "Dar Es Salaam" end)
IO.puts Enum.find(cities, fn city -> city[:population] < 5.0 end)[:name]
IO.puts Enum.find(cities, fn city -> String.first(city[:name])=="A" end)[:population]


USING: accessors io kernel math prettyprint sequences ;
IN: rosetta-code.search-list

TUPLE: city name pop ;

CONSTANT: data {
    T{ city f "Lagos" 21.0 }
    T{ city f "Cairo" 15.2 }
    T{ city f "Kinshasa-Brazzaville" 11.3 }
    T{ city f "Greater Johannesburg" 7.55 }
    T{ city f "Mogadishu" 5.85 }
    T{ city f "Khartoum-Omdurman" 4.98 }
    T{ city f "Dar Es Salaam" 4.7 }
    T{ city f "Alexandria" 4.58 }
    T{ city f "Abidjan" 4.4 }
    T{ city f "Casablanca" 3.98 }
}

! Print the index of the first city named Dar Es Salaam.
data [ name>> "Dar Es Salaam" = ] find drop .

! Print the name of the first city with under 5 million people.
data [ pop>> 5 < ] find nip name>> print

! Print the population of the first city starting with 'A'.
data [ name>> first CHAR: A = ] find nip pop>> .


      MODULE SEMPERNOVIS	!Keep it together.
       TYPE CITYSTAT		!Define a compound data type.
        CHARACTER*28	NAME		!Long enough?
        REAL		POPULATION	!Accurate enough.
       END TYPE CITYSTAT	!Just two parts, but different types.
       TYPE(CITYSTAT) CITY(10)	!Righto, I'll have some.
       DATA CITY/		!Supply the example's data.
     1   CITYSTAT("Lagos",               21.0 ),
     2   CITYSTAT("Cairo",               15.2 ),
     3   CITYSTAT("Kinshasa-Brazzaville",11.3 ),
     4   CITYSTAT("Greater Johannesburg", 7.55),
     5   CITYSTAT("Mogadishu",            5.85),
     6   CITYSTAT("Khartoum-Omdurman",    4.98),
     7   CITYSTAT("Dar Es Salaam",        4.7 ),
     8   CITYSTAT("Alexandria",           4.58),
     9   CITYSTAT("Abidjan",              4.4 ),
     o   CITYSTAT("Casablanca",           3.98)/
       CONTAINS
        INTEGER FUNCTION FIRSTMATCH(TEXT,TARGET)	!First matching.
         CHARACTER*(*) TEXT(:)	!An array of texts.
         CHARACTER*(*) TARGET	!The text to look for.
          DO FIRSTMATCH = 1,UBOUND(TEXT,DIM = 1)	!Scan the array from the start.
            IF (TEXT(FIRSTMATCH) .EQ. TARGET) RETURN	!An exact match? Ignoring trailing spaces.
          END DO				!Try the next.
          FIRSTMATCH = 0		!No match. Oh dear.
        END FUNCTION FIRSTMATCH

        INTEGER FUNCTION FIRSTLESS(VAL,TARGET)	!First matching.
         REAL VAL(:)	!An array of values.
         REAL TARGET	!The value to look for.
          DO FIRSTLESS = 1,UBOUND(VAL,DIM = 1)	!Step through the array from the start.
            IF (VAL(FIRSTLESS) .LT. TARGET) RETURN	!Suitable?
          END DO				!Try the next.
          FIRSTLESS = 0		!No match. Oh dear.
        END FUNCTION FIRSTLESS
      END MODULE SEMPERNOVIS

      PROGRAM POKE
      USE SEMPERNOVIS	!Ex Africa, ...
      CHARACTER*(*) BLAH	!Save on some typing.
      PARAMETER (BLAH = "The first city in the list whose ")	!But also, for layout.

      WRITE (6,1) BLAH,FIRSTMATCH(CITY.NAME,"Dar Es Salaam") - 1	!My array starts with one.
    1 FORMAT (A,"name is Dar Es Salaam, counting with zero, is #",I0)

      WRITE (6,2) BLAH,CITY(FIRSTLESS(CITY.POPULATION,5.0)).NAME
    2 FORMAT (A,"population is less than 5 is ",A)

      WRITE (6,3) BLAH,CITY(FIRSTMATCH(CITY.NAME(1:1),"A")).POPULATION
    3 FORMAT (A,"whose name starts with A has population",F5.2)
      END


begin

    % implements the sieve of Eratosthenes                                   %
    %     s(i) is set to true if i is prime, false otherwise                 %
    %     algol W doesn't have a upb operator, so we pass the size of the    %
    %     array in n                                                         %
    procedure sieve( logical array s ( * ); integer value n ) ;
    begin

        % start with everything flagged as prime                             %
        for i := 1 until n do s( i ) := true;

        % sieve out the non-primes                                           %
        s( 1 ) := false;
        for i := 2 until truncate( sqrt( n ) )
        do begin
            if s( i )
            then begin
                for p := i * i step i until n do s( p ) := false
            end if_s_i
        end for_i ;

    end sieve ;

    % test the sieve procedure                                               %

    integer sieveMax;

    sieveMax := 100;
    begin

        logical array s ( 1 :: sieveMax );

        i_w := 2; % set output field width                                   %
        s_w := 1; % and output separator width                               %

        % find and display the primes                                        %
        sieve( s, sieveMax );
        for i := 1 until sieveMax do if s( i ) then writeon( i );

    end

end.


package main

import (
    "fmt"
    "strings"
)

type element struct {
    name       string
    population float64
}

var list = []element{
    {"Lagos", 21},
    {"Cairo", 15.2},
    {"Kinshasa-Brazzaville", 11.3},
    {"Greater Johannesburg", 7.55},
    {"Mogadishu", 5.85},
    {"Khartoum-Omdurman", 4.98},
    {"Dar Es Salaam", 4.7},
    {"Alexandria", 4.58},
    {"Abidjan", 4.4},
    {"Casablanca", 3.98},
}

func find(cond func(*element) bool) int {
    for i := range list {
        if cond(&list[i]) {
            return i
        }
    }
    return -1
}

func main() {
    fmt.Println(find(func(e *element) bool {
        return e.name == "Dar Es Salaam"
    }))

    i := find(func(e *element) bool {
        return e.population < 5
    })
    if i < 0 {
        fmt.Println("*** not found ***")
    } else {
        fmt.Println(list[i].name)
    }

    i = find(func(e *element) bool {
        return strings.HasPrefix(e.name, "A")
    })
    if i < 0 {
        fmt.Println("*** not found ***")
    } else {
        fmt.Println(list[i].population)
    }
}


import Data.List (findIndex, find)

data City = City
  { name :: String
  , population :: Float
  } deriving (Read, Show)

-- CITY PROPERTIES ------------------------------------------------------------
cityName :: City -> String
cityName (City x _) = x

cityPop :: City -> Float
cityPop (City _ x) = x

mbCityName :: Maybe City -> Maybe String
mbCityName (Just x) = Just (cityName x)
mbCityName _ = Nothing

mbCityPop :: Maybe City -> Maybe Float
mbCityPop (Just x) = Just (cityPop x)
mbCityPop _ = Nothing

-- EXAMPLES -------------------------------------------------------------------
mets :: [City]
mets =
  [ City
    { name = "Lagos"
    , population = 21.0
    }
  , City
    { name = "Cairo"
    , population = 15.2
    }
  , City
    { name = "Kinshasa-Brazzaville"
    , population = 11.3
    }
  , City
    { name = "Greater Johannesburg"
    , population = 7.55
    }
  , City
    { name = "Mogadishu"
    , population = 5.85
    }
  , City
    { name = "Khartoum-Omdurman"
    , population = 4.98
    }
  , City
    { name = "Dar Es Salaam"
    , population = 4.7
    }
  , City
    { name = "Alexandria"
    , population = 4.58
    }
  , City
    { name = "Abidjan"
    , population = 4.4
    }
  , City
    { name = "Casablanca"
    , population = 3.98
    }
  ]

-- TEST -----------------------------------------------------------------------
main :: IO ()
main = do
  mbPrint $ findIndex (("Dar Es Salaam" ==) . cityName) mets
  mbPrint $ mbCityName $ find ((< 5.0) . cityPop) mets
  mbPrint $ mbCityPop $ find (("A" ==) . take 1 . cityName) mets

mbPrint
  :: Show a
  => Maybe a -> IO ()
mbPrint (Just x) = print x
mbPrint x = print x


BEGIN

COMMENT
  FIND PRIMES UP TO THE SPECIFIED LIMIT (HERE 1,000) USING
  CLASSIC SIEVE OF ERATOSTHENES;

% CALCULATE INTEGER SQUARE ROOT %
INTEGER FUNCTION ISQRT(N);
INTEGER N;
BEGIN
    INTEGER R1, R2;
    R1 := N;
    R2 := 1;
    WHILE R1 > R2 DO
        BEGIN
            R1 := (R1+R2) / 2;
            R2 := N / R1;
        END;
    ISQRT := R1;
END;

INTEGER LIMIT, I, J, FALSE, TRUE, COL, COUNT;
INTEGER ARRAY FLAGS[1:1000];

LIMIT := 1000;
FALSE := 0;
TRUE := 1;

WRITE("FINDING PRIMES FROM 2 TO",LIMIT);

% INITIALIZE TABLE %
WRITE("INITIALIZING ... ");
FOR I := 1 STEP 1 UNTIL LIMIT DO
  FLAGS[I] := TRUE;

% SIEVE FOR PRIMES %
WRITEON("SIEVING ... ");
FOR I := 2 STEP 1 UNTIL ISQRT(LIMIT) DO
  BEGIN
    IF FLAGS[I] = TRUE THEN
        FOR J := (I * I) STEP I UNTIL LIMIT DO
          FLAGS[J] := FALSE;
  END;

% WRITE OUT THE PRIMES TEN PER LINE %
WRITEON("PRINTING");
COUNT := 0;
COL := 1;
WRITE("");
FOR I := 2 STEP 1 UNTIL LIMIT DO
  BEGIN
    IF FLAGS[I] = TRUE THEN
      BEGIN
         WRITEON(I);
         COUNT := COUNT + 1;
         COL := COL + 1;
         IF COL > 10 THEN
           BEGIN
             WRITE("");
             COL := 1;
           END;
      END;
  END;

WRITE("");
WRITE(COUNT, " PRIMES WERE FOUND.");

END


colnumeric=: 0&".&.>@{`[`]}

data=: 1 colnumeric |: fixcsv 0 :0
Lagos, 21
Cairo, 15.2
Kinshasa-Brazzaville, 11.3
Greater Johannesburg, 7.55
Mogadishu, 5.85
Khartoum-Omdurman, 4.98
Dar Es Salaam, 4.7
Alexandria, 4.58
Abidjan, 4.4
Casablanca, 3.98
)