import std.stdio, std.array, std.algorithm, std.exception, std.conv,
       std.concurrency, std.range;

struct Solution { uint pos, len; }

Generator!(Solution[]) nonoBlocks(in uint[] blocks, in uint cells) {
    return new typeof(return)({
        if (blocks.empty || blocks[0] == 0) {
            yield([Solution(0, 0)]);
        } else {
            enforce(blocks.sum + blocks.length - 1 <= cells,
                    "Those blocks cannot fit in those cells.");
            immutable firstBl = blocks[0];
            const restBl = blocks.dropOne;

            // The other blocks need space.
            immutable minS = restBl.map!(b => b + 1).sum;

            // Slide the start position from left to max RH
            // index allowing for other blocks.
            foreach (immutable bPos; 0 .. cells - minS - firstBl + 1) {
                if (restBl.empty) {
                    // No other blocks to the right so just yield
                    // this one.
                    yield([Solution(bPos, firstBl)]);
                } else {
                    // More blocks to the right so create a sub-problem
                    // of placing the restBl blocks in the cells one
                    // space to the right of the RHS of this block.
                    immutable offset = bPos + firstBl + 1;
                    immutable newCells = cells - offset;

                    // Recursive call to nonoBlocks yields multiple
                    // sub-positions.
                    foreach (const subPos; nonoBlocks(restBl, newCells)) {
                        // Remove the offset from sub block positions.
                        auto rest = subPos.map!(sol => Solution(offset + sol.pos, sol.len));

                        // Yield this block plus sub blocks positions.
                        yield(Solution(bPos, firstBl) ~ rest.array);
                    }
                }
            }
        }
    });
}

/// Pretty prints each run of blocks with a
/// different letter for each block of filled cells.
string show(in Solution[] vec, in uint nCells) pure {
    auto result = ['_'].replicate(nCells);
    foreach (immutable i, immutable sol; vec)
        foreach (immutable j; sol.pos .. sol.pos + sol.len)
            result[j] = (result[j] == '_') ? to!char('A' + i) : '?';
    return '[' ~ result ~ ']';
}

void main() {
    static struct Problem { uint[] blocks; uint nCells; }

    immutable Problem[] problems = [{[2, 1], 5},
                                    {[], 5},
                                    {[8], 10},
                                    {[2, 3, 2, 3], 15},
                                    {[4, 3], 10},
                                    {[2, 1], 5},
                                    {[3, 1], 10},
                                    {[2, 3], 5}];

    foreach (immutable prob; problems) {
        writefln("Configuration (%d cells and %s blocks):",
                 prob.nCells, prob.blocks);
        show([], prob.nCells).writeln;
        "Possibilities:".writeln;
        auto nConfigs = 0;
        foreach (const sol; nonoBlocks(prob.tupleof)) {
            show(sol, prob.nCells).writeln;
            nConfigs++;
        }
        writefln("A total of %d possible configurations.", nConfigs);
        writeln;
    }
}


;; size is the remaining # of cells
;; blocks is the list of remaining blocks size
;; cells is a stack where we push 0 = space or block size.
(define (nonoblock size blocks into: cells)
(cond
	((and (empty? blocks) (= 0 size)) (print-cells (stack->list cells)))

	((<= size 0) #f) ;; no hope - cut search
	((> (apply + blocks) size)  #f) ;; no hope - cut search

	(else
		(push cells 0) ;; space
		(nonoblock (1- size) blocks  cells)
		(pop cells)

	(when (!empty? blocks)
		(when (stack-empty? cells) ;; first one (no space is allowed)
		(push cells (first blocks))
		(nonoblock  (- size (first blocks)) (rest blocks) cells)
		(pop cells))

		(push cells 0) ;; add space before
		(push cells (first blocks))
		(nonoblock  (- size (first blocks) 1) (rest blocks) cells)
		(pop cells)
		(pop cells)))))

(string-delimiter "")
(define block-symbs #( ?  📦 💣 💊  🍒 🌽 📘 📙 💰 🍯 ))

(define (print-cells cells)
	(writeln (string-append "|"
		(for/string ((cell cells))
			(if (zero? cell) "_"
				(for/string ((i cell)) [block-symbs cell]))) "|")))

(define (task  nonotest)
	(for ((test nonotest))
		(define size (first test))
		(define blocks (second test))
		(printf "\n size:%d blocks:%d" size blocks)
		(if
			(> (+ (apply + blocks)(1- (length blocks))) size)
				(writeln "❌ no solution for" size blocks)
			    (nonoblock size blocks (stack 'cells)))))


defmodule Nonoblock do
  def solve(cell, blocks) do
    width = Enum.sum(blocks) + length(blocks) - 1
    if cell < width do
      raise "Those blocks will not fit in those cells"
    else
      nblocks(cell, blocks, "")
    end
  end

  defp nblocks(cell, _, position) when cell<=0, do:
    display(String.slice(position, 0..cell-1))
  defp nblocks(cell, blocks, position) when length(blocks)==0 or hd(blocks)==0, do:
    display(position <> String.duplicate(".", cell))
  defp nblocks(cell, blocks, position) do
    rest = cell - Enum.sum(blocks) - length(blocks) + 2
    [bl | brest] = blocks
    Enum.reduce(0..rest-1, 0, fn i,acc ->
      acc + nblocks(cell-i-bl-1, brest, position <> String.duplicate(".", i) <> String.duplicate("#",bl) <> ".")
    end)
  end

  defp display(str) do
    IO.puts nonocell(str)
    1                           # number of positions
  end

  def nonocell(str) do                  # "##.###..##" -> "|A|A|_|B|B|B|_|_|C|C|"
    slist = String.to_char_list(str) |> Enum.chunk_by(&(&1==?.)) |> Enum.map(&List.to_string(&1))
    chrs = Enum.map(?A..?Z, &List.to_string([&1]))
    result = nonocell_replace(slist, chrs, "")
             |> String.replace(".", "_")
             |> String.split("") |> Enum.join("|")
    "|" <> result
  end

  defp nonocell_replace([], _, result), do: result
  defp nonocell_replace([h|t], chrs, result) do
    if String.first(h) == "#" do
      [c | rest] = chrs
      nonocell_replace(t, rest, result <> String.replace(h, "#", c))
    else
      nonocell_replace(t, chrs, result <> h)
    end
  end
end

conf = [{ 5, [2, 1]},
        { 5, []},
        {10, [8]},
        {15, [2, 3, 2, 3]},
        { 5, [2, 3]}       ]
Enum.each(conf, fn {cell, blocks} ->
  try do
    IO.puts "Configuration:"
    IO.puts "#{Nonoblock.nonocell(String.duplicate(".",cell))} # #{cell} cells and #{inspect blocks} blocks"
    IO.puts "Possibilities:"
    count = Nonoblock.solve(cell, blocks)
    IO.puts "A total of #{count} Possible configurations.\n"
  rescue
    e in RuntimeError -> IO.inspect e
  end
end)


package main

import (
    "fmt"
    "strings"
)

func printBlock(data string, le int) {
    a := []byte(data)
    sumBytes := 0
    for _, b := range a {
        sumBytes += int(b - 48)
    }
    fmt.Printf("\nblocks %c, cells %d\n", a, le)
    if le-sumBytes <= 0 {
        fmt.Println("No solution")
        return
    }
    prep := make([]string, len(a))
    for i, b := range a {
        prep[i] = strings.Repeat("1", int(b-48))
    }
    for _, r := range genSequence(prep, le-sumBytes+1) {
        fmt.Println(r[1:])
    }
}

func genSequence(ones []string, numZeros int) []string {
    if len(ones) == 0 {
        return []string{strings.Repeat("0", numZeros)}
    }
    var result []string
    for x := 1; x < numZeros-len(ones)+2; x++ {
        skipOne := ones[1:]
        for _, tail := range genSequence(skipOne, numZeros-x) {
            result = append(result, strings.Repeat("0", x)+ones[0]+tail)
        }
    }
    return result
}

func main() {
    printBlock("21", 5)
    printBlock("", 5)
    printBlock("8", 10)
    printBlock("2323", 15)
    printBlock("23", 5)
}


import java.util.*;
import static java.util.Arrays.stream;
import static java.util.stream.Collectors.toList;

public class Nonoblock {

    public static void main(String[] args) {
        printBlock("21", 5);
        printBlock("", 5);
        printBlock("8", 10);
        printBlock("2323", 15);
        printBlock("23", 5);
    }

    static void printBlock(String data, int len) {
        int sumChars = data.chars().map(c -> Character.digit(c, 10)).sum();
        String[] a = data.split("");

        System.out.printf("%nblocks %s, cells %s%n", Arrays.toString(a), len);
        if (len - sumChars <= 0) {
            System.out.println("No solution");
            return;
        }

        List<String> prep = stream(a).filter(x -> !"".equals(x))
                .map(x -> repeat(Character.digit(x.charAt(0), 10), "1"))
                .collect(toList());

        for (String r : genSequence(prep, len - sumChars + 1))
            System.out.println(r.substring(1));
    }

    // permutation generator, translated from Python via D
    static List<String> genSequence(List<String> ones, int numZeros) {
        if (ones.isEmpty())
            return Arrays.asList(repeat(numZeros, "0"));

        List<String> result = new ArrayList<>();
        for (int x = 1; x < numZeros - ones.size() + 2; x++) {
            List<String> skipOne = ones.stream().skip(1).collect(toList());
            for (String tail : genSequence(skipOne, numZeros - x))
                result.add(repeat(x, "0") + ones.get(0) + tail);
        }
        return result;
    }

    static String repeat(int n, String s) {
        StringBuilder sb = new StringBuilder();
        for (int i = 0; i < n; i++)
            sb.append(s);
        return sb.toString();
    }
}


const compose = (...fn) => (...x) => fn.reduce((a, b) => c => a(b(c)))(...x);
const inv = b => !b;
const arrJoin = str => arr => arr.join(str);
const mkArr = (l, f) => Array(l).fill(f);
const sumArr = arr => arr.reduce((a, b) => a + b, 0);
const sumsTo = val => arr => sumArr(arr) === val;
const zipper = arr => (p, c, i) => arr[i] ? [...p, c, arr[i]] : [...p, c];
const zip = (a, b) => a.reduce(zipper(b), []);
const zipArr = arr => a => zip(a, arr);
const hasInner = v => arr => arr.slice(1, -1).indexOf(v) >= 0;
const choose = (even, odd) => n => n % 2 === 0 ? even : odd;
const toBin = f => arr => arr.reduce(
    (p, c, i) => [...p, ...mkArr(c, f(i))], []);

const looper = (arr, max, acc = [[...arr]], idx = 0) => {
  if (idx !== arr.length) {
    const b = looper([...arr], max, acc, idx + 1)[0];
    if (b[idx] !== max) {
      b[idx] = b[idx] + 1;
      acc.push(looper([...b], max, acc, idx)[0]);
    }
  }
  return [arr, acc];
};

const gapPerms = (grpSize, numGaps, minVal = 0) => {
  const maxVal = numGaps - grpSize * minVal + minVal;
  return maxVal <= 0
      ? (grpSize === 2 ? [[0]] : [])
      : looper(mkArr(grpSize, minVal), maxVal)[1];
}

const test = (cells, ...blocks) => {
  const grpSize = blocks.length + 1;
  const numGaps = cells - sumArr(blocks);

  // Filter functions
  const sumsToTrg = sumsTo(numGaps);
  const noInnerZero = compose(inv, hasInner(0));

  // Output formatting
  const combine = zipArr([...blocks]);
  const choices = toBin(choose(0, 1));
  const output = compose(console.log, arrJoin(''), choices, combine);

  console.log(`\n${cells} cells. Blocks: ${blocks}`);
  gapPerms(grpSize, numGaps)
      .filter(noInnerZero)
      .filter(sumsToTrg)
      .map(output);
};

test(5, 2, 1);
test(5);
test(5, 5);
test(5, 1, 1, 1);
test(10, 8);
test(15, 2, 3, 2, 3);
test(10, 4, 3);
test(5, 2, 3);


minsized(arr) = join(map(x->"#"^x, arr), ".")
minlen(arr) = sum(arr) + length(arr) - 1

function sequences(blockseq, numblanks)
    if isempty(blockseq)
        return ["." ^ numblanks]
    elseif minlen(blockseq) == numblanks
        return minsized(blockseq)
    else
        result = Vector{String}()
        allbuthead = blockseq[2:end]
        for leftspace in 0:(numblanks - minlen(blockseq))
            header = "." ^ leftspace * "#" ^ blockseq[1] * "."
            rightspace = numblanks - length(header)
            if isempty(allbuthead)
                push!(result, rightspace <= 0 ? header[1:numblanks] : header * "." ^ rightspace)
            elseif minlen(allbuthead) == rightspace
                push!(result, header * minsized(allbuthead))
            else
                map(x -> push!(result, header * x), sequences(allbuthead, rightspace))
            end
        end
    end
    result
end

function nonoblocks(bvec, len)
    println("With blocks $bvec and $len cells:")
    len < minlen(bvec) ? println("No solution") : for seq in sequences(bvec, len) println(seq) end
end

nonoblocks([2, 1], 5)
nonoblocks(Vector{Int}([]), 5)
nonoblocks([8], 10)
nonoblocks([2, 3, 2, 3], 15)
nonoblocks([2, 3], 5)


// version 1.2.0

fun printBlock(data: String, len: Int) {
    val a = data.toCharArray()
    val sumChars = a.map { it.toInt() - 48 }.sum()
    println("\nblocks ${a.asList()}, cells $len")
    if (len - sumChars <= 0) {
        println("No solution")
        return
    }
    val prep = a.map { "1".repeat(it.toInt() - 48) }
    for (r in genSequence(prep, len - sumChars + 1)) println(r.substring(1))
}

fun genSequence(ones: List<String>, numZeros: Int): List<String> {
    if (ones.isEmpty()) return listOf("0".repeat(numZeros))
    val result = mutableListOf<String>()
    for (x in 1 until numZeros - ones.size + 2) {
        val skipOne = ones.drop(1)
        for (tail in genSequence(skipOne, numZeros - x)) {
            result.add("0".repeat(x) + ones[0] + tail)
        }
    }
    return result
}

fun main(args: Array<String>) {
    printBlock("21", 5)
    printBlock("", 5)
    printBlock("8", 10)
    printBlock("2323", 15)
    printBlock("23", 5)
}


local examples = {
	{5, {2, 1}},
	{5, {}},
	{10, {8}},
	{15, {2, 3, 2, 3}},
	{5, {2, 3}},
}

function deep (blocks, iBlock, freedom, str)
	if iBlock == #blocks then -- last
		for takenFreedom = 0, freedom do
			print (str..string.rep("0", takenFreedom) .. string.rep("1", blocks[iBlock]) .. string.rep("0", freedom - takenFreedom))
			total = total + 1
		end
	else
		for takenFreedom = 0, freedom do
			local str2 = str..string.rep("0", takenFreedom) .. string.rep("1", blocks[iBlock]) .. "0"
			deep (blocks, iBlock+1, freedom-takenFreedom, str2)
		end
	end
end

function main (cells, blocks) -- number, list
	local str = "	"
	print (cells .. ' cells and {' .. table.concat(blocks, ', ') .. '} blocks')
	local freedom = cells - #blocks + 1 -- freedom
	for iBlock = 1, #blocks do
		freedom = freedom - blocks[iBlock]
	end
	if #blocks == 0 then
		print ('no blocks')
		print (str..string.rep("0", cells))
		total = 1
	elseif freedom < 0 then
		print ('no solutions')
	else
		print ('Possibilities:')
		deep (blocks, 1, freedom, str)
	end
end

for i, example in ipairs (examples) do
	print ("\n--")
	total = 0
	main (example[1], example[2])
	print ('A total of ' .. total .. ' possible configurations.')
end


Module NonoBlock {
      Form 80,40
      Flush
      Print "Nonoblock"
      Data 5, (2, 1)
      Data 5, (,)
      Data 10, (8,)
      Data 15, (2,3,2,3)
      Data 5, (2,3)
      Def BLen(a$)=(Len(a$)-1)/2
      Function UseLetter(arr) {
            Dim Base 0, Res$(Len(arr))
            Link Res$() to Res()
            Def Ord$(a$)=ChrCode$(Chrcode(a$)+1)
            L$="A"
            i=each(arr)
            While i {
                  Res$(i^)=String$("|"+L$, Array(i))+"|"
                  L$=Ord$(L$)
            }
            =Res()
      }
      Count=0
      For i=1 to 5
      Read Cells, Blocks
      Blocks=UseLetter(Blocks)
      Print str$(i,"")+".", "Cells=";Cells, "", iF(len(Blocks)=0->("Empty",), Blocks)
      PrintRow( "|", Cells, Blocks, &Count)
      CheckCount()
      Next I
      Sub CheckCount()
            If count=0 Then Print " Impossible"
            count=0
      End Sub
      Sub PrintRow(Lpart$, Cells, Blocks, &Comp)
            If len(Blocks)=0 Then Comp++ :Print Format$("{0::-3} {1}", Comp, lpart$+String$("_|", Cells)):  Exit Sub
            If Cells<=0 Then Exit Sub
            Local TotalBlocksLength=0, Sep_Spaces=-1
            Local Block=Each(Blocks), block$
            While Block {
                  Block$=Array$(Block)
                  TotalBlocksLength+=Blen(Block$)
                  Sep_Spaces++
            }
            Local MaxLengthNeed=TotalBlocksLength+Sep_Spaces
            If MaxLengthNeed>Cells Then Exit Sub
            block$=Array$(Car(Blocks))
            local temp=Blen(block$)
            block$=Mid$(Block$, 2)
            If Len(Blocks)>1 Then block$+="_|" :temp++
            PrintRow(Lpart$+block$, Cells-temp, Cdr(Blocks), &Comp)
            PrintRow(lpart$+String$("_|", 1), Cells-1,Blocks, &Comp)
      End Sub
}
NonoBlock


ClearAll[SpacesDistributeOverN, Possibilities]
SpacesDistributeOverN[s_, p_] :=
 Flatten[
  Permutations /@ (Join[#, ConstantArray[0, p - Length[#]]] & /@
     IntegerPartitions[s, p]), 1]
Possibilities[hint_, len_] :=
 Module[{p = hint, l = len, b = Length[hint], Spaces, out},
  Spaces = # + (Prepend[Append[ConstantArray[1, b - 1], 0],
        0]) & /@ (SpacesDistributeOverN[l - [email protected] - (b - 1), b + 1]);
  out = Flatten /@ (
     Riffle[#, Map[Table[1, {#}] &, p, {1}]] & /@
      Map[Table[0, {#}] &, Spaces, {2}]);
  StringJoin @@@ (out /. {0 -> ".", 1 -> "#"})
  ]
Possibilities[{}, len_] := Module[{},
  {StringJoin[ConstantArray[".", len]]}
  ]
Possibilities[{2, 1}, 5]
Possibilities[{}, 5]
Possibilities[{8}, 10]
Possibilities[{2, 3, 2, 3}, 15]
Possibilities[{2, 3}, 5]


import math, sequtils, strformat, strutils

proc genSequence(ones: seq[string]; numZeroes: Natural): seq[string] =
  if ones.len == 0: return @[repeat('0', numZeroes)]
  for x in 1..(numZeroes - ones.len + 1):
    let skipOne = ones[1..^1]
    for tail in genSequence(skipOne, numZeroes - x):
      result.add repeat('0', x) & ones[0] & tail

proc printBlock(data: string; length: Positive) =

  let a = mapIt(data, ord(it) - ord('0'))
  let sumBytes = sum(a)

  echo &"\nblocks {($a)[1..^1]} cells {length}"
  if length - sumBytes <= 0:
    echo "No solution"
    return

  var prep: seq[string]
  for b in a: prep.add repeat('1', b)

  for r in genSequence(prep, length - sumBytes + 1):
    echo r[1..^1]

when isMainModule:
  printBlock("21", 5)
  printBlock("", 5)
  printBlock("8", 10)
  printBlock("2323", 15)
  printBlock("23", 5)


program Nonoblock;
uses SysUtils;

// Working through solutions to the problem:
// Fill an array z[] with non-negative integers
//  whose sum is the passed-in integer s.
function GetFirstSolution( var z : array of integer;
                               s : integer) : boolean;
var
  j : integer;
begin
  result := (s >= 0) and (High(z) >= 0);  // failed if s < 0 or array is empty
  if result then begin // else initialize to solution 0, ..., 0, s
    j := High(z);  z[j] := s;
    while (j > 0) do begin
      dec(j);      z[j] := 0;
    end;
  end;
end;

// Next solution: return true for success, false if no more solutions.
// Solutions are generated in lexicographic order.
function GetNextSolution( var z : array of integer) : boolean;
var
  h, j : integer;
begin
  h := High(z);
  j := h; // find highest index j such that z[j] > 0.
  while (j > 0) and (z[j] = 0) do dec(j);
  result := (j > 0);   // if index is 0, or there is no such index, failed
  if result then begin // else update caller's array to give next solution
    inc(z[j - 1]);
    z[h] := z[j] - 1;
    if (j < h) then z[j] := 0;
  end;
end;

// Procedure to print solutions to nonoblock task on RosettaCode
procedure PrintSolutions( nrCells : integer;
                          blockSizes : array of integer);
const // cosmetic
  MARGIN = 4;
  GAP_CHAR = '.';
  BLOCK_CHAR = '#';
var
  sb : SysUtils.TStringBuilder;
  nrBlocks, blockSum, gapSum : integer;
  gapSizes : array of integer;
  i, nrSolutions : integer;
begin
  nrBlocks := Length( blockSizes);

  // Print a title, showing the number of cells and the block sizes
  sb := SysUtils.TStringBuilder.Create();
  sb.AppendFormat('%d cells; blocks [', [nrCells]);
  for i := 0 to nrBlocks - 1 do begin
    if (i > 0) then sb.Append(',');
    sb.Append( blockSizes[i]);
  end;
  sb.Append(']');
  WriteLn( sb.ToString());

  blockSum := 0; // total of block sizes
  for i := 0 to nrBlocks - 1 do inc( blockSum, blockSizes[i]);

  gapSum := nrCells - blockSum;
  // Except in the trivial case of no blocks,
  // we reduce the size of each inner gap by 1.
  if nrBlocks > 0 then dec( gapSum, nrBlocks - 1);

  // Work through all solutions and print them nicely.
  nrSolutions := 0;
  SetLength( gapSizes, nrBlocks + 1); // include the gap at each end
  if GetFirstSolution( gapSizes, gapSum) then begin
    repeat
      inc( nrSolutions);
      sb.Clear();
      sb.Append( ' ', MARGIN);
      for i := 0 to nrBlocks - 1 do begin
        sb.Append( GAP_CHAR, gapSizes[i]);
        // We reduced the inner gaps by 1; now we restore the deleted char.
        if (i > 0) then sb.Append( GAP_CHAR);
        sb.Append( BLOCK_CHAR, blockSizes[i]);
      end;
      sb.Append( GAP_CHAR, gapSizes[nrBlocks]);
      WriteLn( sb.ToString());
    until not GetNextSolution( gapSizes);
  end;
  sb.Free();
  WriteLn( SysUtils.Format( 'Number of solutions = %d', [nrSolutions]));
  WriteLn('');
end;

// Main program
begin
  PrintSolutions( 5, [2,1]);
  PrintSolutions( 5, []);
  PrintSolutions( 10, [8]);
  PrintSolutions( 15, [2,3,2,3]);
  PrintSolutions( 5, [2,3]);
end.


use strict;
use warnings;

while( <DATA> )
  {
  print "\n$_", tr/\n/=/cr;
  my ($cells, @blocks) = split;
  my $letter = 'A';
  $_ = join '.', map { $letter++ x $_ } @blocks;
  $cells < length and print("no solution\n"), next;
  $_ .= '.' x ($cells - length) . "\n";
  1 while print, s/^(\.*)\b(.*?)\b(\w+)\.\B/$2$1.$3/;
  }

__DATA__
5 2 1
5
10 8
15 2 3 2 3
5 2 3


with javascript_semantics
function nobr(sequence res, string neat, integer ni, integer ch, sequence blocks)
    if length(blocks)=0 then
        res = append(res,neat)
    else
        integer b = blocks[1]
        blocks = blocks[2..$]
        integer l = (sum(blocks)+length(blocks)-1)*2,
                e = length(neat)-l-b*2
        for i=ni to e by 2 do
            for j=i to i+b*2-2 by 2 do
                neat[j] = ch
            end for
            res = nobr(res,neat,i+b*2+2,ch+1,blocks)
            neat[i] = ' '
        end for
    end if
    return res
end function

function nonoblock(integer len, sequence blocks)
    string neat = "|"&join(repeat(' ',len),'|')&"|"
    return nobr({},neat,2,'A',blocks)
end function

sequence tests = {{5,{2,1}},
                  {5,{}},
                  {10,{8}},
                  {15,{2, 3, 2, 3}},
                  {10,{4, 3}},
                  {5,{2,1}},
                  {10,{3, 1}},
                  {5,{2, 3}}}
integer len
sequence blocks, res
for i=1 to length(tests) do
    {len,blocks} = tests[i]
    string ti = sprintf("%d cells with blocks %s",{len,sprint(blocks)})
    printf(1,"%s\n%s\n",{ti,repeat('=',length(ti))})
    res = nonoblock(len,blocks)
    if length(res)=0 then
        printf(1,"No solutions.\n")
    else
        for ri=1 to length(res) do
            printf(1,"%3d:  %s\n",{ri,res[ri]})
        end for
    end if
    printf(1,"\n")
end for


def nonoblocks(blocks, cells):
    if not blocks or blocks[0] == 0:
        yield [(0, 0)]
    else:
        assert sum(blocks) + len(blocks)-1 <= cells, \
            'Those blocks will not fit in those cells'
        blength, brest = blocks[0], blocks[1:]      # Deal with the first block of length
        minspace4rest = sum(1+b for b in brest)     # The other blocks need space
        # Slide the start position from left to max RH index allowing for other blocks.
        for bpos in range(0, cells - minspace4rest - blength + 1):
            if not brest:
                # No other blocks to the right so just yield this one.
                yield [(bpos, blength)]
            else:
                # More blocks to the right so create a *sub-problem* of placing
                # the brest blocks in the cells one space to the right of the RHS of
                # this block.
                offset = bpos + blength +1
                nonoargs = (brest, cells - offset)  # Pre-compute arguments to nonoargs
                # recursive call to nonoblocks yields multiple sub-positions
                for subpos in nonoblocks(*nonoargs):
                    # Remove the offset from sub block positions
                    rest = [(offset + bp, bl) for bp, bl in subpos]
                    # Yield this block plus sub blocks positions
                    vec = [(bpos, blength)] + rest
                    yield vec

def pblock(vec, cells):
    'Prettyprints each run of blocks with a different letter A.. for each block of filled cells'
    vector = ['_'] * cells
    for ch, (bp, bl) in enumerate(vec, ord('A')):
        for i in range(bp, bp + bl):
            vector[i] = chr(ch) if vector[i] == '_' else'?'
    return '|' + '|'.join(vector) + '|'

if __name__ == '__main__':
    for blocks, cells in (
            ([2, 1], 5),
            ([], 5),
            ([8], 10),
            ([2, 3, 2, 3], 15),
           # ([4, 3], 10),
           # ([2, 1], 5),
           # ([3, 1], 10),
            ([2, 3], 5),
            ):
        print('\nConfiguration:\n    %s # %i cells and %r blocks' % (pblock([], cells), cells, blocks))
        print('  Possibilities:')
        for i, vector in enumerate(nonoblocks(blocks, cells)):
            print('   ', pblock(vector, cells))
        print('  A total of %i Possible configurations.' % (i+1))


#lang racket
(require racket/trace)

(define add1-to-car (match-lambda [(cons (app add1 p1) t) (cons p1 t)]))

;; inputs:
;;   cells  -- available cells
;;   blocks -- list of block widths
;; output:
;;   gap-block+gaps
;;   where gap-block+gaps is:
;;   (list gap)                            -- a single gap
;;   (list gap block-width gap-block+gaps) -- padding to left, a block, right hand side
(define (nonoblock cells blocks)
  (match* ((- cells (apply + (length blocks) -1 blocks)) #| padding available on both sides |# blocks)
    [(_ (list)) (list (list cells))] ; generates an empty list of padding

    [((? negative?) _) null] ; impossible to satisfy

    [((and avp
           ;; use add1 with in-range because we actually want from 0 to available-padding
           ;; without add1, in-range iterates from 0 to (available-padding - 1)
           (app add1 avp+1))
      (list block))
     (for/list ((l-pad (in-range 0 avp+1)))
       (define r-pad (- avp l-pad)) ; what remains goes to right
       (list l-pad block r-pad))]

    [((app add1 avp+1) (list block more-blocks ...))
     (for*/list ((l-pad (in-range 0 avp+1))
                 (cells-- (in-value (- cells block l-pad 1)))
                 (r-blocks (in-value (nonoblock cells-- more-blocks)))
                 (r-block (in-list r-blocks)))
       (list* l-pad block (add1-to-car r-block)))])) ; put a single space pad on left of r-block

(define (neat rslt)
  (define dots (curryr make-string #\.))
  (define Xes (curryr make-string #\X))
  (define inr
    (match-lambda
      [(list 0 (app Xes b) t ...)
       (string-append b (inr t))]
      [(list (app dots p) (app Xes b) t ...)
       (string-append p b (inr t))]
      [(list (app dots p)) p]))
  (define (neat-row r)
    (string-append "|" (inr r) "|"))
  (string-join (map neat-row rslt) "\n"))

(define (tst c b)
  (define rslt (nonoblock c b))
  (define rslt-l (length rslt))
  (printf "~a cells, ~a blocks => ~a~%~a~%" c b
          (match rslt-l
            [0 "impossible"]
            [1 "1 solution"]
            [(app (curry format "~a solutions") r) r])
          (neat rslt)))

(module+ test
  (tst  5 '[2 1])
  (tst  5 '[])
  (tst 10 '[8])
  (tst 15 '[2 3 2 3])
  (tst  5 '[2 3]))


for (5, [2,1]), (5, []), (10, [8]), (5, [2,3]), (15, [2,3,2,3]) -> ($cells, @blocks) {
    say $cells, ' cells with blocks: ', @blocks ?? join ', ', @blocks !! '∅';
    my $letter = 'A';
    my $row = join '.', map { $letter++ x $_ }, @blocks;
    say "no solution\n" and next if $cells < $row.chars;
    say $row ~= '.' x $cells - $row.chars;
    say $row while $row ~~ s/^^ (\.*) <|w> (.*?) <|w> (\w+) \.<!|w> /$1$0.$2/;
    say '';
}


/*REXX program enumerates all possible configurations (or an error) for nonogram puzzles*/
             $.=;    $.1=  5   2 1
                     $.2=  5
                     $.3= 10   8
                     $.4= 15   2 3 2 3
                     $.5=  5   2 3
      do  i=1  while $.i\==''
      parse var  $.i   N  blocks                 /*obtain  N  and  blocks   from array. */
      N= strip(N);     blocks= space(blocks)     /*assign stripped   N   and   blocks.  */
      call nono                                  /*incoke NONO subroutine for heavy work*/
      end   /*i*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
nono: say copies('=', 70)                                 /*display seperator for title.*/
      say 'For '   N   " cells  and blocks of: "   blocks /*display the title for output*/
      z=                                                  /*assign starter value for Z. */
          do w=1  for words(blocks)                       /*process each of the blocks. */
          z= z copies('#', word(blocks,w) )               /*build a string for 1st value*/
          end   /*w*/                                     /*Z  now has a leading blank. */
      #= 1                                                /*number of positions (so far)*/
      z= translate( strip(z), ., ' ');   L= length(z)     /*change blanks to periods.   */
      if L>N  then do;   say '***error***  invalid blocks for number of cells.';   return
                   end
      @.0=;           @.1= z;         !.=0       /*assign default and the first position*/
      z= pad(z)                                  /*fill─out (pad) the value with periods*/

         do prepend=1  while words(blocks)\==0   /*process all the positions (leading .)*/
         new= . || @.prepend                     /*create positions with leading dots.  */
         if length(new)>N  then leave            /*Length is too long?  Then stop adding*/
         call add                                /*add position that has a leading dot. */
         end   /*prepend*/                       /* [↑]  prepend positions with dots.   */

         do   k=1  for N                         /*process each of the positions so far.*/
           do c=1  for N                         /*   "      "   "  "  position blocks. */
           if @.c==''  then iterate              /*if string is null,  skip the string. */
           p= loc(@.c, k)                        /*find location of block in position.  */
           if p==0 | p>=N  then iterate          /*Location zero or out─of─range?  Skip.*/
           new= strip( insert(., @.c, p),'T',.)  /*insert a dot and strip trailing dots.*/
           if strip(new,'T',.)[email protected].c  then iterate /*Is it the same value?  Then skip it. */
           if length(new)<=N  then call add      /*Is length OK?   Then add position.   */
           end   /*k*/
         end     /*c*/
      say
      say '─position─'  center("value", max(7, length(z) ), '─')  /*show hdr for output.*/

               do m=1  for #
               say center(m, 10)   pad(@.m)      /*display the index count and position.*/
               end   /*m*/
      return
/*──────────────────────────────────────────────────────────────────────────────────────*/
loc:  _=0; do arg(2); _=pos('#.',pad(arg(1)),_+1); if _==0  then return 0; end; return _+1
add:  if !.new==1  then return;  #= # + 1;     @.#= new;    !.new=1;    return
pad:  return  left( arg(1), N, .)


def nonoblocks(cell, blocks)
  raise 'Those blocks will not fit in those cells' if cell < blocks.inject(0,:+) + blocks.size - 1
  nblock(cell, blocks, '', [])
end

def nblock(cell, blocks, position, result)
  if cell <= 0
    result << position[0..cell-1]
  elsif blocks.empty? or blocks[0].zero?
    result << position + '.' * cell
  else
    rest = cell - blocks.inject(:+) - blocks.size + 2
    bl, *brest = blocks
    rest.times.inject(result) do |res, i|
      nblock(cell-i-bl-1, brest, position + '.'*i + '#'*bl + '.', res)
    end
  end
end

conf = [[ 5, [2, 1]],
        [ 5, []],
        [10, [8]],
        [15, [2, 3, 2, 3]],
        [ 5, [2, 3]],      ]
conf.each do |cell, blocks|
  begin
    puts "#{cell} cells and #{blocks} blocks"
    result = nonoblocks(cell, blocks)
    puts result, result.size, ""
  rescue => e
    p e
  end
end


struct Nonoblock {
  width: usize,
  config: Vec<usize>,
  spaces: Vec<usize>,
}

impl Nonoblock {
  pub fn new(width: usize, config: Vec<usize>) -> Nonoblock {
    Nonoblock {
      width: width,
      config: config,
      spaces: Vec::new(),
    }
  }

  pub fn solve(&mut self) -> Vec<Vec<i32>> {
    let mut output: Vec<Vec<i32>> = Vec::new();
    self.spaces = (0..self.config.len()).fold(Vec::new(), |mut s, i| {
      s.push(match i {
        0 => 0,
        _ => 1,
      });
      s
    });
    if self.spaces.iter().sum::<usize>() + self.config.iter().sum::<usize>() <= self.width {
      'finished: loop {
        match self.spaces.iter().enumerate().fold((0, vec![0; self.width]), |mut a, (i, s)| {
            (0..self.config[i]).for_each(|j| a.1[a.0 + j + *s] = 1 + i as i32);
            return (a.0 + self.config[i] + *s, a.1);
          }) {
          (_, out) => output.push(out),
        }
        let mut i: usize = 1;
        'calc: loop {
          let len = self.spaces.len();
          if i > len {
            break 'finished;
          } else {
            self.spaces[len - i] += 1
          }
          if self.spaces.iter().sum::<usize>() + self.config.iter().sum::<usize>() > self.width {
            self.spaces[len - i] = 1;
            i += 1;
          } else {
            break 'calc;
          }
        }
      }
    }
    output
  }
}

fn main() {
  let mut blocks = [
    Nonoblock::new(5, vec![2, 1]),
    Nonoblock::new(5, vec![]),
    Nonoblock::new(10, vec![8]),
    Nonoblock::new(15, vec![2, 3, 2, 3]),
    Nonoblock::new(5, vec![2, 3]),
  ];

  for block in blocks.iter_mut() {
    println!("{} cells and {:?} blocks", block.width, block.config);
    println!("{}",(0..block.width).fold(String::from("="), |a, _| a + "=="));
    let solutions = block.solve();
    if solutions.len() > 0 {
      for solution in solutions.iter() {
        println!("{}", solution.iter().fold(String::from("|"), |s, f| s + &match f {
          i if *i > 0 => (('A' as u8 + ((*i - 1) as u8) % 26) as char).to_string(),
          _ => String::from("_"),
        }+ "|"));
      }
    } else {
      println!("No solutions. ");
    }
    println!();
  }
}


import Foundation

func nonoblock(cells: Int, blocks: [Int]) {
    print("\(cells) cells and blocks \(blocks):")
    let totalBlockSize = blocks.reduce(0, +)
    if cells < totalBlockSize + blocks.count - 1 {
        print("no solution")
        return
    }

    func solve(cells: Int, index: Int, totalBlockSize: Int, offset: Int) {
        if index == blocks.count {
            count += 1
            print("\(String(format: "%2d", count))  \(String(output))")
            return
        }
        let blockSize = blocks[index]
        let maxPos = cells - (totalBlockSize + blocks.count - index - 1)
        let t = totalBlockSize - blockSize
        var c = cells - (blockSize + 1)
        for pos in 0...maxPos {
            fill(value: ".", offset: offset, count: maxPos + blockSize)
            fill(value: "#", offset: offset + pos, count: blockSize)
            solve(cells: c, index: index + 1, totalBlockSize: t,
                  offset: offset + blockSize + pos + 1)
            c -= 1
        }
    }

    func fill(value: Character, offset: Int, count: Int) {
        output.replaceSubrange(offset..<offset+count,
                               with: repeatElement(value, count: count))
    }

    var output: [Character] = Array(repeating: ".", count: cells)
    var count = 0
    solve(cells: cells, index: 0, totalBlockSize: totalBlockSize, offset: 0)
}

nonoblock(cells: 5, blocks: [2, 1])
print()

nonoblock(cells: 5, blocks: [])
print()

nonoblock(cells: 10, blocks: [8])
print()

nonoblock(cells: 15, blocks: [2, 3, 2, 3])
print()

nonoblock(cells: 5, blocks: [2, 3])


package require Tcl 8.6
package require generator

generator define nonoblocks {blocks cells} {
    set sum [tcl::mathop::+ {*}$blocks]
    if {$sum == 0 || [lindex $blocks 0] == 0} {
	generator yield {{0 0}}
	return
    } elseif {$sum + [llength $blocks] - 1 > $cells} {
	error "those blocks will not fit in those cells"
    }

    set brest [lassign $blocks blen]
    for {set bpos 0} {$bpos <= $cells - $sum - [llength $brest]} {incr bpos} {
	if {![llength $brest]} {
	    generator yield [list [list $bpos $blen]]
	    return
	}
	set offset [expr {$bpos + $blen + 1}]
	generator foreach subpos [nonoblocks $brest [expr {$cells - $offset}]] {
	    generator yield [linsert [lmap b $subpos {
		lset b 0 [expr {[lindex $b 0] + $offset}]
	    }] 0 [list $bpos $blen]]
	}
    }
}

if {[info script] eq $::argv0} {
    proc pblock {cells {vec {}}} {
	set vector [lrepeat $cells "_"]
	set ch 64
	foreach b $vec {
	    incr ch
	    lassign $b bp bl
	    for {set i $bp} {$i < $bp + $bl} {incr i} {
		lset vector $i [format %c $ch]
	    }
	}
	return |[join $vector "|"]|
    }
    proc flist {items} {
	return [format "\[%s\]" [join $items ", "]]
    }
    foreach {blocks cells} {
	{2 1} 5
	{} 5
	{8} 10
	{2 3 2 3} 15
	{2 3} 5
    } {
	puts "\nConfiguration:"
	puts [format "%s # %d cells and %s blocks" \
		  [pblock $cells] $cells [flist $blocks]]
	puts "  Possibilities:"
	set i 0
	try {
	    generator foreach vector [nonoblocks $blocks $cells] {
		puts "    [pblock $cells $vector]"
		incr i
	    }
	    puts "  A total of $i possible configurations"
	} on error msg {
	    puts "    --> ERROR: $msg"
	}
    }
}

package provide nonoblock 1


import "/math" for Nums

var genSequence // recursive
genSequence = Fn.new { |ones, numZeros|
    if (ones.isEmpty) return ["0" * numZeros]
    var result = []
    for (x in 1...numZeros - ones.count + 2) {
        var skipOne = ones[1..-1]
        for (tail in genSequence.call(skipOne, numZeros - x)) {
            result.add("0" * x + ones[0] + tail)
        }
    }
    return result
}

var printBlock = Fn.new { |data, len|
    var a = data.toList
    var sumChars = Nums.sum(a.map { |c| c.bytes[0] - 48 }.toList)
    System.print("\nblocks %(a), cells %(len)")
    if (len - sumChars <= 0) {
        System.print("No solution")
        return
    }
    var prep = a.map { |c| "1" * (c.bytes[0] - 48) }.toList
    for (r in genSequence.call(prep, len - sumChars + 1)) {
        System.print(r[1..-1])
    }
}

printBlock.call("21", 5)
printBlock.call("", 5)
printBlock.call("8", 10)
printBlock.call("2323", 15)
printBlock.call("23", 5)


fcn nonoblocks(blocks,cells){
   if(not blocks or blocks[0]==0) vm.yield( T(T(0,0)) );
   else{
      if(not ( blocks.sum(0) + blocks.len() -1<=cells ))
	 throw(Exception.AssertionError("Those blocks will not fit in those cells"));
      blength,brest:=blocks[0], blocks[1,*];      # Deal with the first block of length
      minspace4rest:=brest.reduce('+(1),0);       # The other blocks need space
      # Slide the start position from left to max RH index allowing for other blocks.
      foreach bpos in (cells - minspace4rest - blength +1){
         if(not brest) # No other blocks to the right so just yield this one.
	    vm.yield(T(T(bpos,blength)));
	 else{
	    # More blocks to the right so create a *sub-problem* of placing
	    # the brest blocks in the cells one space to the right of the RHS of
	    # this block.
	    offset:=bpos + blength +1;
	    # recursive call to nonoblocks yields multiple sub-positions
	    foreach subpos in (Utils.Generator(nonoblocks,brest,cells - offset)){
	       # Remove the offset from sub block positions
	       rest:=subpos.pump(List,'wrap([(bp,bl)]){ T(offset + bp, bl) });
	       # Yield this block plus sub blocks positions
	       vm.yield(T( T(bpos,blength) ).extend(rest) );
	    }
	 }
      }
   }
}
# Pretty print each run of blocks with a different letter for each block of filled cells
fcn pblock(vec,cells){
   vector,ch:=cells.pump(List(),"_".copy), ["A".."Z"];
   vec.apply2('wrap([(a,b)]){ a.walker(b).pump(Void,vector.set.fp1(ch.next())) });
   String("|",vector.concat("|"),"|");
}


print(Int(‘1A’, radix' 16)) // prints the integer 26


mov ah,02h
mov al,00h     ;this is the unpacked encoding of octal "20" aka 10 in hexadecimal, 16 in decimal. Ignore the leading zeroes.
byte 0D5h,08h  ;most assemblers don't allow you to encode a base so we have to inline the bytecode.


(defun digit-value (chr)
   (cond ((and (char>= chr #\0)
               (char<= chr #\9))
          (- (char-code chr) (char-code #\0)))
         ((and (char>= chr #\A)
               (char<= chr #\Z))
          (+ (- (char-code chr) (char-code #\A)) 10))
         ((and (char>= chr #\a)
               (char<= chr #\z))
          (+ (- (char-code chr) (char-code #\a)) 10))))

(defun value-digit (n)
   (if (< n 10)
       (code-char (+ n (char-code #\0)))
       (code-char (+ (- n 10) (char-code #\A)))))

(defun num-from-cs (cs base)
   (if (endp cs)
       0
       (+ (digit-value (first cs))
          (* base (num-from-cs (rest cs) base)))))

(defun parse-num (str base)
   (num-from-cs (reverse (coerce str 'list)) base))

(include-book "arithmetic-3/top" :dir :system)

(defun num-to-cs (num base)
   (if (or (zp num) (zp base) (= base 1))
       nil
       (cons (value-digit (mod num base))
             (num-to-cs (floor num base) base))))

(defun show-num (num base)
   (coerce (reverse (num-to-cs num base)) 'string))


CHAR ARRAY digits="0123456789abcdefghijklmnopqrstuvwxyz"

PROC CheckBase(BYTE b)
  IF b<2 OR b>digits(0) THEN
    PrintE("Base is out of range!")
    Break()
  FI
RETURN

PROC Encode(CARD v BYTE b CHAR ARRAY s)
  CARD d
  BYTE i,len
  CHAR tmp

  CheckBase(b)
  len=0
  DO
    d=v MOD b
    len==+1
    s(len)=digits(d+1)
    v==/b
  UNTIL v=0
  OD
  s(0)=len

  FOR i=1 to len/2
  DO
    tmp=s(i)
    s(i)=s(len-i+1)
    s(len-i+1)=tmp
  OD
RETURN

CARD FUNC Decode(CHAR ARRAY s BYTE b)
  CARD res
  BYTE i,j,found

  CheckBase(b)
  res=0
  FOR i=1 TO s(0)
  DO
    found=0
    FOR j=1 TO digits(0)
    DO
      IF digits(j)=s(i) THEN
        found=1 EXIT
      FI
    OD
    IF found=0 THEN
      PrintE("Unrecognized character!")
      Break()
    FI
    res==*b
    res==+j-1
  OD
RETURN (res)

PROC Main()
  CARD v=[6502],v2
  BYTE b
  CHAR ARRAY s(256)

  FOR b=2 TO 23
  DO
    Encode(v,b,s)
    v2=Decode(s,b)
    PrintF("%U -> base %B %S -> %U%E",v,b,s,v2)
  OD
RETURN


with Ada.Text_Io; use Ada.Text_Io;
with Ada.Strings.Fixed;
With Ada.Strings.Unbounded;

procedure Number_Base_Conversion is
   Max_Base : constant := 36;
   subtype Base_Type is Integer range 2..Max_Base;
   Num_Digits : constant String := "0123456789abcdefghijklmnopqrstuvwxyz";
   Invalid_Digit : exception;

   function To_Decimal(Value : String; Base : Base_Type) return Integer is
      use Ada.Strings.Fixed;
      Result : Integer := 0;
      Decimal_Value : Integer;
      Radix_Offset : Natural := 0;
   begin
      for I in reverse Value'range loop
         Decimal_Value := Index(Num_Digits, Value(I..I)) - 1;
         if Decimal_Value < 0 then
            raise Invalid_Digit;
         end if;
         Result := Result + (Base**Radix_Offset * Decimal_Value);
         Radix_Offset := Radix_Offset + 1;
      end loop;
      return Result;
   end To_Decimal;

   function To_Base(Value : Natural; Base : Base_Type) return String is
      use Ada.Strings.Unbounded;
      Result : Unbounded_String := Null_Unbounded_String;
      Temp : Natural := Value;
      Base_Digit : String(1..1);
   begin
      if Temp = 0 then
         return "0";
      end if;
      while Temp > 0 loop
         Base_Digit(1) := Num_Digits((Temp mod Base) + 1);
         if Result = Null_Unbounded_String then
            Append(Result, Base_Digit);
         else
            Insert(Source => Result,
               Before => 1,
               New_Item => Base_Digit);
         end if;
         Temp := Temp / Base;
      end loop;
      return To_String(Result);
   end To_Base;

begin
   Put_Line("26 converted to base 16 is " & To_Base(26, 16));
   Put_line("1a (base 16) is decimal" & Integer'image(To_Decimal("1a", 16)));
end Number_Base_Conversion;


INT base = 16, from dec = 26;
BITS to bits;

FORMAT hex repr = $n(base)r2d$;

FILE f; STRING str;

associate(f, str);
putf(f, (hex repr, BIN from dec));
print(("Hex: ",str, new line));

reset(f);
getf(f, (hex repr, to bits));
print(("Int: ",ABS to bits, new line))


begin
    % returns with numberInBase set to the number n converted to a string in %
    % the specified base. Number must be non-negative and base must be in    %
    % range 2 to 36                                                          %
    procedure convertToBase( integer    value  n
                           ; integer    value  base
                           ; string(32) result numberInBase
                           ) ;
    begin
        string(36) baseDigits;
        integer    val, strPos;

        assert( n >= 0 and base >= 2 and base <= 36 );

        baseDigits    := "0123456789abcdefghijklmnopqrstuvwxyz";
        numberInBase  := " ";
        val           := n;
        strPos        := 31;
        while
            begin
                % a(b//c) is the substring of a starting at b with length c. %
                % The first character is at position 0. The length must be   %
                % an integer literal so it is known at compile time.         %
                numberInBase( strPos // 1 ) := baseDigits( val rem base // 1 );
                val    := val div base;
                strPos := strPos - 1;
                val > 0
            end
        do begin end
    end convertToBase ;

    % returns the string numberInBase converted to an integer assuming       %
    % numberInBase ia a string in the specified base                         %
    % base must be in range 2 to 36, invalid digits will cause the program   %
    % to crash, spaces are ignored                                           %
    integer procedure convertFromBase( string(32) value numberInBase
                                     ; integer    value base
                                     ) ;
    begin
        string(36) baseDigits;
        integer    val, cPos;

        assert( base >= 2 and base <= 36 );

        baseDigits    := "0123456789abcdefghijklmnopqrstuvwxyz";
        val           := 0;
        for strPos := 0 until 31 do begin
            string(1) c;
            c := numberInBase( strPos // 1 );
            if c not = " " then begin
                cPos := 0;
                while baseDigits( cPos // 1 ) not = c do cPos := cPos + 1;
                val  := ( val * base ) + cPos;
            end
        end;
        val
    end convertFromBase ;

    % test the procedures                                                    %
    string(32) baseNumber;
    i_w := 3; % set integer output width                                     %
    for i := 2 until 36 do begin
        convertToBase( 35, i, baseNumber );
        write( 35, i, baseNumber, " ", convertFromBase( baseNumber, i ) );
    end
end.


-- toBase :: Int -> Int -> String
on toBase(intBase, n)
    if (intBase < 36) and (intBase > 0) then
        inBaseDigits(items 1 thru intBase of "0123456789abcdefghijklmnopqrstuvwxyz", n)
    else
        "not defined for base " & (n as string)
    end if
end toBase

-- inBaseDigits :: String -> Int -> [String]
on inBaseDigits(strDigits, n)
    set intBase to length of strDigits

    script nextDigit
        on |λ|(residue)
            set {divided, remainder} to quotRem(residue, intBase)
            if divided > 0 then
                {just:(item (remainder + 1) of strDigits), new:divided, nothing:false}
            else
                {nothing:true}
            end if

        end |λ|
    end script

    reverse of unfoldr(nextDigit, n) as string
end inBaseDigits

-- OTHER FUNCTIONS DERIVABLE FROM inBaseDigits -------------------------------

-- inUpperHex :: Int -> String
on inUpperHex(n)
    inBaseDigits("0123456789ABCDEF", n)
end inUpperHex

-- inDevanagariDecimal :: Int -> String
on inDevanagariDecimal(n)
    inBaseDigits("०१२३४५६७८९", n)
end inDevanagariDecimal

-- TEST ----------------------------------------------------------------------
on run
    script
        on |λ|(x)
            {{binary:toBase(2, x), octal:toBase(8, x), hex:toBase(16, x)}, ¬
                {upperHex:inUpperHex(x), dgDecimal:inDevanagariDecimal(x)}}
        end |λ|
    end script

    map(result, [255, 240])
end run

-- GENERIC FUNCTIONS ---------------------------------------------------------

-- unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
on unfoldr(f, v)
    set lst to {}
    set recM to {nothing:false, new:v}
    tell mReturn(f)
        repeat while (not (nothing of recM))
            set recM to |λ|(new of recM)
            if not nothing of recM then set end of lst to just of recM
        end repeat
    end tell
    lst
end unfoldr

--  quotRem :: Integral a => a -> a -> (a, a)
on quotRem(m, n)
    {m div n, m mod n}
end quotRem

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

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


fromBase: function [x,base][
    if base=2 [ return from.binary x ]
    if base=8 [ return from.octal x ]
    if base=16 [ return from.hex x ]

    return to :integer x
]

toBase: function [x,base][
    if base=2 [ return as.binary x ]
    if base=8 [ return as.octal x ]
    if base=16 [ return as.hex x ]

    return to :string x
]

loop 1..20 'i ->
    print [
        i "base2:" toBase i 2 "base8:" toBase i 8 "base16:" toBase i 16
    ]

print ""

print ["101 => from base2:" fromBase "101" 2 "from base8:" fromBase "101" 8 "from base16:" fromBase "101" 16]
print ["123 => from base8:" fromBase "123" 8 "from base16:" fromBase "123" 16]
print ["456 => from base8:" fromBase "456" 8 "from base16:" fromBase "456" 16]


MsgBox % number2base(200, 16) ; 12
MsgBox % parse(200, 16)  ; 512

number2base(number, base)
{
  While, base < digit := floor(number / base)
  {
    result := mod(number, base) . result
    number := digit
  }
  result := digit . result
  Return result
}

parse(number, base)
{
  result = 0
  pos := StrLen(number) - 1
  Loop, Parse, number
  {
    result := ((base ** pos) * A_LoopField) + result
    base -= 1
  }
  Return result
}


function strtol(str, base)
{
  symbols = "0123456789abcdefghijklmnopqrstuvwxyz"
  res = 0
  str = tolower(str)
  for(i=1; i < length(str); i++) {
    res += index(symbols, substr(str, i, 1)) - 1
    res *= base
  }
  res += index(symbols, substr(str, length(str), 1)) - 1
  return res
}

function ltostr(num, base)
{
  symbols = "0123456789abcdefghijklmnopqrstuvwxyz"
  res = ""
  do {
    res = substr(symbols, num%base + 1, 1) res
    num = int(num/base)
  } while ( num != 0 )
  return res
}

BEGIN {
  print strtol("7b", 16)
  print ltostr(123, 16)
}


      PRINT "  0 (decimal) -> " FNtobase(0, 16) " (base 16)"
      PRINT " 26 (decimal) -> " FNtobase(26, 16) " (base 16)"
      PRINT "383 (decimal) -> " FNtobase(383, 16) " (base 16)"
      PRINT " 26 (decimal) -> " FNtobase(26, 2) " (base 2)"
      PRINT "383 (decimal) -> " FNtobase(383, 2) " (base 2)"
      PRINT " 1a (base 16) -> " ;FNfrombase("1a", 16) " (decimal)"
      PRINT " 1A (base 16) -> " ;FNfrombase("1A", 16) " (decimal)"
      PRINT "17f (base 16) -> " ;FNfrombase("17f", 16) " (decimal)"
      PRINT "101111111 (base 2) -> " ;FNfrombase("101111111", 2) " (decimal)"
      END

      DEF FNtobase(N%, B%)
      LOCAL D%,A$
      REPEAT
        D% = N% MOD B%
        N% DIV= B%
        A$ = CHR$(48 + D% - 39*(D%>9)) + A$
      UNTIL N% = FALSE
      =A$

      DEF FNfrombase(A$, B%)
      LOCAL N%
      REPEAT
        N% *= B%
        N% += ASC(A$) - 48 + 7*(ASCA$>64) + 32*(ASCA$>96)
        A$ = MID$(A$,2)
      UNTIL A$ = ""
      = N%


get "libhdr";

// Reverse a string
let reverse(str) = valof
$(  let i = 1
    let j = str%0
    while i<j
    $(  let c = str%i
        str%i := str%j
        str%j := c
        i := i+1
        j := j-1
    $)
    resultis str
$)

// Convert number to string given base
let itoa(n, base, buf) = valof
$(  let digitchar(n) =
        n < 10 -> n + '0',
        (n - 10) + 'A'
    buf%0 := 0
    $( buf%0 := buf%0 + 1
       buf%(buf%0) := digitchar(n rem base)
       n := n / base
    $) repeatuntil n<=0
    resultis reverse(buf)
$)

// Convert string to number given base
let atoi(str, base) = valof
$(  let digitval(d, base) =
        '0' <= d <= '9' -> d - '0',
        'A' <= d <= 'Z' -> (d - 'A') + 10,
        'a' <= d <= 'z' -> (d - 'a') + 10,
        0
    let result = 0
    for i=1 to str%0 do
        result := result * base + digitval(str%i, base)
    resultis result
$)

// Examples
let start() be
$(  let buffer = vec 64

    writes("1234 in bases 2-36:*N")
    for base=2 to 36 do
        writef("Base %I2: %S*N", base, itoa(1234, base, buffer))

    writes("*N*"25*" in bases 10-36:*N")
    for base=10 to 36 do
        writef("Base %I2: %N*N", base, atoi("25", base))
$)


  ( display
  =
    .   !arg:<10
      | !arg:<36&chr$(asc$a+!arg+-10)
      | "Base too big"
  )
& ( base
  =   n b
    .     !arg:(?n.?b)
        & !n:<!b
        & ( !n:~<0&display$!n
          | NOTSUPPORTED
          )
      | base$(div$(!n.!b).!b) display$(mod$(!n.!b))
  )
&   whl
  ' (   put
      $ "Enter non-negative integer in decimal notation (or something else to stop):"
    & get':~/#>-1:?n
    & put$"Enter base (less than 37):"
    & get$:~/#>1:~>36:?b
    & out$(!n " in base " !b " is " str$(base$(!n.!b)))
    );


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

char *to_base(int64_t num, int base)
{
  char *tbl = "0123456789abcdefghijklmnopqrstuvwxyz";
  char buf[66] = {'\0'};
  char *out;
  uint64_t n;
  int i, len = 0, neg = 0;
  if (base > 36) {
    fprintf(stderr, "base %d too large\n", base);
    return 0;
  }

  /* safe against most negative integer */
  n = ((neg = num < 0)) ? (~num) + 1 : num;

  do { buf[len++] = tbl[n % base]; } while(n /= base);

  out = malloc(len + neg + 1);
  for (i = neg; len > 0; i++) out[i] = buf[--len];
  if (neg) out[0] = '-';

  return out;
}

long from_base(const char *num_str, int base)
{
  char *endptr;
  /* there is also strtoul() for parsing into an unsigned long */
  /* in C99, there is also strtoll() and strtoull() for parsing into long long and
   * unsigned long long, respectively */
  int result = strtol(num_str, &endptr, base);
  return result;
}

int main()
{
  int64_t x;
  x = ~(1LL << 63) + 1;
  printf("%lld in base 2: %s\n", x, to_base(x, 2));
  x = 383;
  printf("%lld in base 16: %s\n", x, to_base(x, 16));
  return 0;
}


public static class BaseConverter {

    /// <summary>
    /// Converts a string to a number
    /// </summary>
    /// <returns>The number.</returns>
    /// <param name="s">The string to convert.</param>
    /// <param name="b">The base number (between 2 and 36).</param>
    public static long stringToLong(string s, int b) {

        if ( b < 2 || b > 36 )
            throw new ArgumentException("Base must be between 2 and 36", "b");

        checked {

            int slen = s.Length;
            long result = 0;
            bool isNegative = false;

            for ( int i = 0; i < slen; i++ ) {

                char c = s[i];
                int num;

                if ( c == '-' ) {
                    // Negative sign
                    if ( i != 0 )
                        throw new ArgumentException("A negative sign is allowed only as the first character of the string.", "s");

                    isNegative = true;
                    continue;
                }

                if ( c > 0x2F && c < 0x3A )
                    // Numeric character (subtract from 0x30 ('0') to get numerical value)
                    num = c - 0x30;
                else if ( c > 0x40 && c < 0x5B )
                    // Uppercase letter
                    // Subtract from 0x41 ('A'), then add 10
                    num = c - 0x37;  // 0x37 = 0x41 - 10
                else if ( c > 0x60 && c < 0x7B )
                    // Lowercase letter
                    // Subtract from 0x61 ('a'), then add 10
                    num = c - 0x57;  // 0x57 = 0x61 - 10
                else
                    throw new ArgumentException("The string contains an invalid character '" + c + "'", "s");

                // Check that the digit is allowed by the base.

                if ( num >= b )
                    throw new ArgumentException("The string contains a character '" + c + "' which is not allowed in base " + b, "s");

                // Multiply the result by the base, then add the next digit

                result *= b;
                result += num;

            }

            if ( isNegative )
                result = -result;

            return result;

        }

    }

    /// <summary>
    /// Converts a number to a string.
    /// </summary>
    /// <returns>The string.</returns>
    /// <param name="n">The number to convert.</param>
    /// <param name="b">The base number (between 2 and 36).</param>
    public static string longToString(long n, int b) {

        // This uses StringBuilder, so it only works with .NET 4.0 or higher. For earlier versions, the StringBuilder
        // can be replaced with simple string concatenation.

        if ( b < 2 || b > 36 )
            throw new ArgumentException("Base must be between 2 and 36", "b");

        // If the base is 10, call ToString() directly, which returns a base-10 string.

        if ( b == 10 )
            return n.ToString();

        checked {
            long longBase = b;

            StringBuilder sb = new StringBuilder();

            if ( n < 0 ) {
                // Negative numbers
                n = -n;
                sb.Append('-');
            }

            long div = 1;
            while ( n / div >= b )
                // Continue multiplying the dividend by the base until it reaches the greatest power of
                // the base which is less than or equal to the number.
                div *= b;

            while ( true ) {
                byte digit = (byte) (n / div);

                if ( digit < 10 )
                    // Numeric character (0x30 = '0')
                    sb.Append((char) (digit + 0x30));
                else
                    // Alphabetic character (for digits > 10) (0x61 = 'a')
                    sb.Append((char) (digit + 0x57));  // 0x61 - 10

                if ( div == 1 )
                    // Stop when the dividend reaches 1
                    break;

                n %= div;
                div /= b;
            }

            return sb.ToString();
        }

    }

}


#include <string>
#include <cstdlib>
#include <algorithm>
#include <cassert>

std::string const digits = "0123456789abcdefghijklmnopqrstuvwxyz";

std::string to_base(unsigned long num, int base)
{
  if (num == 0)
    return "0";

  std::string result;
  while (num > 0) {
    std::ldiv_t temp = std::div(num, (long)base);
    result += digits[temp.rem];
    num = temp.quot;
  }
  std::reverse(result.begin(), result.end());
  return result;
}

unsigned long from_base(std::string const& num_str, int base)
{
  unsigned long result = 0;
  for (std::string::size_type pos = 0; pos < num_str.length(); ++pos)
    result = result * base + digits.find(num_str[pos]);
  return result;
}


Class Utils.Number [ Abstract ]
{

ClassMethod ConvertBase10ToN(pNum As %Integer = "", pBase As %Integer = "", pBaseStr As %String = "", pPos As %Integer = 0) As %String
{
  If pNum=0 Quit ""
  Set str=..ConvertBase10ToN(pNum\pBase, pBase, pBaseStr, pPos+1)
  Quit str_$Extract(pBaseStr, pNum#pBase+1)
}

ClassMethod ConvertBaseNTo10(pStr As %String = "", pBase As %Integer = "", pBaseStr As %String = "", pPos As %Integer = 0) As %Integer
{
  If pStr="" Quit 0
  Set num=..ConvertBaseNTo10($Extract(pStr, 1, *-1), pBase, pBaseStr, pPos+1)
  Set dec=$Find(pBaseStr, $Extract(pStr, *))-2
  Quit num+(dec*(pBase**pPos))
}

ClassMethod ConvertBase(pStr As %String = "", pFrom As %Integer = 10, pTo As %Integer = 10, pBaseStr As %String = "", pLen As %Integer = 0) As %String
{
  // some initialisation
  If pBaseStr="" Set pBaseStr="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"

  // check input values
  If pFrom=10 Set pStr=$Number(pStr, "i", 0) If pStr="" Quit ""
  Set pFrom=$Number(pFrom, "i", 2, 94) If pFrom="" Quit ""
  Set pTo=$Number(pTo, "i", 2, 94) If pTo="" Quit ""
  Set pLen=$Number(pLen, "i", 0, 32) If pLen="" Quit ""

  // does base number exceed base string?
  If pFrom>$Length(pBaseStr) Quit ""
  If pTo>$Length(pBaseStr) Quit ""

  // allow for upper/lowercase values
  If pTo=10 {
    If $Match(pStr, "^[0-9a-z]+$"), $Match($Extract(pBaseStr, 1, pFrom), "^[0-9A-Z]+$") {
      Set pStr=$ZConvert(pStr, "U")
    }
    If $Match(pStr, "^[0-9A-Z]+$"), $Match($Extract(pBaseStr, 1, pFrom), "^[0-9a-z]+$") {
      Set pStr=$ZConvert(pStr, "L")
    }
  }

  // do the conversion
  If pFrom=pTo {
    Set pStr=pStr
  } ElseIf pFrom=10 {
    Set pStr=..ConvertBase10ToN($Select(pStr=0: "", 1: pStr), pTo, pBaseStr)
  } ElseIf pTo=10 {
    Set pStr=..ConvertBaseNTo10(pStr, pFrom, pBaseStr)
  } Else {
    Set pStr=..ConvertBase10ToN(..ConvertBaseNTo10(pStr, pFrom, pBaseStr), pTo, pBaseStr)
  }

  // return value
  If pLen=0 Quit pStr
  If pTo'=10 Quit ..PadStr(pStr, pLen, $Extract(pBaseStr))
  Quit ..PadStr(pStr, pLen)
}

ClassMethod PadStr(pStr As %String, pLen As %Integer, pZero As %String = 0) As %String [ Private ]
{
  If $Length(pStr)>pLen Quit pStr
  Quit $Translate($Justify(pStr, pLen), " ", pZero)
}

}


(parse-integer "1a" :radix 16) ; returns multiple values: 26, 2
(write-to-string 26 :base 16) ; also "1A"


import std.stdio, std.conv, std.string, std.ascii;

void main() {
    "1abcd".to!int(16).writeln;

    writeln(60_272_032_366.to!string(36, LetterCase.lower), ' ',
            591_458.to!string(36, LetterCase.lower));
}


def stringToInteger := __makeInt
def integerToString(i :int, base :int) {
  return i.toString(base)
}


12> erlang:list_to_integer("ffff", 17).
78300
13> erlang:integer_to_list(63, 3).
"2100"


function to_base(integer i, integer base)
    integer rem
    sequence s
    s = ""
    while i > 0 do
        rem = remainder(i,base)
        if rem < 10 then
            s = prepend(s, '0'+rem)
        else
            s = prepend(s, 'a'-10+rem)
        end if
        i = floor(i/base)
    end while

    if length(s) = 0 then
        s = "0"
    end if

    return s
end function

function from_base(sequence s, integer base)
    integer i,d
    i = 0
    for n = 1 to length(s) do
        i *= base
        if s[n] >= '0' and s[n] <= '9' then
            d = s[n]-'0'
        elsif s[n] >= 'a' then
            d = s[n]-'a'+10
        end if
        i += d
    end for
    return i
end function


USE: math.parser

12345 16 >base .
"3039" 16 base> .


42 dup
2 base !
.   \ 101010
hex
.   \ 2A
decimal


MODULE Conversion
  IMPLICIT NONE
  CHARACTER(36) :: alphanum = "0123456789abcdefghijklmnopqrstuvwxyz"

  CONTAINS

  FUNCTION ToDecimal(base, instr)
    INTEGER :: ToDecimal
    INTEGER :: length, i, n, base
    CHARACTER(*) :: instr

    ToDecimal = 0
    length = LEN(instr)
    DO i = 1, length
      n = INDEX(alphanum, instr(i:i)) - 1
      n = n * base**(length-i)
      Todecimal = ToDecimal + n
    END DO
  END FUNCTION ToDecimal

  FUNCTION ToBase(base, number)
    CHARACTER(31) :: ToBase
    INTEGER :: base, number, i, rem

    ToBase = "                               "
    DO i = 31, 1, -1
      IF(number < base) THEN
        ToBase(i:i) = alphanum(number+1:number+1)
        EXIT
      END IF
      rem = MOD(number, base)
      ToBase(i:i) = alphanum(rem+1:rem+1)
      number = number / base
    END DO
    ToBase = ADJUSTL(ToBase)
  END FUNCTION ToBase

END MODULE Conversion

PROGRAM Base_Convert
  USE Conversion

  WRITE (*,*) ToDecimal(16, "1a")
  WRITE (*,*) ToBase(16, 26)

END PROGRAM


' FB 1.05.0 Win64

Function min(x As Integer, y As Integer) As Integer
  Return IIf(x < y, x, y)
End Function

Function convertToBase (n As UInteger, b As UInteger) As String
  If n < 2 OrElse b < 2 OrElse b = 10 OrElse b > 36 Then Return Str(n)
  Dim result As String = ""
  Dim digit As Integer
  While n > 0
    digit = n Mod b
    If digit < 10 Then
      result = digit & result
    Else
      result = Chr(digit + 87) + result
    End If
     n \= b
  Wend
  Return result
End Function

Function convertToDecimal (s As Const String, b As UInteger) As UInteger
  If b < 2 OrElse b > 36 Then Return 0
  Dim t As String = LCase(s)
  Dim result As UInteger = 0
  Dim digit As Integer
  Dim multiplier As Integer = 1
  For i As Integer = Len(t) - 1 To 0 Step - 1
     digit = -1
     If t[i] >= 48 AndAlso t[i] <= min(57, 47 + b) Then
       digit = t[i] - 48
     ElseIf b > 10 AndAlso t[i] >= 97 AndAlso t[i] <= min(122, 87 + b) Then
       digit = t[i] - 87
     End If
     If digit = -1 Then Return 0 '' invalid digit present
     If digit > 0 Then result += multiplier * digit
     multiplier *= b
  Next
  Return result
End Function

Dim s As String

For b As UInteger = 2 To 36
  Print "36 base ";
  Print Using "##"; b;
  s = ConvertToBase(36, b)
  Print " = "; s; Tab(21); " -> base ";
  Print Using "##"; b;
  Print " = "; convertToDecimal(s, b)
Next

Print
Print "Press any key to quit"
Sleep


package main

import (
    "fmt"
    "math/big"
    "strconv"
)

func main () {
    s := strconv.FormatInt(26, 16) // returns the string "1a"
    fmt.Println(s)

    i, err := strconv.ParseInt("1a", 16, 64) // returns the integer (int64) 26
    if err == nil {
        fmt.Println(i)
    }
    b, ok := new(big.Int).SetString("1a", 16) // returns the big integer 26
    if ok {
        fmt.Println(b)
    }
}


def radixParse = { s, radix -> Integer.parseInt(s, radix) }
def radixFormat = { i, radix -> Integer.toString(i, radix) }


Prelude> Numeric.showIntAtBase 16 Char.intToDigit 42 ""
"2a"
Prelude> fst $ head $ Numeric.readInt 16 Char.isHexDigit Char.digitToInt "2a"
42


CHARACTER txt*80

    num = 36^7 -1                ! 7836416410
    CALL DecToBase(num, txt, 36)
    WRITE(ClipBoard, Name) num, txt, BaseToDec(36, txt)
 END

FUNCTION BaseToDec(base, string)
 CHARACTER string
    BaseToDec = 0
    length = LEN_TRIM(string)
    DO i = 1, length
      n = INDEX("0123456789abcdefghijklmnopqrstuvwxyz", string(i)) - 1
      BaseToDec = BaseToDec + n * base^(length-i)
    ENDDO
 END

SUBROUTINE DectoBase(decimal, string, base)
 CHARACTER string
    string = '0'
    temp = decimal
    length = CEILING( LOG(decimal+1, base) )
    DO i = length, 1, -1
      n = MOD( temp, base )
      string(i) = "0123456789abcdefghijklmnopqrstuvwxyz"(n+1)
      temp = INT(temp / base)
    ENDDO
 END


procedure main()
   every ( ns := "16r5a" | "-12r1a" ) &
         ( b := 8 | 12 | 16 ) do {
         ns2 := convert(n := numeric(ns),b)
         printf("ns=%s -> n=%d -> %s\n",ns,n,ns2)
      }
end

link printf

procedure convert(i,b)                 #: convert i to base b radix representation
static digits
initial digits := &digits || &lcase

   i := integer(i) | runerr(101, i)    # arg/error checking
   /b := 10 | ( 2 < (b := integer(b)) <= *digits ) | runerr(205,b)

   if b = 10 then return i
   else {
      p := (s := "", (i := -(0 > i),"-")|"") || b || "r" # prefix/setup
      until i = 0 & *s > 0 do
         s ||:= digits[1 + 1( i % b, i /:= b)]

      return p || reverse(s)
      }
end


public static long backToTen(String num, int oldBase){
   return Long.parseLong(num, oldBase); //takes both uppercase and lowercase letters
}

public static String tenToBase(long num, int newBase){
   return Long.toString(num, newBase);//add .toUpperCase() for capital letters
}


k = 26
s = k.toString(16) //gives 1a
i = parseInt('1a',16) //gives 26
//optional special case for hex:
i = +('0x'+s) //hexadecimal base 16, if s='1a' then i=26.


# Convert the input integer to a string in the specified base (2 to 36 inclusive)
def convert(base):
  def stream:
    recurse(if . > 0 then ./base|floor else empty end) | . % base ;
  if . == 0 then "0"
  else  [stream] | reverse | .[1:]
  | if   base <  10 then map(tostring) | join("")
    elif base <= 36 then map(if . < 10 then 48 + . else . + 87 end) | implode
    else error("base too large")
    end
  end;

# input string is converted from "base" to an integer, within limits
# of the underlying arithmetic operations, and without error-checking:
def to_i(base):
  explode
  | reverse
  | map(if . > 96  then . - 87 else . - 48 end)  # "a" ~ 97 => 10 ~ 87
  | reduce .[] as $c
      # state: [power, ans]
      ([1,0]; (.[0] * base) as $b | [$b, .[1] + (.[0] * $c)])
  | .[1];


@show string(185, base=2)
@show string(185, base=3)
@show string(185, base=4)
@show string(185, base=5)
@show string(185, base=6)
@show string(185, base=7)
@show string(185, base=8)
@show string(185, base=9)
@show string(185, base=10)
@show string(185, base=11)
@show string(185, base=12)
@show string(185, base=13)
@show string(185, base=14)
@show string(185, base=15)
@show string(185, base=16)


// version 1.0.6

fun min(x: Int, y: Int) = if (x < y) x else y

fun convertToBase(n: Int, b: Int): String {
    if (n < 2 || b < 2 || b == 10 || b > 36) return n.toString() // leave as decimal
    val sb = StringBuilder()
    var digit: Int
    var nn = n
    while (nn > 0) {
        digit = nn % b
        if (digit < 10) sb.append(digit)
        else            sb.append((digit + 87).toChar())
        nn /= b
    }
    return sb.reverse().toString()
}

fun convertToDecimal(s: String, b: Int): Int {
    if (b !in 2..36) throw IllegalArgumentException("Base must be between 2 and 36")
    if (b == 10) return s.toInt()
    val t = s.toLowerCase()
    var result = 0
    var digit: Int
    var multiplier = 1
    for (i in t.length - 1 downTo 0) {
        digit = -1
        if (t[i] >= '0' && t[i] <= min(57, 47 + b).toChar())
            digit = t[i].toInt() - 48
        else if (b > 10 && t[i] >= 'a' && t[i] <= min(122, 87 + b).toChar())
            digit = t[i].toInt() - 87
        if (digit == -1) throw IllegalArgumentException("Invalid digit present")
        if (digit > 0) result += multiplier * digit
        multiplier *= b
    }
    return result
}

fun main(args: Array<String>) {
    for (b in 2..36) {
        val s = convertToBase(36, b)
        val f = "%2d".format(b)
        println("36 base $f = ${s.padEnd(6)} -> base $f = ${convertToDecimal(s, b)}")
    }
}


   '   Base Converter v6

    global      alphanum$
    alphanum$   ="0123456789abcdefghijklmnopqrstuvwxyz"

    for i =1 to 20
    RandNum     =   int( 100 *rnd( 1))
    base        =2 +int( 35  *rnd( 1))

    print "Decimal "; using( "###", RandNum); " to base "; using( "###", base);_
         " is "; toBase$( base,  RandNum),_
         " back to dec. "; toDecimal( base, toBase$( base, RandNum))
    next i

    end '   ___________________________________________________________

    function toBase$( base, number) '   Convert decimal variable to number string.
        toBase$             =""
        for i =10 to 1 step -1
            remainder   =number mod base
            toBase$     =mid$( alphanum$, remainder +1, 1) +toBase$
            number      =int( number /base)
            if number <1 then exit for
        next i
    end function

    function toDecimal( base, s$)   '   Convert number string to decimal variable.
        toDecimal   =0
        for i =1 to len( s$)
            toDecimal =toDecimal *base +instr( alphanum$, mid$( s$, i, 1), 1) -1
        next i
    end function


function dec2base (base, n)
    local result, digit = ""
    while n > 0 do
        digit = n % base
        if digit > 9 then digit = string.char(digit + 87) end
        n = math.floor(n / base)
        result = digit .. result
    end
    return result
end

local x = dec2base(16, 26)
print(x)                    --> 1a
print(tonumber(x, 16))      --> 26


#converts a number to a given based represented by a string
to_base := proc(num, based)
  local i;
  local chart := "0123456789abcdefghijklmnopqrstuvwxyz";
  local conversion := ListTools:-Reverse((convert(num,base,based)));
  local str := StringTools:-StringBuffer();
  for i in conversion do
    str:-append(chart[i+1]);
  end do;
  return str;
end proc:

#find the location of char in chart
find_digit := proc(char)
  if (StringTools:-HasAlpha(char)) then
    return (StringTools:-Ord(char) - 87);
  else
    return (StringTools:-Ord(char) - 48);
  end if;
end proc:

#converts a string  with given base to a number
from_base := proc(str, base)
  local char;
  local result := 0;
  for char in str do
    result *= base;
    result += find_digit(char);
  end do;
  return result;
end proc:


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

import java.math.BigInteger

numeric digits 200

parse arg input -- input should be val, radix; no input results in using default test data
-- test data - number pairs where 1st is value and 2nd is target radix
inputs = [ -
  '1234,         10', '01234,  8', 'fe,  16', 'f0e,   16', -
  '0,            10', '00,     2', '11,   2', '070,    8', -
  '77,            8', 'f0e,   16', '070, 16', '0xf0e, 36', -
  '000999ABCXYZ, 36', 'ff,    36', 'f,   16', 'z,     37'  -
  ]
if input.length() > 0 then inputs = [input] -- replace test data with user input

loop i_ = 0 to inputs.length - 1
  do
    in = inputs[i_]
    parse in val . ',' radix .
    valB = toDecimal(val, radix)        -- NetRexx default is to store digits as Rexx strings
    valD = fromDecimal(valB + 0, radix) -- Add zero just to prove the result treated as a number
    say val.right(16)'['radix.right(2, 0)']:' valB.right(16)'[10] ==' valD.right(16)'['radix.right(2, 0)']'
  catch nx = NumberFormatException
    say 'Error -- Input:' val', radix:' radix
    nx.printStackTrace()
  end
  end i_

return

method toDecimal(val = String, radix = int 10) public static returns Rexx
  bi = BigInteger(val, radix)
  return bi.toString()

method fromDecimal(val = String, radix = int 10) public static returns Rexx
  bi = BigInteger(val.toString(), 10)
  return bi.toString(radix)


import strutils

proc reverse(a: string): string =
  result = newString(a.len)
  for i, c in a:
    result[a.high - i] = c

const digits = "0123456789abcdefghijklmnopqrstuvwxyz"

proc toBase[T](num: T, base: range[2..36]): string =
  if num == 0: return "0"
  result = ""
  if num < 0: result.add '-'
  var tmp = abs(num)
  var s = ""
  while tmp > 0:
    s.add digits[int(tmp mod base)]
    tmp = tmp div base
  result.add s.reverse

proc fromBase(str: string, base: range[2..36]): BiggestInt =
  var str = str
  let first = if str[0] == '-': 1 else: 0

  for i in first .. str.high:
    let c = str[i].toLowerAscii
    assert c in digits[0 ..< base]
    result = result * base + digits.find c

  if first == 1: result *= -1

echo 26.toBase 16
echo "1a".fromBase 16


let int_of_basen n str =
  match n with
  | 16 -> int_of_string("0x" ^ str)
  |  2 -> int_of_string("0b" ^ str)
  |  8 -> int_of_string("0o" ^ str)
  | _ -> failwith "unhandled"

let basen_of_int n d =
  match n with
  | 16 -> Printf.sprintf "%x" d
  |  8 -> Printf.sprintf "%o" d
  | _ -> failwith "unhandled"


Program ConvertDemo(output);

uses
  Math, SysUtils;

const
  alphanum = '0123456789abcdefghijklmnopqrstuvwxyz';

function ToDecimal(base: integer; instring: string): integer;
  var
    inlength, i, n: integer;
  begin
    ToDecimal := 0;
    inlength := length(instring);
    for i := 1 to inlength do
    begin
      n := pos(instring[i], alphanum) - 1;
      n := n * base**(inlength-i);
      Todecimal := ToDecimal + n;
    end;
  end;

function ToBase(base, number: integer): string;
  var
    i, rem: integer;
  begin
    ToBase :='                               ';
    for i := 31 downto 1 do
    begin
      if (number < base) then
      begin
        ToBase[i] := alphanum[number+1];
        break;
      end;
      rem := number mod base;
      ToBase[i] := alphanum[rem+1];
      number := number div base;
    end;
    ToBase := trimLeft(ToBase);
  end;

begin
  writeln ('1A: ', ToDecimal(16, '1a'));
  writeln ('26: ', ToBase(16, 26));
end.


sub to2  { sprintf "%b", shift; }
sub to16 { sprintf "%x", shift; }
sub from2  { unpack("N", pack("B32", substr("0" x 32 . shift, -32))); }
sub from16 { hex(shift); }


base_convert("26", 10, 16); // returns "1a"


(de numToString (N Base)
   (default Base 10)
   (let L NIL
      (loop
         (let C (% N Base)
            (and (> C 9) (inc 'C 39))
            (push 'L (char (+ C `(char "0")))) )
         (T (=0 (setq N (/ N Base)))) )
      (pack L) ) )

(de stringToNum (S Base)
   (default Base 10)
   (let N 0
      (for C (chop S)
         (when (> (setq C (- (char C) `(char "0"))) 9)
            (dec 'C 39) )
         (setq N (+ C (* N Base))) )
      N ) )

(prinl (numToString 26 16))
(prinl (stringToNum "1a" 16))
(prinl (numToString 123456789012345678901234567890 36))


convert: procedure (N, base) returns (character (64) varying) recursive;
   declare N fixed binary (31), base fixed binary;
   declare table (0:15) character (
      '0', '1', '2', '3', '4', '5', '6', '7',
      '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
   declare s character (64) varying;

   if N = 0 then return ('');

   s = convert(N/base, base);
   return (s || table(mod(N, base)) );
end convert;


100H:

/* CONVERT A NUMBER TO A GIVEN BASE */
TO$BASE: PROCEDURE (N, BASE, BUF) ADDRESS;
    DECLARE (N, BUF, I, J, K) ADDRESS;
    DECLARE (D, BASE, STR BASED BUF) BYTE;

    /* GENERATE DIGITS */
    I = 0;
DIGIT:
    D = N MOD BASE;
    N = N / BASE;
    IF D < 10 THEN STR(I) = D + '0';
    ELSE STR(I) = (D - 10) + 'A';
    I = I + 1;
    IF N > 0 THEN GO TO DIGIT;

    /* PUT DIGITS IN HIGH-ENDIAN ORDER */
    J = 0;
    K = I-1;
    DO WHILE (J < K);
        D = STR(K);
        STR(K) = STR(J);
        STR(J) = D;
        K = K-1;
        J = J+1;
    END;

    STR(I) = '$';
    RETURN BUF;
END TO$BASE;

/* READ A NUMBER IN A GIVEN BASE */
FROM$BASE: PROCEDURE (BUF, BASE) ADDRESS;
    DECLARE (BUF, RESULT) ADDRESS;
    DECLARE (D, BASE, CHAR BASED BUF) BYTE;

    RESULT = 0;
    DO WHILE CHAR <> '$';
        D = CHAR - '0';
        IF D >= 10 THEN D = D - ('A' - '0') + 10;
        RESULT = (RESULT * BASE) + D;
        BUF = BUF + 1;
    END;
    RETURN RESULT;
END FROM$BASE;

/* CP/M BDOS ROUTINES */
BDOS: PROCEDURE (F,A); DECLARE F BYTE, A ADDRESS; GO TO 5; END BDOS;
EXIT: PROCEDURE; CALL BDOS(0,0); END EXIT;
PRINT: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9,S); END PRINT;
CRLF: PROCEDURE; CALL PRINT(.(13,10,'$')); END CRLF;

/* EXAMPLES */
DECLARE I BYTE, N ADDRESS;

CALL PRINT(.'1234 IN BASES 2-36: $'); CALL CRLF;
DO I=2 TO 36;
    CALL PRINT(.'BASE $');
    CALL PRINT(TO$BASE(I, 10, .MEMORY));
    CALL PRINT(.(': ',9,'$'));
    CALL PRINT(TO$BASE(1234, I, .MEMORY));
    CALL CRLF;
END;

CALL PRINT(.'''25'' IN BASES 10-36: $'); CALL CRLF;
DO I=10 TO 36;
    CALL PRINT(.'BASE $');
    CALL PRINT(TO$BASE(I, 10, .MEMORY));
    CALL PRINT(.(':',9,'$'));
    N = FROM$BASE(.'25$', I);
    CALL PRINT(TO$BASE(N, 10, .MEMORY));
    CALL CRLF;
END;

CALL EXIT;
EOF


define number_to_base(n, base);
    radix_apply(n, '%p', sprintf, base);
enddefine;


Global alphanum$ = "0123456789abcdefghijklmnopqrstuvwxyz" ;36 digits
#maxIntegerBitSize = SizeOf(Integer) * 8

Procedure toDecimal(base, s.s)
  Protected length, i, toDecimal

  length = Len(s)
  If length: toDecimal = FindString(alphanum$, Left(s, 1), 1) - 1: EndIf

  For i = 2 To length
    toDecimal * base + FindString(alphanum$, Mid(s, i, 1), 1) - 1
  Next
  ProcedureReturn toDecimal
EndProcedure

Procedure.s toBase(base, number)
  Protected i, rem, toBase.s{#maxIntegerBitSize} = Space(#maxIntegerBitSize)

  For i = #maxIntegerBitSize To 1 Step -1
    rem = number % base
    PokeC(@toBase + i - 1, PeekC(@alphanum$ + rem))
    If number < base: Break: EndIf
    number / base
  Next
  ProcedureReturn LTrim(toBase)
EndProcedure

If OpenConsole()
  PrintN( Str(toDecimal(16, "1a")) )

  PrintN( toBase(16, 26) )

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


i = int('1a',16)  # returns the integer 26


( [ $ '' over abs
    [ base share /mod digit
      rot join swap
      dup 0 = until ]
      drop
      swap 0 < if
        [ $ '-' swap join ] ] is number$ (   n --> $ )

  [ base put
    number$
    base release
    $ '' swap
    witheach
      [ lower join ] ]        is >base$  ( n b --> $ )

  say "The number 2970609818455516403037 in hexatrigesimal is "
  2970609818455516403037 36 >base$ echo$
  say "."


int2str <- function(x, b) {
  if(x==0) return("0")
  if(x<0) return(paste0("-", base(-x,b)))

  map <- c(as.character(0:9), letters)
  res <- ""
  while (x>0) {
    res <- c(map[x %% b + 1], res)
    x <- x %/% b
  }
  return(paste(res, collapse=""))
}

str2int <- function(s, b) {
  map <- c(as.character(0:9), letters)
  s <- strsplit(s,"")[[1]]
  res <- sapply(s, function(x) which(map==x))
  res <- as.vector((res-1) %*% b^((length(res)-1):0))
  return(res)
}

## example: convert 255 to hex (ff):
int2str(255, 16)

## example: convert "1a" in base 16 to integer (26):
str2int("1a", 16)


#lang racket

;; Both assume valid inputs
(define (num->str N r)
  (let loop ([N N] [digits '()])
    (define-values [N1 d] (quotient/remainder N r))
    (define digits1 (cons (integer->char (+ d (if (< d 10) 48 55))) digits))
    (if (zero? N) (list->string digits1) (loop N1 digits1))))
(define (str->num S r)
  (for/fold ([N 0])
            ([B (string->bytes/utf-8 (string-upcase S))])
    (+ (* N r) (- B (if (< 64 B) 55 48)))))

;; To try it out:
(define (random-test)
  (define N (random 1000000))
  (define r (+ 2 (random 35)))
  (define S (num->str N r))
  (define M (str->num S r))
  (printf "~s -> ~a#~a -> ~a => ~a\n" N S r M (if (= M N) 'OK 'BAD)))
;; (random-test)


sub from-base(Str $str, Int $base) {
    +":$base\<$str>";
}

sub to-base(Real $num, Int $base) {
    $num.base($base);
}


        ┌────────────────────────────────────────────────────────────────────┐
      ┌─┘ Input to this program     (bases must be positive integers > 1):   └─┐
      │                                                                        │
      │                       x        is required  (it may have a sign).      │
      │                     toBase     the base to convert   X   to.           │
      │                     inBase     the base  X  is expressed in.           │
      │                                                                        │
      │  If  X  has a leading sign,  it is maintained (kept) after conversion. │
      │                                                                        │
      │  toBase   or   inBase    can be a comma (,)  which causes the default  │
      └─┐ of  10  to be used.    The limits of bases are:    2 ──► 90.       ┌─┘
        └────────────────────────────────────────────────────────────────────┘


# Project : Non-decimal radices/Convert

see "0 (decimal) -> " + hex(0) + " (base 16)" + nl
see "26 (decimal) -> " + hex(26) + " (base 16)" + nl
see "383 (decimal) -> " + hex(383) + " (base 16)" + nl
see "26 (decimal) -> " + tobase(26, 2) + " (base 2)" + nl
see "383 (decimal) -> " + tobase(383, 2)  + " (base 2)" + nl
see "1a (base 16) -> " + dec("1a") + " (decimal)" + nl
see "1A (base 16) -> " + dec("1A") + " (decimal)" + nl
see "17f (base 16) -> " + dec("17f") + " (decimal)" + nl
see "101111111 (base 2) -> " + bintodec("101111111") + " (decimal)" + nl

func tobase(nr, base)
     binary = 0
     i = 1
     while(nr != 0)
           remainder = nr % base
           nr = floor(nr/base)
           binary= binary + (remainder*i)
           i = i*10
     end
     return string(binary)

func bintodec(bin)
     binsum = 0
     for n=1  to len(bin)
         binsum = binsum + number(bin[n]) *pow(2, len(bin)-n)
     next
     return binsum


class String
  def convert_base(from, to)
    Integer(self, from).to_s(to)
    # self.to_i(from).to_s(to) #if you don't want exceptions
  end
end

# first three taken from TCL
p "12345".convert_base(10, 23) # => "107h"
p "107h".convert_base(23, 7) # =>"50664"
p "50664".convert_base(7, 10) # =>"12345"
p "1038334289300125869792154778345043071467300".convert_base(10, 36) # =>"zombieseatingdeadvegetables"
p "ff".convert_base(15, 10) # => ArgumentError


global    basCvt$
basCvt$   ="0123456789abcdefghijklmnopqrstuvwxyz"
html "

Decimal	To Base	Num	to Dec
"

for i =1 to 10
  RandNum     =    int(100 * rnd(1))
  base        = 2 +int(35  * rnd(1))

  html "
";using("###", RandNum);"	";using("###", base);"	";toBase$(base,RandNum);"	";toDecimal( base, toBase$( base, RandNum));"
"
next i
html "
"
end

function toBase$(b,n) '   b=base n=nmber
  toBase$             =""
  for i =10 to 1 step -1
     toBase$     =mid$(basCvt$,n mod b +1,1) +toBase$
    n      =int( n /b)
    if n <1 then exit for
  next i
end function

function toDecimal( b, s$)   '   scring number to decimal
  toDecimal   =0
  for i =1 to len( s$)
    toDecimal = toDecimal * b + instr(basCvt$,mid$(s$,i,1),1) -1
  next i
end function


fn format_with_radix(mut n: u32, radix: u32) -> String {
    assert!(2 <= radix && radix <= 36);

    let mut result = String::new();

    loop {
        result.push(std::char::from_digit(n % radix, radix).unwrap());
        n /= radix;
        if n == 0 {
            break;
        }
    }

    result.chars().rev().collect()
}

#[cfg(test)]
#[test]
fn test() {
    for value in 0..100u32 {
        for radix in 2..=36 {
            let s = format_with_radix(value, radix);
            let v = u32::from_str_radix(s.as_str(), radix).unwrap();
            assert_eq!(value, v);
        }
    }
}

fn main() -> Result<(), Box<dyn std::error::Error>> {
    println!("{}", format_with_radix(0xdeadbeef, 2));
    println!("{}", format_with_radix(0xdeadbeef, 36));
    println!("{}", format_with_radix(0xdeadbeef, 16));
    println!("{}", u32::from_str_radix("DeadBeef", 16)?);
    Ok(())
}


V s = ‘100’
L(base) 2..20
   print(‘String '#.' in base #. is #. in base 10’.format(s, base, Int(s, radix' base)))


def backToBig(num: String, oldBase: Int): BigInt = BigInt(num, oldBase)

def bigToBase(num: BigInt, newBase: Int): String = num.toString(newBase)


$ include "seed7_05.s7i";
  include "bigint.s7i";

const proc: main is func
  begin
    writeln(60272032366_ radix 36);      # Convert bigInteger to string
    writeln(591458 radix 36);            # Convert integer to string

    writeln(bigInteger("rosetta", 36));  # Convert string to bigInteger
    writeln(integer("code", 36));        # Convert string to integer
  end func;


say 60272032366.base(36)    # convert number to string
say Number("rosetta", 36)   # convert string to number


26 printString &radix: 16
Integer readFrom: '1A' &radix: 16.


with Ada.Text_IO;
procedure Numbers is
   package Int_IO is new Ada.Text_IO.Integer_IO (Integer);
   package Float_IO is new Ada.Text_IO.Float_IO (Float);
begin
   Int_IO.Put (Integer'Value ("16#ABCF123#"));
   Ada.Text_IO.New_Line;
   Int_IO.Put (Integer'Value ("8#7651#"));
   Ada.Text_IO.New_Line;
   Int_IO.Put (Integer'Value ("2#1010011010#"));
   Ada.Text_IO.New_Line;
   Float_IO.Put (Float'Value ("16#F.FF#E+2"));
   Ada.Text_IO.New_Line;
end Numbers;


main:
(
  FILE fbuf; STRING sbuf;

  OP FBUF = (STRING in sbuf)REF FILE: (
    sbuf := in sbuf;
    associate(fbuf, sbuf);
    fbuf
  );

  BITS num;

  getf(FBUF("0123459"), ($10r7d$, num));
  printf(($gl$, ABS num)); # prints 123459 #

  getf(FBUF("abcf123"), ($16r7d$, num));
  printf(($gl$, ABS num)); # prints 180154659 #

  getf(FBUF("7651"), ($8r4d$, num));
  printf(($gl$, ABS num)); # prints 4009 #

  getf(FBUF("1010011010"), ($2r10d$, num));
  printf(($gl$, ABS num)) # prints 666 #

)


print to :integer "10"      ; 10

print from.hex "10"         ; 16
print from.octal "120"      ; 80
print from.binary "10101"   ; 21


26 printStringRadix:16 -> '1A'
Integer readFrom:'1A' radix:16 -> 26

2 to:36 do:[:radix |
    'radix %2d: %s\n' printf:{radix . 100 printStringRadix:radix } on:Transcript.
].


fun toBase b v = let
  fun toBase' (a, 0) = a
    | toBase' (a, v) = toBase' (v mod b :: a, v div b)
in
  toBase' ([], v)
end

fun fromBase b ds =
  foldl (fn (k, n) => n * b + k) 0 ds

val toAlphaDigits = let
  fun convert n = if n < 10 then chr (n + ord #"0")
                            else chr (n + ord #"a" - 10)
in
  implode o map convert
end

val fromAlphaDigits = let
  fun convert c = if      Char.isDigit c then ord c - ord #"0"
                  else if Char.isUpper c then ord c - ord #"A" + 10
                  else if Char.isLower c then ord c - ord #"a" + 10
                  else raise Match
in
  map convert o explode
end


println(String(26, radix: 16)) // prints "1a"


namespace eval baseconvert {
    variable chars "0123456789abcdefghijklmnopqrstuvwxyz"
    namespace export baseconvert
}
proc baseconvert::dec2base {n b} {
    variable chars
    expr {$n == 0 ? 0
          : "[string trimleft [dec2base [expr {$n/$b}] $b] 0][string index $chars [expr {$n%$b}]]"
    }
}
proc baseconvert::base2dec {n b} {
    variable chars
    set sum 0
    foreach char [split $n ""] {
        set d [string first $char [string range $chars 0 [expr {$b - 1}]]]
        if {$d == -1} {error "invalid base-$b digit '$char' in $n"}
        set sum [expr {$sum * $b + $d}]
    }
    return $sum
}
proc baseconvert::baseconvert {n basefrom baseto} {
    dec2base [base2dec $n $basefrom] $baseto
}

namespace import baseconvert::baseconvert
baseconvert 12345 10 23 ;# ==> 107h
baseconvert 107h 23 7   ;# ==> 50664
baseconvert 50664 7 10  ;# ==> 12345


      REM VAL parses decimal strings:
      PRINT VAL("0")
      PRINT VAL("123456789")
      PRINT VAL("-987654321")

      REM EVAL can be used to parse binary and hexadecimal strings:
      PRINT EVAL("%10101010")
      PRINT EVAL("%1111111111")
      PRINT EVAL("&ABCD")
      PRINT EVAL("&FFFFFFFF")


#include <stdio.h>

int main()
{
  int num;

  sscanf("0123459", "%d", &num);
  printf("%d\n", num); /* prints 123459 */

  sscanf("abcf123", "%x", &num);
  printf("%d\n", num); /* prints 180154659 */

  sscanf("7651", "%o", &num);
  printf("%d\n", num); /* prints 4009 */

  /* binary not supported */

  return 0;
}


using System;

class Program
{
    static void Main()
    {
        var value = "100";
        var fromBases = new[] { 2, 8, 10, 16 };
        var toBase = 10;
        foreach (var fromBase in fromBases)
        {
            Console.WriteLine("{0} in base {1} is {2} in base {3}",
                value, fromBase, Convert.ToInt32(value, fromBase), toBase);
        }
    }
}


#include <iostream>
#include <sstream>

int main()
{
  int num;

  std::istringstream("0123459") >> num;
  std::cout << num << std::endl; // prints 123459

  std::istringstream("0123459") >> std::dec >> num;
  std::cout << num << std::endl; // prints 123459

  std::istringstream("abcf123") >> std::hex >> num;
  std::cout << num << std::endl; // prints 180154659

  std::istringstream("7651") >> std::oct >> num;
  std::cout << num << std::endl; // prints 4009

  // binary not supported

  return 0;
}


#import std
#import nat

num_to_string "b" = ||'0'! (-: num digits--letters)*+ @NiX ~&r->l ^|rrPlCrlPX/~& division\"b"

string_to_num "b" = @x =>0 sum^|/(-:@rlXS num digits--letters) product/"b"


Private Function to_base(ByVal number As Long, base As Integer) As String
    Dim digits As String, result As String
    Dim i As Integer, digit As Integer
    digits = "0123456789abcdefghijklmnopqrstuvwxyz"
    Do While number > 0
        digit = number Mod base
        result = Mid(digits, digit + 1, 1) & result
        number = number \ base
    Loop
    to_base = result
End Function
Private Function from_base(number As String, base As Integer) As Long
    Dim digits As String, result As Long
    Dim i As Integer
    digits = "0123456789abcdefghijklmnopqrstuvwxyz"
    result = Val(InStr(1, digits, Mid(number, 1, 1), vbTextCompare) - 1)
    For i = 2 To Len(number)
        result = result * base + Val(InStr(1, digits, Mid(number, i, 1), vbTextCompare) - 1)
    Next i
    from_base = result
End Function
Public Sub Non_decimal_radices_Convert()
    Debug.Print "26 decimal in base 16 is: "; to_base(26, 16); ". Conversely, hexadecimal 1a in decimal is: "; from_base("1a", 16)
End Sub


import "/fmt" for Conv

System.print(Conv.itoa(26, 16))
System.print(Conv.atoi("1a", 16))


(parse-integer "abc" :radix 20 :junk-allowed t) ; => 4232


import std.stdio, std.conv;

void main() {
    immutable text = "100";
    foreach (base; 2 .. 21)
        writefln("String '%s' in base %d is  %d in base 10" ,
                 text, base, to!int(text, base));
}


iex(1)> String.to_integer("1000")
1000
iex(2)> String.to_integer("1000",2)
8
iex(3)> String.to_integer("1000",8)
512
iex(4)> String.to_integer("1000",16)
4096
iex(5)> String.to_integer("ffff",16)
65535


<12> erlang:list_to_integer("ffff", 17).
78300


let value = "100"
let fromBases = [ 2; 8; 10; 16 ]
let values = Seq.initInfinite (fun i -> value)
Seq.zip fromBases (Seq.zip values fromBases |> Seq.map (System.Convert.ToInt32))
|> Seq.iter (
    fun (fromBase, valueFromBaseX) ->
        printfn "%s in base %i is %i in base 10" value fromBase valueFromBaseX)


include c:\cxpl\codes;  \intrinsic 'code' declarations
string 0;               \use zero-terminated string convention

func Num2Str(N, B);     \Convert integer N to a numeric string in base B
int  N, B;
char S(32); int I;
[I:= 31;
S(31):= 0;              \terminate string
repeat  I:= I-1;
        N:= N/B;
        S(I):= rem(0) + (if rem(0)<=9 then ^0 else ^a-10);
until   N=0;
return @S(I);           \BEWARE! very temporary string space
];

func Str2Num(S, B);     \Convert numeric string S in base B to an integer
char S; int B;
int  I, N;
[I:= 0;  N:= 0;
while S(I) do
        [N:= N*B + S(I) - (if S(I)<=^9 then ^0 else ^a-10);  I:= I+1];
return N;
];

[Text(0, Num2Str(0, 10));               CrLf(0);
 Text(0, Num2Str(26, 16));              CrLf(0);
 Text(0, Num2Str($7FFF_FFFF, 2));       CrLf(0);
 IntOut(0, Str2Num("0100", 2));         CrLf(0);
 IntOut(0, Str2Num("1a", 16));          CrLf(0);
 IntOut(0, Str2Num("deadbeef", 16));    CrLf(0);
]


   ( scratchpad ) "ff" hex> . ! base 16
   255
   ( scratchpad ) "777" oct> . ! base 8
   511
   ( scratchpad ) "1111" bin> . ! base 2
   15
   ( scratchpad ) "99" string>number . ! base 10
   99


: parse# ( str len -- u true | false )
   0. 2SWAP DUP >R >NUMBER NIP NIP
   R> <> DUP 0= IF NIP THEN ;

: base# ( str len base -- u true | false )
  BASE @ >R  BASE !  parse#  R> BASE ! ;


program Example
  implicit none

  integer :: num
  character(32) :: str

  str = "0123459"
  read(str, "(i10)") num   ! Decimal
  write(*,*) num           ! Prints 123459

  str = "abcf123"
  read(str, "(z8)") num    ! Hexadecimal
  write(*,*) num           ! Prints 180154659

  str = "7651"
  read(str, "(o11)") num   ! Octal
  write(*,*) num           ! Prints 4009

  str = "1010011010"
  read(str, "(b32)") num   ! Binary
  write(*,*) num           ! Prints 666

end program


' FB 1.05.0 Win64

Dim s(1 To 4) As String = {"&H1a", "26", "&O32", "&B11010"} '' 26 in various bases
For i As Integer = 1 To 4
  Print s(i); Tab(9); "="; CInt(s(i))
Next

Sleep


program readIntegers(input, output);
var
	i: aluSInt;
begin
	while not EOF(input) do
	begin
		readLn(i);
		writeLn(i:24);
	end;
end.


package main

import (
    "fmt"
    "math/big"
    "strconv"
)

func main() {
    // package strconv:  the most common string to int conversion,
    // base 10 only.
    x, _ := strconv.Atoi("13")
    fmt.Println(x)

    // ParseInt handles arbitrary bases from 2 to 36, and returns
    // a result of the requested size (64 bits shown here.)
    // If the base argument is zero the base is determined by prefix
    // as with math/big below.
    x64, _ := strconv.ParseInt("3c2", 19, 64)
    fmt.Println(x64)

    // package fmt:  allows direct conversion from strings, standard
    // input, or from an io.Reader (file, buffer, etc) to integer types
    // for bases 2, 8, 10, and 16 or to any type that implements the
    // fmt.Scanner interface (e.g. a big.Int).
    // (Fscanf and Scanf are more common for reading from
    // an io.Reader or stdin than Sscanf for reading from strings.)
    fmt.Sscanf("1101", "%b", &x)
    fmt.Println(x)

    fmt.Sscanf("15", "%o", &x)
    fmt.Println(x)

    fmt.Sscanf("13", "%d", &x)
    fmt.Println(x)

    fmt.Sscanf("d", "%x", &x)
    fmt.Println(x)

    // package math/big:  allows conversion from string to big integer.
    // any base from 2 to 36 can be specified as second parameter.
    var z big.Int
    z.SetString("111", 3)
    fmt.Println(&z)

    // if second parameter is 0, base is determined by prefix, if any
    z.SetString("0b1101", 0) // 0b -> base 2
    fmt.Println(&z)

    z.SetString("015", 0) // 0 -> base 8
    fmt.Println(&z)

    z.SetString("13", 0) // no prefix -> base 10
    fmt.Println(&z)

    z.SetString("0xd", 0) // 0x -> base 16
    fmt.Println(&z)

    // As mentioned, a big.Int (or any type implementing fmt.Scanner)
    // can also be use with any of the fmt scanning functions.
    fmt.Sscanf("15", "%o", &z)
    fmt.Println(&z)
}


Prelude> read "123459" :: Integer
123459
Prelude> read "0xabcf123" :: Integer
180154659
Prelude> read "0o7651" :: Integer
4009


procedure convert (str)
  write (left(str, 10) || " = " || integer(str))
end

procedure main ()
  convert (" 2r1001")
  convert (" 8r7135")
  convert ("16rABC1234")
  convert ("36r1Z")

  write ("2r1001" + "36r1Z") # shows type conversion, string->integer
end


Scanner sc = new Scanner(System.in); //or any other InputStream or String
sc.useRadix(base); //any number from Character.MIN_RADIX (2) to CHARACTER.MAX_RADIX (36)
sc.nextInt(); //read in a value


# Version 5.2
txt = "100"
for base = 2:21
    base10 = parse(Int, txt, base)
    println("String $txt in base $base is $base10 in base 10")
end


// version 1.1.2

fun main(args: Array<String>) {
    val s = "100"
    val bases = intArrayOf(2, 8, 10, 16, 19, 36)
    for (base in bases)
        println("$s in base ${"%2d".format(base)} is ${s.toInt(base)}")
}


print( tonumber("123") )
print( tonumber("a5b0", 16) )
print( tonumber("011101", 2) )
print( tonumber("za3r", 36) )


println int("1234")
println int("1100", 2)
println int("abcd", 16)
println int("ghij", 22)


import strutils

echo parseInt "10"       # 10

echo parseHexInt "0x10"  # 16
echo parseHexInt "10"    # 16

echo parseOctInt "0o120" # 80
echo parseOctInt "120"   # 80


{String.toInt "42"}         %% decimal
= {String.toInt "0x2a"}     %% hexadecimal
= {String.toInt "052"}      %% octal
= {String.toInt "0b101010"} %% binary