type

  Bools[N: static int] = array[N, bool]
  SumCarry = tuple[sum, carry: bool]

proc ha(a, b: bool): SumCarry = (a xor b, a and b)

proc fa(a, b, ci: bool): SumCarry =
  let a = ha(ci, a)
  let b = ha(a[0], b)
  result = (b[0], a[1] or b[1])

proc fa4(a, b: Bools[4]): Bools[5] =
  var co, s: Bools[4]
  for i in 0..3:
    let r = fa(a[i], b[i], if i > 0: co[i-1] else: false)
    s[i] = r[0]
    co[i] = r[1]
  result[0..3] = s
  result[4] = co[3]

proc int2bus(n: int): Bools[4] =
  var n = n
  for i in 0..result.high:
    result[i] = (n and 1) == 1
    n = n shr 1

proc bus2int(b: Bools): int =
  for i, x in b:
    result += (if x: 1 else: 0) shl i

for a in 0..7:
  for b in 0..7:
    assert a + b == bus2int fa4(int2bus(a), int2bus(b))


(* File blocks.ml

A block is just a black box with nin input lines and nout output lines,
numbered from 0 to nin-1 and 0 to nout-1 respectively. It will be stored
in a caml record, with the operation stored as a function. A value on
a line is represented by a boolean value. *)

type block = { nin:int; nout:int; apply:bool array -> bool array };;

(* First we need function for boolean conversion to and from integer values,
mainly for pretty printing of results *)

let int_of_bits nbits v =
	if (Array.length v) <> nbits then failwith "bad args"
	else
		(let r = ref 0L in
		for i=nbits-1 downto 0 do
			r := Int64.add (Int64.shift_left !r 1) (if v.(i) then 1L else 0L)
		done;
		!r);;

let bits_of_int nbits n =
	let v = Array.make nbits false
	and r = ref n in
	for i=0 to nbits-1 do
		v.(i) <- (Int64.logand !r 1L) <> Int64.zero;
		r := Int64.shift_right_logical !r 1
	done;
	v;;

let input nbits v =
	let n = Array.length v in
	let w = Array.make (n*nbits) false in
	Array.iteri (fun i x ->
		Array.blit (bits_of_int nbits x) 0 w (i*nbits) nbits
	) v;
	w;;

let output nbits v =
	let nv = Array.length v in
	let r = nv mod nbits and n = nv/nbits in
	if r <> 0 then failwith "bad output size" else
	Array.init n (fun i ->
		int_of_bits nbits (Array.sub v (i*nbits) nbits)
	);;

(* We have a type for blocks, so we need operations on blocks.

assoc:        make one block from two blocks, side by side (they are not connected)
serial:       connect input from one block to output of another block
parallel:     make two outputs from one input passing through two blocks
block_array:  an array of blocks linked by the same connector (assoc, serial, parallel) *)

let assoc a b =
	{ nin=a.nin+b.nin; nout=a.nout+b.nout; apply=function
		bits -> Array.append
			(a.apply (Array.sub bits 0 a.nin))
			(b.apply (Array.sub bits a.nin b.nin)) };;

let serial a b =
	if a.nout <> b.nin then
		failwith "[serial] bad block"
	else
	{ nin=a.nin; nout=b.nout; apply=function
		bits -> b.apply (a.apply bits) };;

let parallel a b =
	if a.nin <> b.nin then
		failwith "[parallel] bad blocks"
	else { nin=a.nin; nout=a.nout+b.nout; apply=function
		bits -> Array.append (a.apply bits) (b.apply bits) };;

let block_array comb v =
	let n = Array.length v
	and r = ref v.(0) in
	for i=1 to n-1 do
		r := comb !r v.(i)
	done;
	!r;;

(* wires

map:     map n input lines on length(v) output lines, using the links out(k)=v(in(k))
pass:    n wires not connected (out(k) = in(k))
fork:    a wire is developed into n wires having the same value
perm:    permutation of wires
forget:  n wires going nowhere
sub:     subset of wires, other ones going nowhere *)

let map n v = { nin=n; nout=Array.length v; apply=function
	bits -> Array.map (function k -> bits.(k)) v };;

let pass n = { nin=n; nout=n; apply=function
	bits -> bits };;

let fork n = { nin=1; nout=n; apply=function
	bits -> Array.make n bits.(0) };;

let perm v =
	let n = Array.length v in
	{ nin=n; nout=n; apply=function
		bits -> Array.init n (function k -> bits.(v.(k))) };;

let forget n = { nin=n; nout=0; apply=function
	bits -> [| |] };;

let sub nin nout where = { nin=nin; nout=nout; apply=function
	bits -> Array.sub bits where nout };;

let transpose n p v =
	if n*p <> Array.length v
		then failwith "bad dim"
	else
		let w = Array.copy v in
		for i=0 to n-1 do
			for j=0 to p-1 do
				let r = i*p+j and s = j*n+i in
				w.(r) <- v.(s)
			done
		done;
		w;;

(* line mixing (a special permutation)
mix 4 2 : 0,1,2,3, 4,5,6,7 -> 0,4, 1,5, 2,6, 3,7
unmix: inverse operation *)

let mix n p = perm (transpose n p (Array.init (n*p) (function x -> x)));;

let unmix n p = perm (transpose p n (Array.init (n*p) (function x -> x)));;

(* basic blocks

dummy:   no input, no output, usually not useful
const:   n wires with constant value (true or false)
encode:  translates an Int64 into boolean values, keeping only n lower bits
bnand:   NAND gate, the basic building block for all the other basic gates (or, and, not...) *)

let dummy = { nin=0; nout=0; apply=function
	bits -> bits };;

let const b n = { nin=0; nout=n; apply=function
	bits -> Array.make n b };;

let encode nbits x = { nin=0; nout=nbits; apply=function
	bits -> bits_of_int nbits x };;

let bnand = { nin=2; nout=1; apply=function
	[| a; b |] -> [| not (a && b) |] | _ -> failwith "bad args" };;

(* block evaluation : returns the value of the output, given an input and a block. *)

let eval block nbits_in nbits_out v =
	output nbits_out (block.apply (input nbits_in v));;

(* building a 4-bit adder *)

(* first we build the usual gates *)

let bnot = serial (fork 2) bnand;;

let band = serial bnand bnot;;

(* a or b = !a nand !b *)
let bor = serial (assoc bnot bnot) bnand;;

(* line "a" -> two lines, "a" and "not a" *)
let a_not_a = parallel (pass 1) bnot;;

let bxor = block_array serial [|
	assoc a_not_a a_not_a;
	perm [| 0; 3; 1; 2 |];
	assoc band band;
	bor |];;

let half_adder = parallel bxor band;;

(* bits C0,A,B -> S,C1 *)
let full_adder = block_array serial [|
	assoc half_adder (pass 1);
	perm [| 1; 0; 2 |];
	assoc (pass 1) half_adder;
	perm [| 1; 0; 2 |];
	assoc (pass 1) bor |];;

(* 4-bit adder *)
let add4 = block_array serial [|
	mix 4 2;
	assoc half_adder (pass 6);
	assoc (assoc (pass 1) full_adder) (pass 4);
	assoc (assoc (pass 2) full_adder) (pass 2);
	assoc (pass 3) full_adder |];;

(* 4-bit adder and three supplementary lines to make a multiple of 4 (to translate back to 4-bit integers) *)
let add4_io = assoc add4 (const false 3);;

(* wrapping the 4-bit to input and output integers instead of booleans
plus a b -> (sum,carry)
*)
let plus a b =
	let v = Array.map Int64.to_int
		(eval add4_io 4 4 (Array.map Int64.of_int [| a; b |])) in
	v.(0), v.(1);;


sub dec2bin { sprintf "%04b", shift }
sub bin2dec { oct "0b".shift }
sub bin2bits { reverse split(//, substr(shift,0,shift)); }
sub bits2bin { join "", map { 0+$_ } reverse @_ }

sub bxor {
  my($a, $b) = @_;
  (!$a & $b) | ($a & !$b);
}

sub half_adder {
  my($a, $b) = @_;
  ( bxor($a,$b), $a & $b );
}

sub full_adder {
  my($a, $b, $c) = @_;
  my($s1, $c1) = half_adder($a, $c);
  my($s2, $c2) = half_adder($s1, $b);
  ($s2, $c1 | $c2);
}

sub four_bit_adder {
  my($a, $b) = @_;
  my @abits = bin2bits($a,4);
  my @bbits = bin2bits($b,4);

  my($s0,$c0) = full_adder($abits[0], $bbits[0], 0);
  my($s1,$c1) = full_adder($abits[1], $bbits[1], $c0);
  my($s2,$c2) = full_adder($abits[2], $bbits[2], $c1);
  my($s3,$c3) = full_adder($abits[3], $bbits[3], $c2);
  (bits2bin($s0, $s1, $s2, $s3), $c3);
}

print " A    B      A      B   C    S  sum\n";
for my $a (0 .. 15) {
  for my $b (0 .. 15) {
    my($abin, $bbin) = map { dec2bin($_) } $a,$b;
    my($s,$c) = four_bit_adder( $abin, $bbin );
    printf "%2d + %2d = %s + %s = %s %s = %2d\n",
           $a, $b, $abin, $bbin, $c, $s, bin2dec($c.$s);
  }
}


with javascript_semantics
function xor_gate(bool a, bool b)
    return (a and not b) or (not a and b)
end function

function half_adder(bool a, bool b)
    bool s = xor_gate(a,b),
         c = a and b
    return {s,c}
end function

function full_adder(bool a, bool b, bool c)
    bool {s1,c1} = half_adder(c,a),
         {s2,c2} = half_adder(s1,b)
    c = c1 or c2
    return {s2,c}
end function

function four_bit_adder(bool a0, a1, a2, a3, b0, b1, b2, b3)
    bool s0,s1,s2,s3,c
    {s0,c} = full_adder(a0,b0,0)
    {s1,c} = full_adder(a1,b1,c)
    {s2,c} = full_adder(a2,b2,c)
    {s3,c} = full_adder(a3,b3,c)
    return {s3,s2,s1,s0,c}
end function

procedure test(integer a, integer b)
    bool {a0,a1,a2,a3} = int_to_bits(a,4),
         {b0,b1,b2,b3} = int_to_bits(b,4),
         {r3,r2,r1,r0,c} = four_bit_adder(a0,a1,a2,a3,b0,b1,b2,b3)
    integer r = bits_to_int({r0,r1,r2,r3})
    string s = iff(c?sprintf(" [=%d+16]",r):"")
    printf(1,"%04b + %04b = %04b %b (%d+%d=%d%s)\n",{a,b,r,c,a,b,c*16+r,s})
end procedure

test(0,0)
test(0,1)
test(0b1111,0b1111)
test(3,7)
test(11,8)
test(0b1100,0b1100)
test(0b1100,0b1101)
test(0b1100,0b1110)
test(0b1100,0b1111)
test(0b1101,0b0000)
test(0b1101,0b0001)
test(0b1101,0b0010)
test(0b1101,0b0011)


(de halfAdder (A B)  #> (Carry . Sum)
   (cons
      (and A B)
      (xor A B) ) )

(de fullAdder (A B C)  #> (Carry . Sum)
   (let (Ha1 (halfAdder C A)  Ha2 (halfAdder (cdr Ha1) B))
      (cons
         (or (car Ha1) (car Ha2))
         (cdr Ha2) ) ) )

(de 4bitsAdder (A4 A3 A2 A1  B4 B3 B2 B1)  #> (V S4 S3 S2 S1)
   (let
      (Fa1 (fullAdder A1 B1)
         Fa2 (fullAdder A2 B2 (car Fa1))
         Fa3 (fullAdder A3 B3 (car Fa2))
         Fa4 (fullAdder A4 B4 (car Fa3)) )
      (list
         (car Fa4)
         (cdr Fa4)
         (cdr Fa3)
         (cdr Fa2)
         (cdr Fa1) ) ) )


/* 4-BIT ADDER */

TEST: PROCEDURE OPTIONS (MAIN);
   DECLARE CARRY_IN BIT (1) STATIC INITIAL ('0'B) ALIGNED;
   declare (m, n, sum)(4) bit(1) aligned;
   declare i fixed binary;

   get edit (m, n) (b(1));
   put edit (m, ' + ', n, ' = ') (4 b, a);

   do i = 4 to 1 by -1;
      call full_adder ((carry_in), m(i), n(i), sum(i), carry_in);
   end;
   put edit (sum) (b);

HALF_ADDER: PROCEDURE (IN1, IN2, SUM, CARRY);
   DECLARE (IN1, IN2, SUM, CARRY) BIT (1) ALIGNED;

   SUM = ( ^IN1 & IN2) | ( IN1 & ^IN2);
         /* Exclusive OR using only AND, NOT, OR. */
   CARRY = IN1 & IN2;

END HALF_ADDER;

FULL_ADDER: PROCEDURE (CARRY_IN, IN1, IN2, SUM, CARRY);
   DECLARE (CARRY_IN, IN1, IN2, SUM, CARRY) BIT (1) ALIGNED;
   DECLARE (SUM2, CARRY2) BIT (1) ALIGNED;

   CALL HALF_ADDER (CARRY_IN, IN1, SUM, CARRY);
   CALL HALF_ADDER (SUM, IN2, SUM2, CARRY2);
   SUM = SUM2;
   CARRY = CARRY | CARRY2;
END FULL_ADDER;

END TEST;


function bxor2 ( [byte] $a, [byte] $b )
{
    $out1 = $a -band ( -bnot $b )
    $out2 = ( -bnot $a ) -band $b
    $out1 -bor $out2
}

function hadder ( [byte] $a, [byte] $b )
{
    @{
        "S"=bxor2 $a $b
        "C"=$a -band $b
    }
}

function fadder ( [byte] $a, [byte] $b, [byte] $cd )
{
    $out1 = hadder $cd $a
    $out2 = hadder $out1["S"] $b
    @{
        "S"=$out2["S"]
        "C"=$out1["C"] -bor $out2["C"]
    }
}

function FourBitAdder ( [byte] $a, [byte] $b )
{
    $a0 = $a -band 1
    $a1 = ($a -band 2)/2
    $a2 = ($a -band 4)/4
    $a3 = ($a -band 8)/8
    $b0 = $b -band 1
    $b1 = ($b -band 2)/2
    $b2 = ($b -band 4)/4
    $b3 = ($b -band 8)/8
    $out1 = fadder $a0 $b0 0
    $out2 = fadder $a1 $b1 $out1["C"]
    $out3 = fadder $a2 $b2 $out2["C"]
    $out4 = fadder $a3 $b3 $out3["C"]
    @{
        "S"="{3}{2}{1}{0}" -f $out1["S"], $out2["S"], $out3["S"], $out4["S"]
        "V"=$out4["C"]
    }
}

FourBitAdder 3 5

FourBitAdder 0xA 5

FourBitAdder 0xC 0xB

[Convert]::ToByte((FourBitAdder 0xC 0xB)["S"],2)


% binary 4 bit adder chip simulation

b_not(in(hi), out(lo)) :- !.      % not(1) = 0
b_not(in(lo), out(hi)).           % not(0) = 1

b_and(in(hi,hi), out(hi)) :- !.   % and(1,1) = 1
b_and(in(_,_), out(lo)).          % and(anything else) = 0

b_or(in(hi,_), out(hi)) :- !.     % or(1,any) = 1
b_or(in(_,hi), out(hi)) :- !.     % or(any,1) = 1
b_or(in(_,_), out(lo)).           % or(anything else) = 0

b_xor(in(A,B), out(O)) :-
    b_not(in(A), out(NotA)), b_not(in(B), out(NotB)),
    b_and(in(A,NotB), out(P)), b_and(in(NotA,B), out(Q)),
    b_or(in(P,Q), out(O)).

b_half_adder(in(A,B), s(S), c(C)) :-
    b_xor(in(A,B),out(S)), b_and(in(A,B),out(C)).

b_full_adder(in(A,B,Ci), s(S), c(C1)) :-
  b_half_adder(in(Ci, A), s(S0), c(C0)),
  b_half_adder(in(S0, B), s(S), c(C)),
  b_or(in(C0,C), out(C1)).

b_4_bit_adder(in(A0,A1,A2,A3), in(B0,B1,B2,B3), out(S0,S1,S2,S3), c(V)) :-
  b_full_adder(in(A0,B0,lo), s(S0), c(C0)),
  b_full_adder(in(A1,B1,C0), s(S1), c(C1)),
  b_full_adder(in(A2,B2,C1), s(S2), c(C2)),
  b_full_adder(in(A3,B3,C2), s(S3), c(V)).

test_add(A,B,T) :-
  b_4_bit_adder(A, B, R, C),
  writef('%w + %w is %w %w  \t(%w)\n', [A,B,R,C,T]).

go :-
  test_add(in(hi,lo,lo,lo), in(hi,lo,lo,lo), '1 + 1 = 2'),
  test_add(in(lo,hi,lo,lo), in(lo,hi,lo,lo), '2 + 2 = 4'),
  test_add(in(hi,lo,hi,lo), in(hi,lo,lo,hi), '5 + 9 = 14'),
  test_add(in(hi,hi,lo,hi), in(hi,lo,lo,hi), '11 + 9 = 20'),
  test_add(in(lo,lo,lo,hi), in(lo,lo,lo,hi), '8 + 8 = 16'),
  test_add(in(hi,hi,hi,hi), in(hi,lo,lo,lo), '15 + 1 = 16').


;Because no representation for a solitary bit is present, bits are stored as bytes.
;Output values from the constructive building blocks is done using pointers (i.e. '*').

Procedure.b notGate(x)
  ProcedureReturn ~x
EndProcedure

Procedure.b xorGate(x,y)
  ProcedureReturn  (x & notGate(y)) | (notGate(x) & y)
EndProcedure

Procedure halfadder(a, b, *sum.Byte, *carry.Byte)
  *sum\b = xorGate(a, b)
  *carry\b = a & b
EndProcedure

Procedure fulladder(a, b, c0, *sum.Byte, *c1.Byte)
  Protected sum_ac.b, carry_ac.b, carry_sb.b

  halfadder(c0, a, @sum_ac, @carry_ac)
  halfadder(sum_ac, b, *sum, @carry_sb)
  *c1\b = carry_ac | carry_sb
EndProcedure

Procedure fourbitsadder(a0, a1, a2, a3, b0, b1, b2, b3 , *s0.Byte, *s1.Byte, *s2.Byte, *s3.Byte, *v.Byte)
  Protected.b c1, c2, c3

  fulladder(a0, b0, 0,   *s0, @c1)
  fulladder(a1, b1, c1,  *s1, @c2)
  fulladder(a2, b2, c2,  *s2, @c3)
  fulladder(a3, b3, c3,  *s3, *v)
EndProcedure

;// Test implementation, map two 4-character strings to the inputs of the fourbitsadder() and display results
Procedure.s test_4_bit_adder(a.s,b.s)
  Protected.b s0, s1, s2, s3,  v, i
  Dim a.b(3)
  Dim b.b(3)
  For i = 0 To 3
    a(i) = Val(Mid(a, 4 - i, 1))
    b(i) = Val(Mid(b, 4 - i, 1))
  Next

  fourbitsadder(a(0), a(1), a(2), a(3), b(0), b(1), b(2), b(3), @s0, @s1, @s2, @s3, @v)
  ProcedureReturn a + " + " + b + " = " + Str(s3) + Str(s2) + Str(s1) + Str(s0) + " overflow " + Str(v)
EndProcedure

If OpenConsole()
  PrintN(test_4_bit_adder("0110","1110"))

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


def xor(a, b): return (a and not b) or (b and not a)

def ha(a, b): return xor(a, b), a and b     # sum, carry

def fa(a, b, ci):
    s0, c0 = ha(ci, a)
    s1, c1 = ha(s0, b)
    return s1, c0 or c1     # sum, carry

def fa4(a, b):
    width = 4
    ci = [None] * width
    co = [None] * width
    s  = [None] * width
    for i in range(width):
        s[i], co[i] = fa(a[i], b[i], co[i-1] if i else 0)
    return s, co[-1]

def int2bus(n, width=4):
    return [int(c) for c in "{0:0{1}b}".format(n, width)[::-1]]

def bus2int(b):
    return sum(1 << i for i, bit in enumerate(b) if bit)

def test_fa4():
    width = 4
    tot = [None] * (width + 1)
    for a in range(2**width):
        for b in range(2**width):
            tot[:width], tot[width] = fa4(int2bus(a), int2bus(b))
            assert a + b == bus2int(tot), "totals don't match: %i + %i != %s" % (a, b, tot)

if __name__ == '__main__':
   test_fa4()


#lang racket

(define (adder-and a b)
  (if (= 2 (+ a b)) 1 0))    ; Defining the basic and function

(define (adder-not a)
  (if (zero? a) 1 0))        ; Defining the basic not function

(define (adder-or a b)
  (if (> (+ a b) 0) 1 0))    ; Defining the basic or function

(define (adder-xor a b)
  (adder-or
   (adder-and
    (adder-not a)
    b)
   (adder-and
    a
    (adder-not b))))         ; Defines the xor function based on the basic functions

(define (half-adder a b)
  (list (adder-xor a b) (adder-and a b))) ; Creates the half adder, returning '(sum carry)

(define (adder a b c0)
  (define half-a (half-adder c0 a))
  (define half-b (half-adder (car half-a) b))
  (list
   (car half-b)
   (adder-or (cadr half-a) (cadr half-b))))  ; Creates the full adder, returns '(sum carry)

(define (n-bit-adder 4a 4b)   ; Creates the n-bit adder, it receives 2 lists of same length
  (let-values                 ; Lists of the form '([01]+)
      (((4s v)                ; for/fold form will return 2 values, receiving this here
        (for/fold ((S null) (c 0)) ;initializes the full sum and carry
          ((a (in-list (reverse 4a))) (b (in-list (reverse 4b))))
          ;here it prepares variables for summing each element, starting from the least important bits
          (define added
            (adder a b c))
          (values
           (cons (car added) S) ; changes S and c to it's new values in the next iteration
           (cadr added)))))
    (if (zero? v)
        4s
        (cons v 4s))))

(n-bit-adder '(1 0 1 0) '(0 1 1 1)) ;-> '(1 0 0 0 1)


/*REXX program displays (all) the  sums  of a  full  4─bit adder  (with carry).         */
call hdr1;    call hdr2                          /*note the order of headers & trailers.*/
                                                 /* [↓]  traipse thru all possibilities.*/
   do    j=0  for 16
                             do m=0  for 4;   a.m= bit(j, m)
                             end   /*m*/
      do k=0  for 16
                             do m=0  for 4;   b.m= bit(k, m)
                             end   /*m*/
      sc= 4bitAdder(a., b.)
      z= a.3 a.2 a.1 a.0    '~+~'   b.3 b.2 b.1 b.0   "~=~"    sc   ','    s.3 s.2 s.1 s.0
      say translate( space(z, 0), , '~')         /*translate tildes (~) to blanks in Z. */
      end   /*k*/
   end      /*j*/

call hdr2;    call hdr1                          /*display two trailers (note the order)*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
bit:       procedure;  parse arg x,y;    return  substr( reverse( x2b( d2x(x) ) ), y+1, 1)
halfAdder: procedure expose c;   parse arg x,y;          c= x & y;           return x && y
hdr1:      say 'aaaa + bbbb = c, sum     [c=carry]';                         return
hdr2:      say '════   ════   ══════'              ;                         return
/*──────────────────────────────────────────────────────────────────────────────────────*/
fullAdder: procedure expose c;   parse arg x,y,fc
           #1= halfAdder(fc, x);        c1= c
           #2= halfAdder(#1, y);        c= c | c1;                           return #2
/*──────────────────────────────────────────────────────────────────────────────────────*/
4bitAdder: procedure expose s. a. b.;  carry.= 0
               do j=0  for 4;                 n= j - 1
               s.j= fullAdder(a.j, b.j, carry.n);        carry.j= c
               end   /*j*/;                                                  return c


	.model small
        .stack 1024
.data
         ;data segment is unused in this program
.code

start:

	mov ax,@code
	mov ds,ax
	mov es,ax

	cld              ;make lodsb, etc. auto-increment

	mov al, byte ptr [ds:LeadingZeroes]
	mov cl,al
	mov ch,0
	mov al,'0'			;30h
	jcxz DonePrintingLeadingZeroes  ;there are leading zeroes so we won't skip that section. This branch is not taken.

printLeadingZeroes:
	call PrintChar                   ;print ascii 0 to the terminal 4 times
	loop printLeadingZeroes

DonePrintingLeadingZeroes:

	mov si, offset TestString
	call PrintString

	mov al, byte ptr [ds:TrailingZeroes]
	mov cl,al
	mov ch,0
	mov al,'0'			;30h
	jcxz DonePrintingTrailingZeroes	;there are none in this example so this branch is always taken
printTrailingZeroes:
	call PrintChar
	loop printTrailingZeroes

DonePrintingTrailingZeroes:
	mov ax,4C00h
	int 21h				;exit to DOS

TestString byte "7.125",0

LeadingZeroes  byte 4			;number of leading zeroes to print
TrailingZeroes byte 0			;number of trailing zeroes to print


###---------------------------
# Program: 4 Bit Adder - Ring
# Author:  Bert Mariani
# Date:    2018-02-28
#
# Bit Adder: Input  A B Cin
#            Output S   Cout
#
# A ^ B => axb                XOR gate
#          axb ^ C => Sout    XOR gate
#          axb & C => d       AND gate
#
# A & B => anb                AND gate
#          anb | d => Cout     OR gate
#
# Call Adder for number of bit in input fields
###-------------------------------------------
### 4 Bits

Cout     = "0"
OutputS  = "0000"
InputA   = "0101"
InputB   = "1101"

   See "InputA:.. "+ InputA +nl
   See "InputB:.. "+ InputB +nl
BitsAdd(InputA, InputB)
   See "Sum...: "+ Cout +" "+ OutputS +nl+nl

###-------------------------------------------
### 32 Bits

Cout     = "0"
OutputS  = "00000000000000000000000000000000"
InputA   = "01010101010101010101010101010101"
InputB   = "11011101110111011101110111011101"

   See "InputA:.. "+ InputA +nl
   See "InputB:.. "+ InputB +nl
BitsAdd(InputA, InputB)
   See "Sum...: "+ Cout +" "+ OutputS +nl+nl

###-------------------------------

Func BitsAdd(InputA, InputB)
	nbrBits = len(InputA)

	for i = nbrBits to 1 step -1
	      A = InputA[i]
	      B = InputB[i]
	      C = Cout

              S = Adder(A,B,C)
	      OutputS[i] = "" + S
	next
return

###------------------------
Func Adder(A,B,C)

    axb  =   A ^ B
    Sout = axb ^ C
    d    = axb & C

    anb  =   A & B
    Cout = anb | d    ### Cout is global

return(Sout)
###------------------------


# returns pair [sum, carry]
def four_bit_adder(a, b)
  a_bits = binary_string_to_bits(a,4)
  b_bits = binary_string_to_bits(b,4)

  s0, c0 = full_adder(a_bits[0], b_bits[0],  0)
  s1, c1 = full_adder(a_bits[1], b_bits[1], c0)
  s2, c2 = full_adder(a_bits[2], b_bits[2], c1)
  s3, c3 = full_adder(a_bits[3], b_bits[3], c2)

  [bits_to_binary_string([s0, s1, s2, s3]), c3.to_s]
end

# returns pair [sum, carry]
def full_adder(a, b, c0)
  s, c = half_adder(c0, a)
  s, c1 = half_adder(s, b)
  [s, _or(c,c1)]
end

# returns pair [sum, carry]
def half_adder(a, b)
  [xor(a, b), _and(a,b)]
end

def xor(a, b)
  _or(_and(a, _not(b)), _and(_not(a), b))
end

# "and", "or" and "not" are Ruby keywords
def _and(a, b)  a & b  end
def _or(a, b)   a | b  end
def _not(a)    ~a & 1  end

def int_to_binary_string(n, length)
  "%0#{length}b" % n
end

def binary_string_to_bits(s, length)
  ("%#{length}s" % s).reverse.chars.map(&:to_i)
end

def bits_to_binary_string(bits)
  bits.map(&:to_s).reverse.join
end

puts " A    B      A      B   C    S  sum"
0.upto(15) do |a|
  0.upto(15) do |b|
    bin_a = int_to_binary_string(a, 4)
    bin_b = int_to_binary_string(b, 4)
    sum, carry = four_bit_adder(bin_a, bin_b)
    puts "%2d + %2d = %s + %s = %s %s = %2d" %
         [a, b, bin_a, bin_b, carry, sum, (carry + sum).to_i(2)]
  end
end


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program formatNum64.s   */
/* use C library printf  ha, ha, ha !!! */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"
/*******************************************/
/* Initialized data                        */
/*******************************************/
.data
szFormat1:         .asciz " %09.3f\n"
.align 4
sfNumber:          .double  0f-7125E-3
sfNumber1:         .double  0f7125E-3
/*******************************************/
/* UnInitialized data                      */
/*******************************************/
.bss
.align 4
/*******************************************/
/*  code section                           */
/*******************************************/
.text
.global main
main:                                   // entry of program

    ldr x0,qAdrszFormat1                // format
    ldr x1,qAdrsfNumber                 // float number address
    ldr d0,[x1]                         // load float number in d0
    bl printf                           // call C function !!!
    ldr x0,qAdrszFormat1
    ldr x1,qAdrsfNumber1
    ldr d0,[x1]
    bl printf

100:                                    // standard end of the program
    mov x0,0                            // return code
    mov x8,EXIT                         // request to exit program
    svc 0                               // perform the system call

qAdrszFormat1:           .quad szFormat1
qAdrsfNumber:            .quad sfNumber
qAdrsfNumber1:           .quad sfNumber1


with Ada.Text_Io.Editing; use Ada.Text_Io.Editing;
with Ada.Text_Io; use Ada.Text_Io;

procedure Zero_Fill is
   Pic_String: String := "<999999.99>";
   Pic : Picture := To_Picture(Pic_String);
   type Money is delta 0.01 digits 8;
   package Money_Output is new Decimal_Output(Money);
   use Money_Output;

   Value : Money := 37.25;
begin
   Put(Item => Value, Pic => Pic);
end Zero_Fill;


main:(
  REAL r=exp(pi)-pi;
  print((r,newline));
  printf(($g(-16,4)l$,-r));
  printf(($g(-16,4)l$,r));
  printf(($g( 16,4)l$,r));
  printf(($g( 16,4,1)l$,r));
  printf(($-dddd.ddddl$,-r));
  printf(($-dddd.ddddl$,r));
  printf(($+dddd.ddddl$,r));
  printf(($ddddd.ddddl$,r));
  printf(($zzzzd.ddddl$,r));
  printf(($zzzz-d.ddddl$,r));
  printf(($zzzz-d.ddddedl$,r));
  printf(($zzzz-d.ddddeddl$,r));
  printf(($4z-d.4de4dl$,r))
)


// half adder with XOR and AND
// SUM = A XOR B
// CARRY = A.B
fn half_adder(a: usize, b: usize) -> (usize, usize) {
    return (a ^ b, a & b);
}

// full adder as a combination of half adders
// SUM = A XOR B XOR C
// CARRY = A.B + B.C + C.A
fn full_adder(a: usize, b: usize, c_in: usize) -> (usize, usize) {
    let (s0, c0) = half_adder(a, b);
    let (s1, c1) = half_adder(s0, c_in);
    return (s1, c0 | c1);
}

// A = (A3, A2, A1, A0)
// B = (B3, B2, B1, B0)
// S = (S3, S2, S1, S0)
fn four_bit_adder (
    a: (usize, usize, usize, usize),
    b: (usize, usize, usize, usize)
)
    ->
    // 4 bit output, carry is ignored
    (usize, usize, usize, usize)
{
    // lets have a.0 refer to the rightmost element
    let a = a.reverse();
    let b = b.reverse();

    // i would prefer a loop but that would abstract
    // the "connections of the constructive blocks"
    let (sum, carry) = half_adder(a.0, b.0);
    let out0 = sum;
    let (sum, carry) = full_adder(a.1, b.1, carry);
    let out1 = sum;
    let (sum, carry) = full_adder(a.2, b.2, carry);
    let out2 = sum;
    let (sum, _) = full_adder(a.3, b.3, carry);
    let out3 = sum;
    return (out3, out2, out1, out0);
}

fn main() {
    let a: (usize, usize, usize, usize) = (0, 1, 1, 0);
    let b: (usize, usize, usize, usize) = (0, 1, 1, 0);
    assert_eq!(four_bit_adder(a, b), (1, 1, 0, 0));
    // 0110 + 0110 = 1100
    // 6 + 6 = 12
}

// misc. traits to make our life easier
trait Reverse<A, B, C, D> {
    fn reverse(self) -> (D, C, B, A);
}

// reverse a generic tuple of arity 4
impl<A, B, C, D> Reverse<A, B, C, D> for (A, B, C, D) {
    fn reverse(self) -> (D, C, B, A){
        return (self.3, self.2, self.1, self.0)
    }
}


-- a "pin" can be connected only to one component
-- that "sets" it to 0 or 1, while it can be "read"
-- ad libitum. (Tristate logic is not taken into account)
-- This class does the proper checking, assuring the "circuit"
-- and the connections are described correctly. Currently can make
-- hard the implementation of a latch
class PIN is
  private attr v:INT;
  readonly attr name:STR;
  private attr connected:BOOL;

  create(n:STR):SAME is -- n = conventional name for this "pin"
    res ::= new;
    res.name := n;
    res.connected := false;
    return res;
  end;

  val:INT is
    if self.connected.not then
       #ERR + "pin " + self.name + " is undefined\n";
       return 0; -- could return a random bit to "simulate" undefined
                 -- behaviour
    else
       return self.v;
    end;
  end;

  -- connect ...
  val(v:INT) is
    if self.connected then
       #ERR + "pin " + self.name + " is already 'assigned'\n";
    else
       self.connected := true;
       self.v := v.band(1);
    end;
  end;

  -- connect to existing pin
  val(v:PIN) is
     self.val(v.val);
  end;
end;

-- XOR "block"
class XOR is
  readonly attr xor :PIN;

  create(a, b:PIN):SAME is
    res ::= new;
    res.xor := #PIN("xor output");
    l   ::= a.val.bnot.band(1).band(b.val);
    r   ::= a.val.band(b.val.bnot.band(1));
    res.xor.val := r.bor(l);
    return res;
  end;
end;

-- HALF ADDER "block"
class HALFADDER is
  readonly attr s, c:PIN;

  create(a, b:PIN):SAME is
    res ::= new;
    res.s := #PIN("halfadder sum output");
    res.c := #PIN("halfadder carry output");
    res.s.val := #XOR(a, b).xor.val;
    res.c.val := a.val.band(b.val);
    return res;
  end;
end;

-- FULL ADDER "block"
class FULLADDER is
  readonly attr s, c:PIN;

  create(a, b, ic:PIN):SAME is
    res ::= new;
    res.s := #PIN("fulladder sum output");
    res.c := #PIN("fulladder carry output");
    halfadder1 ::= #HALFADDER(a, b);
    halfadder2 ::= #HALFADDER(halfadder1.s, ic);
    res.s.val := halfadder2.s;
    res.c.val := halfadder2.c.val.bor(halfadder1.c.val);
    return res;
  end;
end;

-- FOUR BITS ADDER "block"
class FOURBITSADDER is
  readonly attr s0, s1, s2, s3, v :PIN;

  create(a0, a1, a2, a3, b0, b1, b2, b3:PIN):SAME is
    res ::= new;
    res.s0  := #PIN("4-bits-adder sum outbut line 0");
    res.s1  := #PIN("4-bits-adder sum outbut line 1");
    res.s2  := #PIN("4-bits-adder sum outbut line 2");
    res.s3  := #PIN("4-bits-adder sum outbut line 3");
    res.v   := #PIN("4-bits-adder overflow output");
    zero ::= #PIN("zero/mass pin");
    zero.val := 0;
    fa0 ::= #FULLADDER(a0, b0, zero);
    fa1 ::= #FULLADDER(a1, b1, fa0.c);
    fa2 ::= #FULLADDER(a2, b2, fa1.c);
    fa3 ::= #FULLADDER(a3, b3, fa2.c);
    res.v.val  := fa3.c;
    res.s0.val := fa0.s;
    res.s1.val := fa1.s;
    res.s2.val := fa2.s;
    res.s3.val := fa3.s;
    return res;
  end;
end;

-- testing --

class MAIN is
  main is
    a0 ::= #PIN("a0 in"); b0 ::= #PIN("b0 in");
    a1 ::= #PIN("a1 in"); b1 ::= #PIN("b1 in");
    a2 ::= #PIN("a2 in"); b2 ::= #PIN("b2 in");
    a3 ::= #PIN("a3 in"); b3 ::= #PIN("b3 in");
    ov ::= #PIN("overflow");

    a0.val := 1; b0.val := 1;
    a1.val := 1; b1.val := 1;
    a2.val := 0; b2.val := 0;
    a3.val := 0; b3.val := 1;

    fba ::= #FOURBITSADDER(a0,a1,a2,a3,b0,b1,b2,b3);
    #OUT + #FMT("%d%d%d%d", a3.val, a2.val, a1.val, a0.val) +
    	   " + " +
           #FMT("%d%d%d%d", b3.val, b2.val, b1.val, b0.val) +
           " = " +
           #FMT("%d%d%d%d", fba.s3.val, fba.s2.val, fba.s1.val, fba.s0.val) +
           ", overflow = " + fba.v.val + "\n";
  end;
end;


PROC newRealF(es, fl, digit, len=0, zeros=TRUE)
  DEF s, t, i
  IF (len = 0) OR (len < (digit+3))
    RETURN RealF(es, fl, digit)
  ELSE
    s := String(len)
    t := RealF(es, fl, digit)
    FOR i := 0 TO len-EstrLen(t)-1 DO StrAdd(s, IF zeros THEN '0' ELSE ' ')
    StrAdd(s, t)
    StrCopy(es, s)
    DisposeLink(s)
    DisposeLink(t)
  ENDIF
ENDPROC es

PROC main()
  DEF s[100] : STRING
  WriteF('\s\n', newRealF(s, 7.125, 3,9))
ENDPROC


/* ARM assembly Raspberry PI  */
/*  program formatNum.s   */
/* use C library printf  ha, ha, ha !!! */
/* Constantes               */
.equ EXIT,   1                         @ Linux syscall
/* Initialized data */
.data
szFormat1:         .asciz " %09.3f\n"
.align 4
sfNumber:          .double  0f-7125E-3
sfNumber1:         .double  0f7125E-3

/* UnInitialized data */
.bss
.align 4

/*  code section */
.text
.global main
main:                                   @ entry of program
    push {fp,lr}                        @ saves registers

    ldr r0,iAdrszFormat1                @ format
    ldr r1,iAdrsfNumber                 @ number address
    ldr r2,[r1]                         @ load first 4 bytes
    ldr r3,[r1,#4]                      @ load last 4 bytes
    bl printf                           @ call C function !!!
    ldr r0,iAdrszFormat1
    ldr r1,iAdrsfNumber1
    ldr r2,[r1]
    ldr r3,[r1,#4]
    bl printf

100:                                    @ standard end of the program
    mov r0, #0                          @ return code
    pop {fp,lr}                         @restaur  registers
    mov r7, #EXIT                       @ request to exit program
    swi 0                               @ perform the system call

iAdrszFormat1:           .int szFormat1
iAdrsfNumber:            .int sfNumber
iAdrsfNumber1:           .int sfNumber1


object FourBitAdder {
   type Nibble=(Boolean, Boolean, Boolean, Boolean)

   def xor(a:Boolean, b:Boolean)=(!a)&&b || a&&(!b)

   def halfAdder(a:Boolean, b:Boolean)={
      val s=xor(a,b)
      val c=a && b
      (s, c)
   }

   def fullAdder(a:Boolean, b:Boolean, cIn:Boolean)={
      val (s1, c1)=halfAdder(a, cIn)
      val (s, c2)=halfAdder(s1, b)
      val cOut=c1 || c2
      (s, cOut)
   }

   def fourBitAdder(a:Nibble, b:Nibble)={
      val (s0, c0)=fullAdder(a._4, b._4, false)
      val (s1, c1)=fullAdder(a._3, b._3, c0)
      val (s2, c2)=fullAdder(a._2, b._2, c1)
      val (s3, cOut)=fullAdder(a._1, b._1, c2)
      ((s3, s2, s1, s0), cOut)
   }
}


r: 7.125

print r
print to :string .format: "09.3f" r


MsgBox % pad(7.25,7)  ; 0007.25
MsgBox % pad(-7.25,7) ; -007.25

pad(x,len) { ; pad with 0's from left to len chars
   IfLess x,0, Return "-" pad(SubStr(x,2),len-1)
   VarSetCapacity(p,len,Asc("0"))
   Return SubStr(p x,1-len)
}


BEGIN {
  r=7.125
  printf " %9.3f\n",-r
  printf " %9.3f\n",r
  printf " %-9.3f\n",r
  printf " %09.3f\n",-r
  printf " %09.3f\n",r
  printf " %-09.3f\n",r
}


' Formatted numeric output
n = 7.125
PRINT n FORMAT "%09.3f\n"


(import (scheme base)
        (scheme write)
        (srfi 60))      ;; for logical bits

;; Returns a list of bits: '(sum carry)
(define (half-adder a b)
  (list (bitwise-xor a b) (bitwise-and a b)))

;; Returns a list of bits: '(sum carry)
(define (full-adder a b c-in)
  (let* ((h1 (half-adder c-in a))
         (h2 (half-adder (car h1) b)))
    (list (car h2) (bitwise-ior (cadr h1) (cadr h2)))))

;; a and b are lists of 4 bits each
(define (four-bit-adder a b)
  (let* ((add-1 (full-adder (list-ref a 3) (list-ref b 3) 0))
         (add-2 (full-adder (list-ref a 2) (list-ref b 2) (list-ref add-1 1)))
         (add-3 (full-adder (list-ref a 1) (list-ref b 1) (list-ref add-2 1)))
         (add-4 (full-adder (list-ref a 0) (list-ref b 0) (list-ref add-3 1))))
    (list (list (car add-4) (car add-3) (car add-2) (car add-1))
          (cadr add-4))))

(define (show-eg a b)
  (display a) (display " + ") (display b) (display " = ")
  (display (four-bit-adder a b)) (newline))

(show-eg (list 0 0 0 0) (list 0 0 0 0))
(show-eg (list 0 0 0 0) (list 1 1 1 1))
(show-eg (list 1 1 1 1) (list 0 0 0 0))
(show-eg (list 0 1 0 1) (list 1 1 0 0))
(show-eg (list 1 1 1 1) (list 1 1 1 1))
(show-eg (list 1 0 1 0) (list 0 1 0 1))


      PRINT FNformat(PI, 9, 3)
      PRINT FNformat(-PI, 9, 3)
      END

      DEF FNformat(n, sl%, dp%)
      LOCAL @%
      @% = &1020000 OR dp% << 8
      IF n >= 0 THEN
        = RIGHT$(STRING$(sl%,"0") + STR$(n), sl%)
      ENDIF
      = "-" + RIGHT$(STRING$(sl%,"0") + STR$(-n), sl%-1)


/*
 * Print number n, using at least c characters.
 *
 * Different from normal, this function:
 *  1. Uses the current ibase (not the obase) to print the number.
 *  2. Prunes "0" digits from the right, so p(1.500, 1) prints "1.5".
 *  3. Pads "0" digits to the left, so p(-1.5, 6) prints "-001.5".
 *  4. Never prints a newline.
 *
 * Use an assignment, as t = p(1.5, 1), to discard the return value
 * from this function so that bc not prints the return value.
 */
define p(n, c) {
	auto d, d[], f, f[], i, m, r, s, v
	s = scale	/* Save original scale. */

	if (n < 0) {
		"-"	/* Print negative sign. */
		c -= 1
		n = -n	/* Remove negative sign from n. */
	}

	/* d[] takes digits before the radix point. */
	scale = 0
	for (m = n / 1; m != 0; m /= 10) d[d++] = m % 10

	/* f[] takes digits after the radix point. */
	r = n - (n / 1)		/* r is these digits. */
	scale = scale(n)
	f = -1			/* f counts the digits of r. */
	for (m = r + 1; m != 0; m /= 10) f += 1
	scale = 0
	r = r * (10 ^ f) / 1	/* Remove radix point from r. */
	if (r != 0) {
		while (r % 10 == 0) {	/* Prune digits. */
			f -= 1
			r /= 10
		}
		for (i = 0; i < f; i++) {
			f[i] = r % 10
			r /= 10
		}
	}

	/* Pad "0" digits to reach c characters. */
	c -= d
	if (f > 0) c -= 1 + f
	for (1; c > 0; c--) "0"		/* Print "0". */

	/* i = index, m = maximum index, r = digit to print. */
	m = d + f
	for (i = 1; i <= m; i++) {
		if (i <= d) r = d[d - i]
		if (i > d) r = f[m - i]
		if (i == d + 1) "."	/* Print radix point. */

		v = 0
		if (r == v++) "0"	/* Print digit. */
		if (r == v++) "1"
		if (r == v++) "2"	/* r == 2 might not work, */
		if (r == v++) "3"	/* unless ibase is ten.   */
		if (r == v++) "4"
		if (r == v++) "5"
		if (r == v++) "6"
		if (r == v++) "7"
		if (r == v++) "8"
		if (r == v++) "9"
		if (r == v++) "A"
		if (r == v++) "B"
		if (r == v++) "C"
		if (r == v++) "D"
		if (r == v++) "E"
		if (r == v++) "F"
	}

	scale = s  /* Restore original scale. */
}


beads 1 program 'Formatted numeric output'
calc main_init
	var num = 7.125
	log to_str(num, min:9, zero_pad:Y)


func bxor(a, b) {
  (~a & b) | (a & ~b)
}

func half_adder(a, b) {
  return (bxor(a, b), a & b)
}

func full_adder(a, b, c) {
  var (s1, c1) = half_adder(a, c)
  var (s2, c2) = half_adder(s1, b)
  return (s2, c1 | c2)
}

func four_bit_adder(a, b) {
  var (s0, c0) = full_adder(a[0], b[0], 0)
  var (s1, c1) = full_adder(a[1], b[1], c0)
  var (s2, c2) = full_adder(a[2], b[2], c1)
  var (s3, c3) = full_adder(a[3], b[3], c2)
  return ([s3,s2,s1,s0].join, c3.to_s)
}

say " A    B      A      B   C    S  sum"
for a in ^16 {
  for b in ^16 {
    var(abin, bbin) = [a,b].map{|n| "%04b"%n->chars.reverse.map{.to_i} }...
    var(s, c) = four_bit_adder(abin, bbin)
    printf("%2d + %2d = %s + %s = %s %s = %2d\n",
        a, b, abin.join, bbin.join, c, s, "#{c}#{s}".bin)
    }
}


class Program
    {

        static void Main(string[] args)
        {

            float myNumbers = 7.125F;

            string strnumber = Convert.ToString(myNumbers);

            Console.WriteLine(strnumber.PadLeft(9, '0'));

            Console.ReadLine();
        }

    }


#include <iostream>
#include <iomanip>

int main()
{
  std::cout << std::setfill('0') << std::setw(9) << std::fixed << std::setprecision(3) << 7.125 << std::endl;
  return 0;
}


typealias FourBit = (Int, Int, Int, Int)

func halfAdder(_ a: Int, _ b: Int) -> (Int, Int) {
  return (a ^ b, a & b)
}

func fullAdder(_ a: Int, _ b: Int, carry: Int) -> (Int, Int) {
  let (s0, c0) = halfAdder(a, b)
  let (s1, c1) = halfAdder(s0, carry)

  return (s1, c0 | c1)
}

func fourBitAdder(_ a: FourBit, _ b: FourBit) -> (FourBit, carry: Int) {
  let (sum1, carry1) = halfAdder(a.3, b.3)
  let (sum2, carry2) = fullAdder(a.2, b.2, carry: carry1)
  let (sum3, carry3) = fullAdder(a.1, b.1, carry: carry2)
  let (sum4, carryOut) = fullAdder(a.0, b.0, carry: carry3)

  return ((sum4, sum3, sum2, sum1), carryOut)
}

let a = (0, 1, 1, 0)
let b = (0, 1, 1, 0)

print("\(a) + \(b) = \(fourBitAdder(a, b))")


module Half_Adder( input a, b, output s, c );
  assign s = a ^ b;
  assign c = a & b;
endmodule

module Full_Adder( input a, b, c_in, output s, c_out );

  wire s_ha1, c_ha1, c_ha2;

  Half_Adder ha1( .a(c_in), .b(a), .s(s_ha1), .c(c_ha1) );
  Half_Adder ha2( .a(s_ha1), .b(b), .s(s), .c(c_ha2) );
  assign c_out = c_ha1 | c_ha2;

endmodule

module Multibit_Adder(a,b,s);
  parameter N = 8;
  input [N-1:0] a;
  input [N-1:0] b;
  output [N:0] s;

  wire [N:0] c;

  assign c[0] = 0;
  assign s[N] = c[N];

  generate
    genvar I;
    for (I=0; I<N; ++I) Full_Adder add( .a(a[I]), .b(b[I]), .s(s[I]), .c_in(c[I]), .c_out(c[I+1]) );
  endgenerate

endmodule


IDENTIFICATION DIVISION.
PROGRAM-ID. NUMERIC-OUTPUT-PROGRAM.
DATA DIVISION.
WORKING-STORAGE SECTION.
01  WS-EXAMPLE.
    05 X            PIC  9(5)V9(3).
PROCEDURE DIVISION.
    MOVE     7.125  TO   X.
    DISPLAY  X      UPON CONSOLE.
    STOP RUN.


import std.stdio;

void main() {
    immutable r = 7.125;
    writefln(" %9.3f",  -r);
    writefln(" %9.3f",   r);
    writefln(" %-9.3f",  r);
    writefln(" %09.3f", -r);
    writefln(" %09.3f",  r);
    writefln(" %-09.3f", r);
}


package require Tcl 8.5

# Create our little language
proc pins args {
    # Just declaration...
    foreach p $args {upvar 1 $p v}
}
proc gate {name pins body} {
    foreach p $pins {
	lappend args _$p
	append v " \$_$p $p"
    }
    proc $name $args "upvar 1 $v;$body"
}

# Fundamental gates; these are the only ones that use Tcl math ops
gate not {x out}   {
    set out [expr {1 & ~$x}]
}
gate and {x y out} {
    set out [expr {$x & $y}]
}
gate or  {x y out} {
    set out [expr {$x | $y}]
}
gate GND pin {
    set pin 0
}

# Composite gates: XOR
gate xor {x y out} {
    pins nx ny x_ny nx_y

    not x          nx
    not y          ny
    and x ny       x_ny
    and nx y       nx_y
    or  x_ny nx_y  out
}

# Composite gates: half adder
gate halfadd {a b sum carry} {
    xor a b  sum
    and a b  carry
}

# Composite gates: full adder
gate fulladd {a b c0 sum c1} {
    pins sum_ac carry_ac carry_sb

    halfadd c0 a          sum_ac carry_ac
    halfadd sum_ac b      sum carry_sb
    or carry_ac carry_sb  c1
}

# Composite gates: 4-bit adder
gate 4add {a0 a1 a2 a3  b0 b1 b2 b3  s0 s1 s2 s3  v} {
    pins c0 c1 c2 c3

    GND c0
    fulladd a0 b0 c0  s0 c1
    fulladd a1 b1 c1  s1 c2
    fulladd a2 b2 c2  s2 c3
    fulladd a3 b3 c3  s3 v
}


[*
 * (n) (c) lpx
 * Print number n, using at least c characters.
 *
 * Different from normal, this function:
 *  1. Uses the current ibase (not the obase) to print the number.
 *  2. Prunes "0" digits from the right, so [1.500 1 lxp] prints "1.5".
 *  3. Pads "0" digits to the left, so [_1.5 6 lxp] prints "-001.5".
 *  4. Never prints a newline.
 *]sz
[
 Sc Sn          [Local n, c = from stack.]sz
 K Ss           [Local s = original scale.]sz
 [Reserve local variables D, F, I, L.]sz
 0 SD 0 SF 0 SI 0 SL

 [              [If n < 0:]sz
  [-]P           [Print negative sign.]sz
  lc 1 - sc      [Decrement c.]sz
  0 ln - sn      [Negate n.]sz
 ]sI 0 ln <I

 [*
  * Array D[] takes digits before the radix point.
  *]sz
 0 k            [scale = 0]sz
 0 Sd           [Local d = 0]sz
 ln 1 /         [Push digits before radix point.]sz
 [              [Loop to fill D[]:]sz
  d 10 % ld :D   [D[d] = next digit.]sz
  ld 1 + sd      [Increment d.]sz
  10 /           [Remove digit.]sz
  d 0 !=L        [Loop until no digits.]sz
 ]sL d 0 !=L
 sz             [Pop digits.]sz

 [*
  * Array F[] takes digits after the radix point.
  *]sz
 ln ln 1 / -    [Push digits after radix point.]sz
 d X k          [scale = enough.]sz
 _1 Sf          [Local f = -1]sz
 d 1 +          [Push 1 + digits after radix point.]sz
 [              [Loop to count digits:]sz
  lf 1 + sf      [Increment f.]sz
  10 /           [Remove digit.]sz
  d 0 !=L        [Loop until no digits.]sz
 ]sL d 0 !=L
 sz             [Pop 1 + digits.]sz
 0 k            [scale = 0]sz
 10 lf ^ * 1 /  [Remove radix point from digits.]sz
 [              [Loop to prune digits:]sz
  lf 1 - sf      [Decrement f.]sz
  10 /           [Remove digit.]sz
  d 10 % 0 =L    [Loop while last digit is 0.]sz
 ]sL d 10 % 0 =L
 0 Si           [Local i = 0]sz
 [              [Loop to fill F[]:]sz
  d 10 % li :F   [F[i] = next digit.]sz
  10 /           [Remove digit.]sz
  li 1 + si      [Increment i.]sz
  lf li <L       [Loop while i < f.]sz
 ]sL lf li <L
 sz             [Pop digits.]sz

 lc ld -        [Push count = c - d.]sz
 [              [If f > 0:]sz
  1 lf + -       [Subtract 1 radix point + f from count.]sz
 ]sI 0 lf >I
 [              [Loop:]sz
  [0]P           [Print a padding "0".]sz
  1 -            [Decrement count.]sz
  d 0 <L         [Loop while count > 0.]sz
 ]sL d 0 <L
 sz             [Pop count.]sz

 [              [Local function (digit) lPx:]sz
  [              [Execute:]sz
   [*
    * Push the string that matches the digit.
    *]sz
   [[0] 2Q]sI d 0 =I  [[1] 2Q]sI d 1 =I  [[2] 2Q]sI d 2 =I  [[3] 2Q]sI d 3 =I
   [[4] 2Q]sI d 4 =I  [[5] 2Q]sI d 5 =I  [[6] 2Q]sI d 6 =I  [[7] 2Q]sI d 7 =I
   [[8] 2Q]sI d 8 =I  [[9] 2Q]sI d 9 =I  [[A] 2Q]sI d A =I  [[B] 2Q]sI d B =I
   [[C] 2Q]sI d C =I  [[D] 2Q]sI d D =I  [[E] 2Q]sI d E =I  [[F] 2Q]sI d F =I
   [?]            [Else push "?".]sz
  ]x
  P              [Print the string.]sz
  sz             [Pop the digit.]sz
 ]SP
 ld             [Push counter = d.]sz
 [              [Loop:]sz
  1 -            [Decrement counter.]sz
  d ;D lPx       [Print digit D[counter].]sz
  d 0 <L         [Loop while counter > 0.]sz
 ]sL d 0 <L
 sz             [Pop counter.]sz
 [              [If f > 0:]sz
  [.]P           [Print radix point.]sz
  lf              [Push counter = f.]sz
  [              [Loop:]sz
   1 -            [Decrement counter.]sz
   d ;F lPx       [Print digit F[counter].]sz
   d 0 <L         [Loop while counter > 0.]sz
  ]sL d 0 <L
  sz             [Pop counter.]sz
 ]sI 0 lf >I

 [Restore variables n, c, d, f, D, F, L, I, P.]sz
 Lnsz Lcsz Ldsz Lfsz LDsz LFsz LLsz LIsz LPsz
 Ls k           [Restore variable s. Restore original scale.]sz
]sp


program FormattedNumericOutput;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const
  fVal = 7.125;

begin
  Writeln(FormatFloat('0000#.000',fVal));
  Writeln(FormatFloat('0000#.0000000',fVal));
  Writeln(FormatFloat('##.0000000',fVal));
  Writeln(FormatFloat('0',fVal));
  Writeln(FormatFloat('#.#E-0',fVal));
  Writeln(FormatFloat('#,##0.00;;Zero',fVal));
  Readln;
end.


note
	description : "{
2 Examples are given.
The first example uses the standard library's FORMAT_DOUBLE class.
The second example uses the AEL_PRINTF class from the freely available
Amalasoft Eiffel Library (AEL).

See additional comments in the code.
}"

class APPLICATION

inherit
	AEL_PRINTF -- Optional, see below

create
	make

feature {NONE} -- Initialization

	make
			-- Run application.
		do
			print_formatted_std (7.125)
			print_formatted_ael (7.125)
		end

	--|--------------------------------------------------------------

	print_formatted_std (v: REAL_64)
			-- Print the value 'v' as a zero-padded string in a fixed
			-- overall width of 9 places and, with a precision of
			-- to 3 places to the right of the decimal point.
			-- Use the FORMAT_DOUBLE class from the standard library
		local
			fmt: FORMAT_DOUBLE
		do
			create fmt.make (9, 3)
			fmt.zero_fill
			print (fmt.formatted (v) + "%N")
		end

	--|--------------------------------------------------------------

	print_formatted_ael (v: REAL_64)
			-- Print the value 'v' as a zero-padded string in a fixed
			-- overall width of 9 places and, with a precision of
			-- to 3 places to the right of the decimal point.
			-- Use the AEL_PRINTF class from the Amalasoft Eiffel Library
			-- freely available from www.amalasoft.com
		do
			-- printf accepts a format string and an argument list
			-- The argument list is a container (often a manifest
			-- array) of values corresponding to the type of the format
			-- specified in the format string argument.
			-- When only one argument is needed, then there is also the
			-- option to use just the value, without the container.
			-- In this example, the line would be:
			--   printf ("%%09.3f%N", v)
			-- The more deliberate form is used in the actual example,
			-- as it is more representative of common usage, when there
			-- are multiple value arguments.

			printf ("%%09.3f%N", << v >>)
		end

end


function XOR(%a, %b)
{
	return (!%a && %b) || (%a && !%b);
}

//Seperated by space
function HalfAdd(%a, %b)
{
	return XOR(%a, %b) SPC %a && %b;
}

//First word is the carry bit
function FullAdd(%a, %b, %c0)
{
	%r1 = HalfAdd(%a, %c0);
	%r2 = HalfAdd(getWord(%r1, 0), %b);
	%r3 = getWord(%r1, 1) || getWord(%r2, 1);
	return %r3 SPC getWord(%r2, 0);
}

//Outputs each bit seperated by a space.
function FourBitFullAdd(%a0, %a1, %a2, %a3, %b0, %b1, %b2, %b3)
{
	%r0 = FullAdd(%a0, %b0, 0);
	%r1 = FullAdd(%a1, %b1, getWord(%r0, 0));
	%r2 = FullAdd(%a2, %b2, getWord(%r1, 0));
	%r3 = FullAdd(%a3, %b3, getWord(%r2, 0));
	return getWord(%r0,1) SPC getWord(%r1,1) SPC getWord(%r2,1) SPC getWord(%r3,1) SPC getWord(%r3,0);
}


xor() {
  typeset -i a=$1 b=$2
  printf '%d\n' $(( (a || b)  && ! (a && b) ))
}

half_adder() {
  typeset -i a=$1 b=$2
  printf '%d %d\n' $(xor $a $b) $(( a && b ))
}

full_adder() {
  typeset -i a=$1 b=$2 c=$3
  typeset -i ha0_s ha0_c ha1_s ha1_c
  read ha0_s ha0_c < <(half_adder "$c" "$a")
  read ha1_s ha1_c < <(half_adder "$ha0_s" "$b")
  printf '%d %d\n' "$ha1_s" "$(( ha0_c || ha1_c ))"
}

four_bit_addr() {
  typeset -i a0=$1 a1=$2 a2=$3 a3=$4 b0=$5 b1=$6 b2=$7 b3=$8
  typeset -i fa0_s fa0_c fa1_s fa1_c fa2_s fa2_c fa3_s fa3_c
  read fa0_s fa0_c < <(full_adder "$a0" "$b0" 0)
  read fa1_s fa1_c < <(full_adder "$a1" "$b1" "$fa0_c")
  read fa2_s fa2_c < <(full_adder "$a2" "$b2" "$fa1_c")
  read fa3_s fa3_c < <(full_adder "$a3" "$b3" "$fa2_c")
  printf '%s' "$fa0_s"
  printf ' %s' "$fa1_s" "$fa2_s" "$fa3_s" "$fa3_c"
  printf '\n'
}

is() {
  typeset label=$1
  shift
  if eval "$*"; then
    printf 'ok'
  else
    printf 'not ok'
  fi
  printf ' %s\n' "$label"
}

is "1 + 1 =  2"       "[[ '$(four_bit_addr 1 0 0 0 1 0 0 0)' == '0 1 0 0 0' ]]"
is "5 + 5 = 10"       "[[ '$(four_bit_addr 1 0 1 0 1 0 1 0)' == '0 1 0 1 0' ]]"
is "7 + 9 = overflow" "a=($(four_bit_addr 1 0 0 1 1 1 1 0)); (( \${a[-1]}==1 ))"


PROGRAM FORMATTED

PROCEDURE FORMATTED_PRINT(N,LENGTH,DEC_PLACES->FP$)

    LOCAL I,C$,NN$

    FORMAT$=STRING$(LENGTH,"#")+"."

    FOR I=1 TO DEC_PLACES DO
       FORMAT$=FORMAT$+"#"
    END FOR

    OPEN("O",1,"FORMAT.$$$")
       WRITE(#1,FORMAT$;N)
    CLOSE(1)

    OPEN("I",1,"FORMAT.$$$")
       INPUT(LINE,#1,N$)
    CLOSE(1)

    ! add leading zeros
    FOR I=1 TO LEN(N$) DO
       C$=MID$(N$,I,1)
       IF C$=" " OR C$="%" THEN NN$=NN$+"0" ELSE NN$=NN$+C$
    END FOR

    FP$=RIGHT$("000000000000"+NN$,LENGTH) ! chop to required length

END PROCEDURE

BEGIN

   PRINT(CHR$(12);) ! CLS

   FOR I=1 TO 10 DO
     N=RND(1)*10^(INT(10*RND(1))-2)
     FORMATTED_PRINT(N,16,5->FP$)
     PRINT("Raw number =";N;TAB(30);"Using custom function =";FP$)
   END FOR

END PROGRAM


module Half_Adder( output c, s, input a, b );
  xor xor01 (s, a, b);
  and and01 (c, a, b);
endmodule // Half_Adder

module Full_Adder( output c_out, s, input a, b, c_in );

  wire s_ha1, c_ha1, c_ha2;

  Half_Adder ha01( c_ha1, s_ha1, a, b );
  Half_Adder ha02( c_ha2, s, s_ha1, c_in );
  or or01 ( c_out, c_ha1, c_ha2 );

endmodule // Full_Adder

module Full_Adder4( output [4:0] s, input [3:0] a, b, input c_in );

  wire [4:0] c;

  Full_Adder adder00 ( c[1], s[0], a[0], b[0], c_in );
  Full_Adder adder01 ( c[2], s[1], a[1], b[1], c[1] );
  Full_Adder adder02 ( c[3], s[2], a[2], b[2], c[2] );
  Full_Adder adder03 ( c[4], s[3], a[3], b[3], c[3] );

  assign s[4] = c[4];

endmodule // Full_Adder4

module test_Full_Adder();

  reg  [3:0] a;
  reg  [3:0] b;
  wire [4:0] s;

  Full_Adder4 FA4 ( s, a, b, 0 );

  initial begin
    $display( "   a +    b =     s" );
    $monitor( "%4d + %4d = %5d", a, b, s );
     a=4'b0000; b=4'b0000;
  #1 a=4'b0000; b=4'b0001;
  #1 a=4'b0001; b=4'b0001;
  #1 a=4'b0011; b=4'b0001;
  #1 a=4'b0111; b=4'b0001;
  #1 a=4'b1111; b=4'b0001;
  end

endmodule // test_Full_Adder


class Main
{
  public static Void main()
  {
    echo (7.125.toStr.padl(9, '0'))
  }
}


\ format 'n' digits of the double word 'd'
: #n ( d n -- d )  0 ?do # loop ;

\ ud.0 prints an unsigned double
: ud.0 ( d n -- )  <# 1- #n #s #> type ;

\ d.0 prints a signed double
: d.0 ( d n -- )  >r tuck dabs <# r> 1- #n #s rot sign #> type ;


INTEGER :: number = 7125
WRITE(*,"(I8.8)") number   ! Prints 00007125


LIBRARY ieee;
USE ieee.std_logic_1164.all;

entity four_bit_adder is
   port(
      a : in     std_logic_vector (3 downto 0);
      b : in     std_logic_vector (3 downto 0);
      s : out    std_logic_vector (3 downto 0);
      v : out    std_logic
   );
end four_bit_adder ;

LIBRARY ieee;
USE ieee.std_logic_1164.all;

entity fa is
   port(
      a  : in     std_logic;
      b  : in     std_logic;
      ci : in     std_logic;
      co : out    std_logic;
      s  : out    std_logic
   );
end fa ;

LIBRARY ieee;
USE ieee.std_logic_1164.all;

entity ha is
   port(
      a : in     std_logic;
      b : in     std_logic;
      c : out    std_logic;
      s : out    std_logic
   );
end ha ;

LIBRARY ieee;
USE ieee.std_logic_1164.all;

entity xor_gate is
   port(
      a : in     std_logic;
      b : in     std_logic;
      x : out    std_logic
   );
end xor_gate ;

architecture struct of four_bit_adder is
   signal ci0 : std_logic;
   signal co0 : std_logic;
   signal co1 : std_logic;
   signal co2 : std_logic;

   component fa
   port (
      a  : in     std_logic ;
      b  : in     std_logic ;
      ci : in     std_logic ;
      co : out    std_logic ;
      s  : out    std_logic
   );
   end component;
begin
   ci0 <= '0';

   i_fa0 : fa
      port map (
         a  => a(0),
         b  => b(0),
         ci => ci0,
         co => co0,
         s  => s(0)
      );
   i_fa1 : fa
      port map (
         a  => a(1),
         b  => b(1),
         ci => co0,
         co => co1,
         s  => s(1)
      );
   i_fa2 : fa
      port map (
         a  => a(2),
         b  => b(2),
         ci => co1,
         co => co2,
         s  => s(2)
      );
   i_fa3 : fa
      port map (
         a  => a(3),
         b  => b(3),
         ci => co2,
         co => v,
         s  => s(3)
      );

end struct;

architecture struct of fa is
   signal c1 : std_logic;
   signal c2 : std_logic;
   signal s1 : std_logic;

   component ha
   port (
      a : in     std_logic ;
      b : in     std_logic ;
      c : out    std_logic ;
      s : out    std_logic
   );
   end component;
begin
   co <= c1 or c2;

   i_ha0 : ha
      port map (
         a => ci,
         b => a,
         c => c1,
         s => s1
      );
   i_ha1 : ha
      port map (
         a => s1,
         b => b,
         c => c2,
         s => s
      );
end struct;

architecture struct of ha is
   component xor_gate
   port (
      a : in     std_logic;
      b : in     std_logic;
      x : out    std_logic
   );
   end component;
begin
   c <= a and b;

   i_xor_gate : xor_gate
      port map (
         a => a,
         b => b,
         x => s
      );
end struct;

architecture rtl of xor_gate is
begin
  x <= (a and not b) or (b and not a);
end architecture rtl;


' FB 1.05.0 Win64

#Include "vbcompat.bi"

Dim s As String  = Format(7.125, "00000.0##")
Print s
Sleep


window 1, @"Formatted Numeric Output", (0,0,480,270)

print using "0000#.###";7.125

HandleEvents


Public Sub Main()

Print Format("7.125", "00000.000")

End


var xor = Fn.new { |a, b| a&(~b) | b&(~a) }

var ha = Fn.new { |a, b| [xor.call(a, b), a & b] }

var fa = Fn.new { |a, b, c0|
    var res = ha.call(a, c0)
    var sa = res[0]
    var ca = res[1]
    res = ha.call(sa, b)
    return [res[0], ca | res[1]]
}

var add4 = Fn.new { |a3, a2, a1, a0, b3, b2, b1, b0|
    var res = fa.call(a0, b0, 0)
    var s0 = res[0]
    var c0 = res[1]
    res = fa.call(a1, b1, c0)
    var s1 = res[0]
    var c1 = res[1]
    res = fa.call(a2, b2, c1)
    var s2 = res[0]
    var c2 = res[1]
    res = fa.call(a3, b3, c2)
    return [res[1], res[0], s2, s1, s0]
}

System.print(add4.call(1, 0, 1, 0, 1, 0, 0, 1))


import Text.Printf
main =
  printf "%09.3f" 7.125


fcn xor(a,b) // a,b are 1|0 -->a^b(1|0)
   { a.bitAnd(b.bitNot()).bitOr(b.bitAnd(a.bitNot())) }

fcn halfAdder(a,b) // -->(carry, a+b) (1|0)
   { return(a.bitAnd(b), xor(a,b)) }

fcn fullBitAdder(c, a,b){ //-->(carry, a+b+c), a,b,c are 1|0
   c1,s := halfAdder(a,c);
   c2,s := halfAdder(s,b);
   c3   := c1.bitOr(c2);
   return(c3,s);
}

   // big endian
fcn fourBitAdder(a3,a2,a1,a0, b3,b2,b1,b0){ //-->(carry, s3,s2,s1,s0)
   c,s0 := fullBitAdder(0, a0,b0);
   c,s1 := fullBitAdder(c, a1,b1);
   c,s2 := fullBitAdder(c, a2,b2);
   c,s3 := fullBitAdder(c, a3,b3);
   return(c, s3,s2,s1,s0);
}

// add(10,9)  result should be 1 0 0 1 1 (0x13, 3 carry 1)
println(fourBitAdder(1,0,1,0, 1,0,0,1));


fun format n length
  let n tostr n
  while len n < length
    let n 0 + n
  endwhile
  println n
endfun

format 7.125 9


concept FixedLengthFormat(value, length) {
	string = text(abs(value))
	prefix = ""
	sign = ""

	if value < 0
		sign = "-"
	end

	if #string < length
		prefix = "0"*(length-#sign-#string-#prefix)
	end

	return sign+prefix+string
}

software {
	d = 7.125
	print(FixedLengthFormat(d, 9))
	print(FixedLengthFormat(-d, 9))
}


link printf

procedure main()

every  r := &pi | -r | 100-r do {
  write(r," <=== no printf")
  every p := "|%r|" | "|%9.3r|" | "|%-9.3r|" | "|%0.3r|" | "|%e|" | "|%d|" do
     write(sprintf(p,r)," <=== sprintf ",p)
}
end


public class Printing{
	public static void main(String[] args){
		double value = 7.125;
		System.out.printf("%09.3f",value); // System.out.format works the same way
		System.out.println(String.format("%09.3f",value));
	}
}


def pp0(width):
  tostring
  | if width > length then (width - length) * "0" + . else . end;

# pp(left; right) formats a decimal number to occupy
# (left+right+1) positions if possible,
# where "left" is the number of characters to the left of
# the decimal point, and similarly for "right".
def pp(left; right):
  def lpad: if (left > length) then ((left - length) * "0") + . else . end;
  tostring as $s
  | $s
  | index(".") as $ix
  | ((if $ix then $s[0:$ix] else $s end) | lpad) + "." +
    (if $ix then $s[$ix+1:] | .[0:right] else "" end);


using Printf
test = [7.125, [rand()*10^rand(0:4) for i in 1:9]]

println("Formatting some numbers with the @sprintf macro (using \"%09.3f\"):")
for i in test
    println(@sprintf "    %09.3f" i)
end

using Formatting
println()
println("The same thing using the Formatting package:")
fe = FormatExpr("    {1:09.3f}")
for i in test
    printfmtln(fe, i)
end


// version 1.0.5-2

fun main(args: Array<String>) {
    val num = 7.125
    println("%09.3f".format(num))
}


7.125 -> asstring(-precision = 3, -padding = 9, -padchar = '0')


for i =1 to 10
    n =rnd( 1) *10^( int( 10 *rnd(1)) -2)
    print "Raw number ="; n; "Using custom function ="; FormattedPrint$( n, 16, 5)
next i
end

function FormattedPrint$( n, length, decPlaces)
    format$ ="#."
    for i =1 to decPlaces
        format$ =format$ +"#"
    next i

    n$ =using( format$, n)            '   remove leading spaces if less than 3 figs left of decimal
                                        '   add leading zeros
    for i =1 to len( n$)
        c$ =mid$( n$, i, 1)
        if c$ =" " or c$ ="%" then nn$ =nn$ +"0" else nn$ =nn$ +c$
    next i
    FormattedPrint$ =right$( "000000000000" +nn$, length) '   chop to required length
end function


to zpad :num :width :precision
  output map [ifelse ? = "| | ["0] [?]] form :num :width :precision
end
print zpad 7.125 9 3  ; 00007.125


function digits(n) return math.floor(math.log(n) / math.log(10))+1 end
function fixedprint(num, digs) --digs = number of digits before decimal point
  for i = 1, digs - digits(num) do
    io.write"0"
  end
  print(num)
end

fixedprint(7.125, 5) --> 00007.125


:- module formatted_numeric_output.
:- interface.
:- import_module io.

:- pred main(io::di, io::uo) is det.

:- implementation.
:- import_module list, string.

main(!IO) :-
    io.format("%09.3f\n", [f(7.125)], !IO).


(quote cons "" join) :str-append
(pick length - repeat swap str-append) :left-pad

7.125 string "0" 9 left-pad puts!


printer = 7.125
println format("%09.3f", printer)


/* NetRexx */

options replace format comments java crossref savelog symbols binary

import java.text.MessageFormat

sevenPointOneTwoFive = double 7.125

-- using NetRexx Built-In Functions (BIFs)
say Rexx(sevenPointOneTwoFive).format(5, 3).changestr(' ', '0')

-- using Java library constructs
System.out.printf('%09.3f\n', [Double(sevenPointOneTwoFive)])
say MessageFormat.format('{0,number,#00000.###}', [Double(sevenPointOneTwoFive)])

return


import strformat
const r = 7.125
echo r
echo fmt"{-r:9.3f}"
echo fmt"{r:9.3f}"
echo fmt"{-r:09.3f}"
echo fmt"{r:09.3f}"


MESSAGE
   STRING( 7.125, "99999.999" )
VIEW-AS ALERT-BOX.


declare
  fun {PrintFloat X Prec}
     {Property.put 'print.floatPrecision' Prec}
     S = {Float.toString X}
  in
     {Append
      for I in 1..Prec-{Length S}+1 collect:C do {C &0} end
      S}
  end
in
  {System.showInfo {PrintFloat 7.125 8}}


procedure writeInFixedFormat(n: real);
const
	wholeNumberPlaces = 5;
	fractionalPlaces = 3;
	zeroDigit = '0';
	negative = '-';
var
	signPresent: boolean;
	i: integer;
begin
	// NOTE: This does not catch “negative” zero.
	signPresent := n < 0.0;
	if signPresent then
	begin
		write(negative);
		n := abs(n);
	end;

	// determine number of leading zeros
	i := wholeNumberPlaces;
	if n > 0 then
	begin
		i := i - trunc(ln(n) / ln(10));
	end;

	for i := i - 1 downto succ(ord(signPresent)) do
	begin
		write(zeroDigit);
	end;

	// writes n with
	// - at least 0 characters in total
	// - exactly fractionalPlaces post-radix digits
	// rounded
	write(n:0:fractionalPlaces);
end;


echo str_pad(7.125, 9, '0', STR_PAD_LEFT);


(pad 9 (format 7125 3))
(pad 9 (format 7125 3 ","))  # European format


put edit (X) (p'999999.V999'); /* Western format. */

put edit (X) (p'999999,V999'); /* In European format. */


-> (displayln (~a 7.125 #:width 9 #:align 'right #:pad-string "0"))
00007.125


rebol [
	Title: "Formatted Numeric Output"
	URL: http://rosettacode.org/wiki/Formatted_Numeric_Output
]

; REBOL has no built-in facilities for printing pictured output.
; However, it's not too hard to cook something up using the
; string manipulation facilities.

zeropad: func [
	"Pad number with zeros or spaces. Works on entire number."
	pad "Number of characters to pad to."
	n "Number to pad."
	/space "Pad with spaces instead."
	/local nn c s
][
	n: to-string n  c: " "  s: ""

	if not space [
		c: "0"
		if #"-" = n/1 [pad: pad - 1  n: copy skip n 1  s: "-"]
	]

        insert/dup n c (pad - length? n)
	insert n s
    n
]

; These tests replicate the C example output.

print [zeropad/space 9 negate 7.125]
print [zeropad/space 9 7.125]
print 7.125
print [zeropad 9 negate 7.125]
print [zeropad 9 7.125]
print 7.125


/*REXX program shows various ways to  add leading zeroes  to numbers.   */
a=7.125
b=translate(format(a,10),0,' ')
say 'a=' a
say 'b=' b
say

c=8.37
d=right(c,20,0)
say 'c=' c
say 'd=' d
say

e=19.46
f='000000'e
say 'e=' e
say 'f=' f
say

g=18.25e+1
h=000000||g
say 'g=' g
say 'h=' h
say

i=45.2
j=translate('      'i,0," ")
say 'i=' i
say 'j=' j
say

k=36.007
l=insert(00000000,k,0)
say 'k=' k
say 'l=' l
say

m=.10055
n=copies(0,20)m
say 'm=' m
say 'n=' n
say

p=4.060
q=0000000000000||p
say 'p=' p
say 'q=' q
say

r=876
s=substr(r+10000000,2)
say 'r=' r
say 's=' s
say

t=13.02
u=reverse(reverse(t)000000000)
say 't=' t
say 'u=' u
                                      /*stick a fork in it, we're done.*/


decimals(3)
see fixedprint(7.125, 5) + nl

func fixedprint num, digs
     for i = 1 to digs - len(string(floor(num)))
         see "0"
     next
     see num + nl


$ include "seed7_05.s7i";
  include "float.s7i";

const proc: main is func
  local
    const float: r is 7.125;
  begin
    writeln( r digits 3 lpad 9);
    writeln(-r digits 3 lpad 9);
    writeln( r digits 3 lpad0 9);
    writeln(-r digits 3 lpad0 9);
    writeln( r digits 3);
    writeln(-r digits 3);
  end func;


Transcript show: (7.125 printPaddedWith: $0 to: 3.6); cr.
"output: 007.125000"


DECLARE @n INT
SELECT @n=123
SELECT SUBSTRING(CONVERT(CHAR(5), 10000+@n),2,4) AS FourDigits

SET @n=5
print "TwoDigits: " + SUBSTRING(CONVERT(CHAR(3), 100+@n),2,2)
--Output: 05


print (StringCvt.padLeft #"0" 9 (Real.fmt (StringCvt.FIX (SOME 3)) 7.125) ^ "\n")


set number 7.342
format "%08.3f" $number


needs values
value n
123 to n

2 import printf
" %08d" n printf


#import flo

x = 7.125

#show+

t = <printf/'%09.3f' x>


Option Explicit

Sub Main()
Debug.Print fFormat(13, 2, 1230.3333)
Debug.Print fFormat(2, 13, 1230.3333)
Debug.Print fFormat(10, 5, 0.3333)
Debug.Print fFormat(13, 2, 1230)
End Sub

Private Function fFormat(NbInt As Integer, NbDec As Integer, Nb As Double) As String
'NbInt : Lenght of integral part
'NbDec : Lenght of decimal part
'Nb : decimal on integer number
Dim u As String, v As String, i As Integer
   u = CStr(Nb)
   i = InStr(u, Application.DecimalSeparator)
   If i > 0 Then
      v = Mid(u, i + 1)
      u = Left(u, i - 1)
      fFormat = Right(String(NbInt, "0") & u, NbInt) & Application.DecimalSeparator & Left(v & String(NbDec, "0"), NbDec)
   Else
      fFormat = Right(String(NbInt, "0") & u, NbInt) & Application.DecimalSeparator & String(NbDec, "0")
   End If
End Function


a = 1234.5678

' Round to three decimal places. Groups by default. Output = "1,234.568".
WScript.Echo FormatNumber(a, 3)

' Truncate to three decimal places. Output = "1234.567".
WScript.Echo Left(a, InStr(a, ".") + 3)

' Round to a whole number. Grouping disabled. Output = "1235".
WScript.Echo FormatNumber(a, 0, , , False)

' Use integer portion only and pad with zeroes to fill 8 chars. Output = "00001234".
WScript.Echo Right("00000000" & Int(a), 8)


#1 = 7125
Num_Ins(#1, FILL+COUNT, 9) Char(-3) Ins_Char('.')


import "/fmt" for Fmt

var n = 7.125
System.print(Fmt.rjust(9, n, "0"))


int C;
[Format(5, 3);                  \5 places before decimal point and 3 after
RlOut(8, 7.125);                \output real number to internal buffer
loop    [C:= ChIn(8);           \read character from internal buffer
        if C = ^  then C:= ^0;  \change leading space characters to zeros
        if C = $1A then quit;   \exit loop on end-of-file (EOF = end of chars)
        ChOut(0, C);            \display digit character on terminal
        ];
]


10 LET n=7.125
20 LET width=9
30 GO SUB 1000
40 PRINT AT 10,10;n$
50 STOP
1000 REM Formatted fixed-length
1010 LET n$=STR$ n
1020 FOR i=1 TO width-LEN n$
1030 LET n$="0"+n$
1040 NEXT i
1050 RETURN


with Generic_Rational;

generic
   with package Rational_Numbers is new Generic_Rational (<>);
package Generic_Taylor_Series is
   use Rational_Numbers;
   type Taylor_Series is array (Natural range <>) of Rational;

   function "+" (A : Taylor_Series) return Taylor_Series;
   function "-" (A : Taylor_Series) return Taylor_Series;

   function "+" (A, B : Taylor_Series) return Taylor_Series;
   function "-" (A, B : Taylor_Series) return Taylor_Series;
   function "*" (A, B : Taylor_Series) return Taylor_Series;

   function Integral (A : Taylor_Series) return Taylor_Series;
   function Differential (A : Taylor_Series) return Taylor_Series;

   function Value (A : Taylor_Series; X : Rational) return Rational;

   Zero : constant Taylor_Series := (0 => Rational_Numbers.Zero);
   One  : constant Taylor_Series := (0 => Rational_Numbers.One);
end Generic_Taylor_Series;


#include <stdio.h>
#include <stdlib.h>
#include <math.h> /* for NaN */

enum fps_type {
        FPS_CONST = 0,
        FPS_ADD,
        FPS_SUB,
        FPS_MUL,
        FPS_DIV,
        FPS_DERIV,
        FPS_INT,
};

typedef struct fps_t *fps;
typedef struct fps_t {
        int type;
        fps s1, s2;
        double a0;
} fps_t;

fps fps_new()
{
        fps x = malloc(sizeof(fps_t));
        x->a0 = 0;
        x->s1 = x->s2 = 0;
        x->type = 0;
        return x;
}

/* language limit of C; when self or mutual recursive definition is needed,
 * one has to be defined, then defined again after it's used.  See how
 * sin and cos are defined this way below
 */
void fps_redefine(fps x, int op, fps y, fps z)
{
        x->type = op;
        x->s1 = y;
        x->s2 = z;
}

fps _binary(fps x, fps y, int op)
{
        fps s = fps_new();
        s->s1 = x;
        s->s2 = y;
        s->type = op;
        return s;
}

fps _unary(fps x, int op)
{
        fps s = fps_new();
        s->s1 = x;
        s->type = op;
        return s;
}

/* Taking the n-th term of series.  This is where actual work is done. */
double term(fps x, int n)
{
        double ret = 0;
        int i;

        switch (x->type) {
        case FPS_CONST: return n > 0 ? 0 : x->a0;
        case FPS_ADD:
                ret = term(x->s1, n) + term(x->s2, n); break;

        case FPS_SUB:
                ret = term(x->s1, n) - term(x->s2, n); break;

        case FPS_MUL:
                for (i = 0; i <= n; i++)
                        ret += term(x->s1, i) * term(x->s2, n - i);
                break;

        case FPS_DIV:
                if (! term(x->s2, 0)) return NAN;

                ret = term(x->s1, n);
                for (i = 1; i <= n; i++)
                        ret -= term(x->s2, i) * term(x, n - i) / term(x->s2, 0);
                break;

        case FPS_DERIV:
                ret = n * term(x->s1, n + 1);
                break;

        case FPS_INT:
                if (!n) return x->a0;
                ret = term(x->s1, n - 1) / n;
                break;

        default:
                fprintf(stderr, "Unknown operator %d\n", x->type);
                exit(1);
        }

        return ret;
}

#define _add(x, y) _binary(x, y, FPS_ADD)
#define _sub(x, y) _binary(x, y, FPS_SUB)
#define _mul(x, y) _binary(x, y, FPS_MUL)
#define _div(x, y) _binary(x, y, FPS_DIV)
#define _integ(x)  _unary(x, FPS_INT)
#define _deriv(x)  _unary(x, FPS_DERIV)

fps fps_const(double a0)
{
        fps x = fps_new();
        x->type = FPS_CONST;
        x->a0 = a0;
        return x;
}

int main()
{
        int i;
        fps one = fps_const(1);
        fps fcos = fps_new();           /* cosine */
        fps fsin = _integ(fcos);        /* sine */
        fps ftan = _div(fsin, fcos);    /* tangent */

        /* redefine cos to complete the mutual recursion; maybe it looks
         * better if I said
         *     *fcos = *( _sub(one, _integ(fsin)) );
         */
        fps_redefine(fcos, FPS_SUB, one, _integ(fsin));

        fps fexp = fps_const(1);        /* exponential */
        /* make exp recurse on self */
        fps_redefine(fexp, FPS_INT, fexp, 0);

        printf("Sin:");   for (i = 0; i < 10; i++) printf(" %g", term(fsin, i));
        printf("\nCos:"); for (i = 0; i < 10; i++) printf(" %g", term(fcos, i));
        printf("\nTan:"); for (i = 0; i < 10; i++) printf(" %g", term(ftan, i));
        printf("\nExp:"); for (i = 0; i < 10; i++) printf(" %g", term(fexp, i));

        return 0;
}


(defn ps+ [ps0 ps1]
  (letfn [(+zs   [ps] (concat ps (repeat :z)))
          (notz? [a] (not= :z a))
          (nval  [a] (if (notz? a) a 0))
          (z+    [a0 a1] (if (= :z a0 a1) :z (+ (nval a0) (nval a1))))]
    (take-while notz? (map z+ (+zs ps0) (+zs ps1)))))

(defn ps- [ps0 ps1] (ps+ ps0 (map - ps1)))


(defpackage #:formal-power-series
  (:nicknames #:fps)
  (:use "COMMON-LISP")
  (:shadow
   #:+ #:- #:* #:/))

(in-package #:formal-power-series)


(require 'math)
;; converts a finite polynomial (a_0 a_1 .. a_n) to an infinite serie (a_0 ..a_n 0 0 0 ...)
(define (poly->stream list)
	(make-stream (lambda(n) (cons (if (< n (length list)) (list-ref list n) 0) (1+ n))) 0))

;; c = a + b , c_n = a_n + b_n
(define (s-add a b)
	(make-stream (lambda (n) (cons (+ (stream-ref a n) (stream-ref b n)) (1+ n))) 0))

;; c = a * b , c_n = ∑ (0 ..n) a_i * b_n-i
(define (s-mul-coeff n a b) (sigma (lambda(i) (* (stream-ref a i)(stream-ref b (- n i)))) 0 n))

(define (s-mul a b)
	(make-stream (lambda(n) (cons (s-mul-coeff n a b) (1+ n))) 0))

;; b = 1/a ; b_0 = 1/a_0, b_n =  - ∑ (1..n) a_i * b_n-i / a_0
(define (s-inv-coeff n a b)
			(if (zero? n) (/ (stream-ref a 0))
			(- (/ (sigma (lambda(i) (* (stream-ref a i)(stream-ref b (- n i)))) 1 n)
			 (stream-ref a 0)))))

;; note the self keyword which refers to b = (s-inv a)
(define (s-inv a)
	(make-stream (lambda(n) (cons (s-inv-coeff n a self ) (1+ n))) 0))

;; b = (s-k-add k a) = k + a_0, a_1, a_2, ...
(define (s-k-add k a)
	(make-stream (lambda(n) (cons
	(if(zero? n) (+ k (stream-ref a 0)) (stream-ref a n)) (1+ n))) 0))

;; b = (s-neg a) = -a_0,-a_1, ....
(define (s-neg a)
	(make-stream (lambda(n) (cons (- (stream-ref a n)) (1+ n))) 0))

;; b = (s-int a) = ∫ a ; b_0 = 0 by convention, b_n = a_n-1/n
(define (s-int a)
	(make-stream (lambda(n) (cons (if (zero? n) 0 (/ (stream-ref a (1- n)) n)) (1+ n))) 0))

;; value of power serie at x, n terms
(define (s-value a x (n 20))
	(poly x (take a n)))

;; stream-cons allows mutual delayed references
;; sin = ∫ cos
(define sin-x (stream-cons 0 (stream-rest (s-int cos-x))))
;; cos = 1 - ∫ sin
(define cos-x (stream-cons 1 (stream-rest (s-k-add 1  (s-neg (s-int sin-x))))))


component FormalPowerSeries(Number);
  type PowerSeries;
       PowerSeries(Size = integer) -> PowerSeries;

       + PowerSeries -> PowerSeries;
       - PowerSeries -> PowerSeries;

       PowerSeries + PowerSeries -> PowerSeries;
       PowerSeries - PowerSeries -> PowerSeries;
       PowerSeries * PowerSeries -> PowerSeries;

       Integral(PowerSeries)     -> PowerSeries;
       Differential(PowerSeries) -> PowerSeries;

       Zero -> PowerSeries;
       One  -> PowerSeries;

       Array(PowerSeries) -> array(Number);
 begin
       PowerSeries(Size) = PowerSeries:[T = array(Number, Size); Size];

       + A = A;

       - A = [ C = PowerSeries(A.Size);
		       [ i = 1 .. A.Size; C.T[i] := - A.T[i] ];
		     C];

       A + B = [ if A.Size > B.Size then return(B + A);
		         C = PowerSeries(B.Size);
		         [ i = 1 .. A.Size; C.T[i] := A.T[i] + B.T[i] ];
		         [ i = (A.Size +1) .. B.Size;  C.T[i] := B.T[i] ];
		       C];

       A - B = A + (- B );

       A * B = [ C = PowerSeries(A.Size + B.Size - 1);
 	         [ i = 1 .. A.Size;
		     [j = 1.. B.Size;
		         C.T[i + j - 1] := C.T[i + j - 1] + A.T[i] * B.T[j] ] ];
	          C];

      Integral(A) = [ if A.Size == 0 then return (A);
 		      C = PowerSeries(A.Size + 1);
		      [ i = 1 .. A.Size; C.T[i +1] := A.T[i] / Number( i )];
		      C.T[1]:= Number(0);
		      C ];

      Differential(A) = [ if A.Size == 1 then return (A);
		          C = PowerSeries(A.Size - 1);
		          [ i = 1 .. C.Size; C.T[i] := A.T[i + 1] * Number( i )];
		          C ];

      Zero = [ C = PowerSeries (1); C.T[1]:= Number(0);  C];
      One =  [ C = PowerSeries (1); C.T[1]:= Number(1);  C];

      Array(PowerSeries) -> array(Number);
      Array(TS) = TS.T;

end component FormalPowerSeries;


package main

import (
    "fmt"
    "math"
)

// Task:  Formal power series type
//
// Go does not have a concept of numeric types other than the built in
// integers, floating points, and so on.  Nor does it have function or
// operator overloading, or operator defintion.  The type use to implement
// fps here is an interface with a single method, extract.
// While not named in the task description, extract is described in the
// WP article as "important."  In fact, by representing a way to index
// all of the coefficients of a fps, any type that implements the interface
// represents a formal power series.

type fps interface {
    extract(int) float64
}

// Task:  Operations on FPS
//
// Separate operations are implemented with separate extract methods.
// This requires each operation on the fps type to have a concrete type.
// Executing a fps operation is the act of instantiating the concrete type.
// This is implemented here with constructor functions that construct a
// new fps from fps arguments.

// Constructor functions are shown here as a group, followed by concrete
// type definitions and associated extract methods.

func one() fps {
    return &oneFps{}
}

func add(s1, s2 fps) fps {
    return &sum{s1: s1, s2: s2}
}

func sub(s1, s2 fps) fps {
    return &diff{s1: s1, s2: s2}
}

func mul(s1, s2 fps) fps {
    return &prod{s1: s1, s2: s2}
}

func div(s1, s2 fps) fps {
    return &quo{s1: s1, s2: s2}
}

func differentiate(s1 fps) fps {
    return &deriv{s1: s1}
}

func integrate(s1 fps) fps {
    return &integ{s1: s1}
}

// Example:  Mutually recursive defintion of sine and cosine.
// This is a constructor just as those above.  It is nullary and returns
// two fps.  Note sin and cos implemented as instances of other fps defined
// above, and so do not need new concrete types.  Note also the constant
// term of the integration fps provides the case that terminates recursion
// of the extract function.
func sinCos() (fps, fps) {
    sin := &integ{}
    cos := sub(one(), integrate(sin))
    sin.s1 = cos
    return sin, cos
}

// Following are type definitions and extract methods for fps operators
// (constructor functions) just defined.
//
// Goal:  lazy evaluation
//
// Go has no built in support for lazy evaluation, so we make it from
// scratch here.  Types contain, at a minimum, their fps operands and
// representation neccessary to implement lazy evaluation.  Typically
// this is a coefficient slice, although constant terms are not stored,
// so in the case of a constant fps, no slice is needed at all.
// Coefficients are generated only as they are requested.  Computed
// coefficients are stored in the slice and if requested subsequently,
// are returned immediately rather than recomputed.
//
// Types can also contain any other intermediate values useful for
// computing coefficients.

// Constant one:  A constant is a nullary function and no coefficent
// storage is needed so an empty struct is used for the type.
type oneFps struct{}

// The extract method implements the fps interface.  It simply has to
// return 1 for the first term and return 0 for all other terms.
func (*oneFps) extract(n int) float64 {
    if n == 0 {
        return 1
    }
    return 0
}

// Addition is a binary function so the sum type stores its two fps operands
// and its computed terms.
type sum struct {
    s      []float64
    s1, s2 fps
}

func (s *sum) extract(n int) float64 {
    for i := len(s.s); i <= n; i++ {
        s.s = append(s.s, s.s1.extract(i)+s.s2.extract(i))
    }
    return s.s[n]
}

// Subtraction and other binary operations are similar.
// (The common field definitions could be factored out with an embedded
// struct, but the clutter of the extra syntax required doesn't seem
// to be worthwhile.)
type diff struct {
    s      []float64
    s1, s2 fps
}

func (s *diff) extract(n int) float64 {
    for i := len(s.s); i <= n; i++ {
        s.s = append(s.s, s.s1.extract(i)-s.s2.extract(i))
    }
    return s.s[n]
}

type prod struct {
    s      []float64
    s1, s2 fps
}

func (s *prod) extract(n int) float64 {
    for i := len(s.s); i <= n; i++ {
        c := 0.
        for k := 0; k <= i; k++ {
            c += s.s1.extract(k) * s.s1.extract(n-k)
        }
        s.s = append(s.s, c)
    }
    return s.s[n]
}

// Note a couple of fields in addition to those of other binary operators.
// They simply optimize computations a bit.
type quo struct {
    s1, s2 fps
    inv    float64   // optimizes a divide
    c      []float64 // saves multiplications
    s      []float64
}

// WP formula.  Note the limitation s2[0] cannot be 0.  In this case
// the function returns NaN for all terms.  The switch statement catches
// this case and avoids storing a slice of all NaNs.
func (s *quo) extract(n int) float64 {
    switch {
    case len(s.s) > 0:
    case !math.IsInf(s.inv, 1):
        a0 := s.s2.extract(0)
        s.inv = 1 / a0
        if a0 != 0 {
            break
        }
        fallthrough
    default:
        return math.NaN()
    }
    for i := len(s.s); i <= n; i++ {
        c := 0.
        for k := 1; k <= i; k++ {
            c += s.s2.extract(k) * s.c[n-k]
        }
        c = s.s1.extract(i) - c*s.inv
        s.c = append(s.c, c)
        s.s = append(s.s, c*s.inv)
    }
    return s.s[n]
}

// Note differentiation and integration are unary so their types contain
// only a single fps operand.

type deriv struct {
    s   []float64
    s1  fps
}

func (s *deriv) extract(n int) float64 {
    for i := len(s.s); i <= n; {
        i++
        s.s = append(s.s, float64(i)*s.s1.extract(i))
    }
    return s.s[n]
}

type integ struct {
    s   []float64
    s1  fps
}

func (s *integ) extract(n int) float64 {
    if n == 0 {
        return 0 // constant term C=0
    }
    // with constant term handled, s starts at 1
    for i := len(s.s) + 1; i <= n; i++ {
        s.s = append(s.s, s.s1.extract(i-1)/float64(i))
    }
    return s.s[n-1]
}

// Demonstrate working sin, cos.
func main() {
    // Format several terms in a way that is easy to compare visually.
    partialSeries := func(f fps) (s string) {
        for i := 0; i < 6; i++ {
            s = fmt.Sprintf("%s %8.5f ", s, f.extract(i))
        }
        return
    }
    sin, cos := sinCos()
    fmt.Println("sin:", partialSeries(sin))
    fmt.Println("cos:", partialSeries(cos))
}


newtype Series a = S { coeffs :: [a] } deriving (Eq, Show)
-- Invariant: coeffs must be an infinite list

instance Num a => Num (Series a) where
  fromInteger n = S $ fromInteger n : repeat 0
  negate (S fs) = S $ map negate fs
  S fs + S gs   = S $ zipWith (+) fs gs
  S (f:ft) * S gs@(g:gt) = S $ f*g : coeffs (S ft * S gs + S (map (f*) gt))

instance Fractional a => Fractional (Series a) where
  fromRational n = S $ fromRational n : repeat 0
  S (f:ft) / S (g:gt) = S qs where qs = f/g : map (/g) (coeffs (S ft - S qs * S gt))

-- utility function to convert from a finite polynomial
fromFiniteList xs = S (xs ++ repeat 0)

int (S fs) = S $ 0 : zipWith (/) fs [1..]

diff (S (_:ft)) = S $ zipWith (*) ft [1..]

sinx,cosx :: Series Rational
sinx = int cosx
cosx = 1 - int sinx

fiboS = 1 / fromFiniteList [1,-1,-1]


Ai=: ([email protected]]  =/ [email protected][ -/ [email protected]>:@-)&#
divide=: [ +/ .*~ [:%.&.x: ] +/ .* Ai
diff=: 1 }. ] * [email protected]#
intg=: 0 ,  ] % 1 + [email protected]#
mult=: +//[email protected](*/)
plus=: +/@,:
minus=: -/@,:


module FormalPowerSeries

using Printf
import Base.iterate, Base.eltype, Base.one, Base.show, Base.IteratorSize
import Base.IteratorEltype, Base.length, Base.size, Base.convert

_div(a, b) = a / b
_div(a::Union{Integer,Rational}, b::Union{Integer,Rational}) = a // b

abstract type AbstractFPS{T<:Number} end

Base.IteratorSize(::AbstractFPS) = Base.IsInfinite()
Base.IteratorEltype(::AbstractFPS) = Base.HasEltype()
Base.eltype(::AbstractFPS{T}) where T = T
Base.one(::AbstractFPS{T}) where T = ConstantFPS(one(T))

function Base.show(io::IO, fps::AbstractFPS{T}) where T
    itr = Iterators.take(fps, 8)
    a, s = iterate(itr)
    print(io, a)
    a, s = iterate(itr, s)
    @printf(io, " %s %s⋅x",
        ifelse(sign(a) ≥ 0, '+', '-'), abs(a))
    local i = 2
    while (it = iterate(itr, s)) != nothing
        a, s = it
        @printf(io, " %s %s⋅x^%i",
            ifelse(sign(a) ≥ 0, '+', '-'), abs(a), i)
        i += 1
    end
    print(io, "...")
end

struct MinusFPS{T,A<:AbstractFPS{T}} <: AbstractFPS{T}
    a::A
end
Base.:-(a::AbstractFPS{T}) where T = MinusFPS{T,typeof(a)}(a)

function Base.iterate(fps::MinusFPS)
	v, s = iterate(fps.a)
	return -v, s
end
function Base.iterate(fps::MinusFPS, st)
    v, s = iterate(fps.a, st)
    return -v, s
end

struct SumFPS{T,A<:AbstractFPS,B<:AbstractFPS} <: AbstractFPS{T}
    a::A
    b::B
end
Base.:+(a::AbstractFPS{A}, b::AbstractFPS{B}) where {A,B} =
    SumFPS{promote_type(A, B),typeof(a),typeof(b)}(a, b)
Base.:-(a::AbstractFPS, b::AbstractFPS) = a + (-b)

function Base.iterate(fps::SumFPS{T,A,B}) where {T,A,B}
    a1, s1 = iterate(fps.a)
    a2, s2 = iterate(fps.b)
    return T(a1 + a2), (s1, s2)
end
function Base.iterate(fps::SumFPS{T,A,B}, st) where {T,A,B}
    stateA, stateB = st
    valueA, stateA = iterate(fps.a, stateA)
    valueB, stateB = iterate(fps.b, stateB)
    return T(valueA + valueB), (stateA, stateB)
end

struct ProductFPS{T,A<:AbstractFPS,B<:AbstractFPS} <: AbstractFPS{T}
    a::A
    b::B
end
Base.:*(a::AbstractFPS{A}, b::AbstractFPS{B}) where {A,B} =
    ProductFPS{promote_type(A, B),typeof(a),typeof(b)}(a, b)

function Base.iterate(fps::ProductFPS{T}) where T
    a1, s1 = iterate(fps.a)
    a2, s2 = iterate(fps.b)
    T(sum(a1 .* a2)), (s1, s2, T[a1], T[a2])
end
function Base.iterate(fps::ProductFPS{T,A,B}, st) where {T,A,B}
    stateA, stateB, listA, listB = st
    valueA, stateA = iterate(fps.a, stateA)
    valueB, stateB = iterate(fps.b, stateB)
    push!(listA, valueA)
    pushfirst!(listB, valueB)
    return T(sum(listA .* listB)), (stateA, stateB, listA, listB)
end

struct DifferentiatedFPS{T,A<:AbstractFPS} <: AbstractFPS{T}
    a::A
end
differentiate(fps::AbstractFPS{T}) where T = DifferentiatedFPS{T,typeof(fps)}(fps)

function Base.iterate(fps::DifferentiatedFPS{T,A}) where {T,A}
    _, s = iterate(fps.a)
    return Base.iterate(fps, (zero(T), s))
end
function Base.iterate(fps::DifferentiatedFPS{T,A}, st) where {T,A}
    n, s = st
    n += one(n)
    v, s = iterate(fps.a, s)
    return n * v, (n, s)
end

struct IntegratedFPS{T,A<:AbstractFPS} <: AbstractFPS{T}
    a::A
    k::T
end
integrate(fps::AbstractFPS{T}, k::T=zero(T)) where T = IntegratedFPS{T,typeof(fps)}(fps, k)
integrate(fps::AbstractFPS{T}, k::T=zero(T)) where T <: Integer =
    IntegratedFPS{Rational{T},typeof(fps)}(fps, k)

function Base.iterate(fps::IntegratedFPS{T,A}, st=(0, 0)) where {T,A}
	if st == (0, 0)
		return fps.k, (one(T), 0)
	end
    n, s = st
    if n == one(T)
		v, s = iterate(fps.a)
	else
		v, s = iterate(fps.a, s)
	end
    r::T = _div(v, n)
    n += one(n)
    return r, (n, s)
end

# Examples of FPS: constant

struct FiniteFPS{T} <: AbstractFPS{T}
    v::NTuple{N,T} where N
end
Base.iterate(fps::FiniteFPS{T}, st=1) where T =
    st > lastindex(fps.v) ? (zero(T), st) : (fps.v[st], st + 1)
Base.convert(::Type{FiniteFPS}, x::Real) = FiniteFPS{typeof(x)}((x,))
FiniteFPS(r) = convert(FiniteFPS, r)
for op in (:+, :-, :*)
    @eval Base.$op(x::Number, a::AbstractFPS) = $op(FiniteFPS(x), a)
    @eval Base.$op(a::AbstractFPS, x::Number) = $op(a, FiniteFPS(x))
end

struct ConstantFPS{T} <: AbstractFPS{T}
    k::T
end
Base.iterate(c::ConstantFPS, ::Any=nothing) = c.k, nothing

struct SineFPS{T} <: AbstractFPS{T} end
SineFPS() = SineFPS{Rational{Int}}()
function Base.iterate(::SineFPS{T}, st=(0, 1, 1)) where T
    n, fac, s = st
    local r::T
    if iseven(n)
        r = zero(T)
    else
        r = _div(one(T), (s * fac))
        s = -s
    end
    n += 1
    fac *= n
    return r, (n, fac, s)
end

struct CosineFPS{T} <: AbstractFPS{T} end
CosineFPS() = CosineFPS{Rational{Int}}()
function Base.iterate(::CosineFPS{T}, st=(0, 1, 1)) where T
    n, fac, s = st
    local r::T
    if iseven(n)
        r = _div(one(T), (s * fac))
    else
        r = zero(T)
        s = -s
    end
    n += 1
    fac *= n
    return r, (n, fac, s)
end

end  # module FormalPowerSeries


// version 1.2.10

fun gcd(a: Long, b: Long): Long = if (b == 0L) a else gcd(b, a % b)

class Frac : Comparable<Frac> {
    val num: Long
    val denom: Long

    companion object {
        val ZERO = Frac(0, 1)
        val ONE  = Frac(1, 1)
    }

    constructor(n: Long, d: Long) {
        require(d != 0L)
        var nn = n
        var dd = d
        if (nn == 0L) {
            dd = 1
        }
        else if (dd < 0) {
            nn = -nn
            dd = -dd
        }
        val g = Math.abs(gcd(nn, dd))
        if (g > 1) {
            nn /= g
            dd /= g
        }
        num = nn
        denom = dd
    }

    constructor(n: Int, d: Int) : this(n.toLong(), d.toLong())

    operator fun plus(other: Frac) =
        Frac(num * other.denom + denom * other.num, other.denom * denom)

    operator fun unaryPlus() = this

    operator fun unaryMinus() = Frac(-num, denom)

    operator fun minus(other: Frac) = this + (-other)

    operator fun times(other: Frac) =
        Frac(this.num * other.num, this.denom * other.denom)

    operator fun rem(other: Frac) = this - Frac((this / other).toLong(), 1) * other

    operator fun inc() = this + ONE
    operator fun dec() = this - ONE

    fun inverse(): Frac {
        require(num != 0L)
        return Frac(denom, num)
    }

    operator fun div(other: Frac) = this * other.inverse()

    fun abs() = if (num >= 0) this else -this

    override fun compareTo(other: Frac): Int {
        val diff = this.toDouble() - other.toDouble()
        return when {
            diff < 0.0  -> -1
            diff > 0.0  -> +1
            else        ->  0
        }
    }

    override fun equals(other: Any?): Boolean {
       if (other == null || other !is Frac) return false
       return this.compareTo(other) == 0
    }

    override fun hashCode() = num.hashCode() xor denom.hashCode()

    override fun toString() = if (denom == 1L) "$num" else "$num/$denom"

    fun toDouble() = num.toDouble() / denom

    fun toLong() = num / denom
}

interface Gene {
    fun coef(n: Int): Frac
}

class Term(private val gene: Gene) {
    private val cache = mutableListOf<Frac>()

    operator fun get(n: Int): Frac {
        if (n < 0) return Frac.ZERO
        if (n >= cache.size) {
            for (i in cache.size..n) cache.add(gene.coef(i))
        }
        return cache[n]
    }
}

class FormalPS {
    private lateinit var term: Term

    private companion object {
        const val DISP_TERM = 12
        const val X_VAR = "x"
    }

    constructor() {}

    constructor(term: Term) {
        this.term = term
    }

    constructor(polynomial: List<Frac>) :
        this(Term(object : Gene {
            override fun coef(n: Int) =
                if (n < 0 || n >= polynomial.size)
                    Frac.ZERO
                else
                    polynomial[n]
        }))

    fun copyFrom(other: FormalPS) {
        term = other.term
    }

    fun inverseCoef(n: Int): Frac {
        val res = Array(n + 1) { Frac.ZERO }
        res[0] = term[0].inverse()
        for (i in 1..n) {
            for (j in 0 until i) res[i] += term[i - j] * res[j]
            res[i] *= -res[0]
        }
        return res[n]
    }

    operator fun plus(other: FormalPS) =
        FormalPS(Term(object : Gene {
            override fun coef(n: Int) = term[n] + other.term[n]
        }))

    operator fun minus(other: FormalPS) =
        FormalPS(Term(object : Gene {
            override fun coef(n: Int) = term[n] - other.term[n]
        }))

    operator fun times(other: FormalPS) =
        FormalPS(Term(object : Gene {
            override fun coef(n: Int): Frac {
                var res = Frac.ZERO
                for (i in 0..n) res += term[i] * other.term[n - i]
                return res
            }
        }))

    operator fun div(other: FormalPS) =
        FormalPS(Term(object : Gene {
            override fun coef(n: Int): Frac {
                var res = Frac.ZERO
                for (i in 0..n) res += term[i] * other.inverseCoef(n - i)
                return res
            }
        }))

    fun diff() =
        FormalPS(Term(object : Gene {
            override fun coef(n: Int) = term[n + 1] * Frac(n + 1, 1)
        }))

    fun intg() =
        FormalPS(Term(object : Gene {
            override fun coef(n: Int) =
                if (n == 0) Frac.ZERO else term[n - 1] * Frac(1, n)
        }))

    override fun toString() = toString(DISP_TERM)

    private fun toString(dpTerm: Int): String {
        val sb = StringBuilder()
        var c = term[0]
        if (c != Frac.ZERO) sb.append(c.toString())
        for (i in 1 until dpTerm) {
            c = term[i]
            if (c != Frac.ZERO) {
                if (c > Frac.ZERO && sb.length > 0) sb.append(" + ")
                sb.append (when {
                    c == Frac.ONE  -> X_VAR
                    c == -Frac.ONE -> " - $X_VAR"
                    c.num < 0      -> " - ${-c}$X_VAR"
                    else           -> "$c$X_VAR"
                })
                if (i > 1) sb.append("^$i")
            }
        }
        if (sb.length == 0) sb.append("0")
        sb.append(" + ...")
        return sb.toString()
    }
}

fun main(args: Array<String>) {
    var cos = FormalPS()
    val sin = cos.intg()
    cos.copyFrom(FormalPS(listOf(Frac.ONE)) - sin.intg())
    println("SIN(x) = $sin")
    println("COS(x) = $cos")
}


powerseries = setmetatable({
__add = function(z1, z2) return powerseries(function(n) return z1.coeff(n) + z2.coeff(n) end) end,
__sub = function(z1, z2) return powerseries(function(n) return z1.coeff(n) - z2.coeff(n) end) end,
__mul = function(z1, z2) return powerseries(function(n)
  local ret = 0
  for i = 0, n do
    ret = ret + z1.coeff(i) * z2.coeff(n-i)
  end
  return ret
end) end,
__div = function(z1, z2) return powerseries(function(n)
  local ret = z1.coeff(n)
  local function coeffs(a)
    local c = z1.coeff(a)
	for j = 0, a - 1 do c = c - coeffs(j) * z2.coeff(a-j) end
	return c / z2.coeff(0)
  end
  for i = 0, n-1 do
    ret = ret - coeffs(i) * z2.coeff(n-i)
  end
  return ret / z2.coeff(0)
end) end,
__pow = function(z1, p) -- for a series z, z^n returns the nth derivative of z. negative values take integrals.
  if p == 0 then return z1
  elseif p > 0 then return powerseries(function(i) return z1.coeff(i+1)*(i+1) end)^(p-1)
  else return powerseries(function(i) return z1.coeff(i-1)/i end)^(p+1)
  end
end,
__unm = function(z1) return powerseries(function(n) return -z1.coeff(n) end) end,
__index = function(z, n) return z.coeff(n) end,
__call = function(z, n)
  local ret = 0
  for i = 0, 15 do --we do 20 terms, which is simpler than trying to check error bounds
    ret = ret + z[i]*(n^i)
  end
  return ret
end},
{__call = function(z, f) return setmetatable({coeff = f}, z) end})

cosine = powerseries(function(n)
  if(n == 0) then return 1
  else return -((sine^(-1))[n]) --defer to the integral of sine function
  end
end)

sine = powerseries(function(n)
  if(n == 0) then return 0
  else return (cosine^(-1))[n] --defer to the integral of cosine function
  end
end)

print(sine[1], sine[3], sine[5], sine[7], cosine[0], cosine[2], cosine[4], cosine[6])
print(sine(math.pi/3), sine(math.pi/2), cosine(math.pi/3), cosine(math.pi/2))

tangent = sine / cosine
print(tangent(math.pi/3), tangent(math.pi/4), tangent(math.pi/6)) --something like 30000 function calls!


cos = Series[Cos[x], {x, 0, 10}];
sin = Series[Sin[x], {x, 0, 8}];
sin - Integrate[cos, x]


package FPS;
use strict;
use warnings;
use Math::BigRat;

sub new {
   my $class = shift;
   return bless {@_}, $class unless @_ == 1;
   my $arg = shift;
   return bless { more => $arg }, $class if 'CODE' eq ref $arg;
   return bless { coeff => $arg }, $class if 'ARRAY' eq ref $arg;
   bless { coeff => [$arg] }, $class;
}

sub coeff {
   my ($self, $i) = @_;
   my $cache = ($self->{coeff} ||= []);
   my $more = $self->{more};
   for my $j ( @$cache .. $i ) {
      last unless $more;
      $cache->[$j] = $more->($j, $self);
   }
   $cache->[$i] or 0;
}

sub invert {
   my $orig = shift;
   ref($orig)->new( sub {
      my ($i, $self) = @_;
      unless( $i ) {
         my $a0 = $orig->coeff(0);
         die "Cannot invert power series with zero constant term."
            unless $a0;
         (Math::BigRat->new(1) / $a0);
      } else {
         my $sum = 0;
         my $terms = $self->{coeff};
         for my $j (1 .. $i) {
            $sum += $orig->coeff($j) * $terms->[$i - $j];
         }
         -$terms->[0] * $sum;
      }
   } );
}

sub fixargs {
   my ($x, $y, $swap) = @_;
   my $class = ref $x;
   $y = $class->new($y) unless UNIVERSAL::isa($y, $class);
   ($x, $y) = ($y, $x) if $swap;
   ($class, $x, $y);
}

use overload '+' => sub {
   my ($class, $x, $y) = &fixargs;
   $class->new( sub { $x->coeff($_[0]) + $y->coeff($_[0]) } );
}, '-' => sub {
   my ($class, $x, $y) = &fixargs;
   $class->new( sub { $x->coeff($_[0]) - $y->coeff($_[0]) } );
}, '*' => sub {
   my ($class, $x, $y) = &fixargs;
   $class->new( sub {
      my $i = shift;
      my $sum = 0;
      $sum += $x->coeff($_) * $y->coeff($i-$_) for 0..$i;
      $sum;
   } );
}, '/' => sub {
   my ($class, $x, $y) = &fixargs;
   $x * $y->invert;
}, '""' => sub {
   my $self = shift;
   my $str = $self->coeff(0);
   for my $i (1..10) {
      my $c = $self->coeff($i);
      next unless $c;
      $str .= ($c < 0) ? (" - " . (-$c)) : (" + ".$c);
      $str .= "x^$i";
   }
   $str;
};

sub differentiate {
   my $orig = shift;
   ref($orig)->new( sub {
      my $i = shift;
      ($i+1) * $orig->coeff($i);
   } );
}

sub integrate {
   my $orig = shift;
   ref($orig)->new( coeff => [0], more => sub {
      my $i = shift;
      $orig->coeff($i-1) / Math::BigRat->new($i);
   } );
}

my $sin = __PACKAGE__->new;
my $cos = 1 - $sin->integrate;
%$sin = %{$cos->integrate};
my $tan = $sin / $cos;
my $exp = __PACKAGE__->new();
%$exp = (%{$exp->integrate}, coeff => [1]);

print "sin(x) ~= $sin\n";
print "cos(x) ~= $cos\n";
print "tan(x) ~= $tan\n";
print "exp(x) ~= $exp\n";

print "sin^2 + cos^2 = ", $sin*$sin + $cos*$cos, "\n";

1;
__END__