 [Demo of EDSAC library subroutine G1: Runge-Kutta solution of differential equations.
  Full description is in Wilkes, Wheeler & Gill, 1951 edn, pages 32-34, 86-87, 132-134.

  Before using G1, we need to fix n, m, a, b, c, d, as defined in WWG pages 86-87:
  n = number of equations (2 for the Rosetta Code example).
  2^m = multiplier for the hy', as large as possible without causing numeric overflow;
    with the scaling chosen here, m = 5.
  Variables y are stored in n consecutive long locations, the last of which is aD.
  Scaled derivatives (2^m)hy' in n consecutive long locations, the last of which is bD.
  G1 uses working variables in n consecutive long locations, the last of which is cD.
  d = address of user-supplied auxiliary subroutine, which calculates the (2^m)hy'.

  For convenience, keep G1 and its storage together. Start at (say) 400 and place:
      variables y at 400D, 402D;
      scaled derivatives at 404D, 406D;
      workspace for G1 at 408D, 410D;
      G1 itself at 412.
  If the base address is placed in location 51 at load time, all the above
    addresses can be accessed via the G parameter:]
            T   51 K
            P  400 F
 [Now set up the 6 preset parameters specified in WWG:]
            T   45 K
            P    2#G [H parameter: P a D]
            P    4 F [N parameter: P 2n F]
            P    4 F [M parameter: P (b-a) F, or V (2048-a+b) F if a > b]
            P    4 F [& parameter: P (c-b) F, or V (2048-b+c) F if b > c]
            P    8 F [L parameter: P 2^(m-2) F]
            P  300 F [X parameter: P d F]
 [For other addresses in the program we can optionally use some more parameters:]
            T   52 K
            P  120 F [A parameter: main routine]
            P   56 F [B parameter: print subroutine P1 from EDSAC library]
            P  350 F [C parameter: constants for Rosetta code example]
            P   78 F [V parameter: square root subroutine]

 [Library subroutine to read constants; runs at load time and is then overwritten.
  R5, for decimal fractions, seems to be unavailable (lost?), so the values are
    here read in as 35-bit integers (i.e. times 2^34) by R2.
  Values are: 0.001, initial value of y
              (2^23)/(10^7) and 25/(2^10) for use in calculations
              0.5/(10^9) for rounding to 9 d.p. (print routine P1 doesn't do this)]
    [email protected]@[email protected]@E13Z
            T#C
    17179869F14411518808F419430400F9#
            TZ

 [Library subroutine M3; prints header at load time and is then overwritten.]
    [email protected]@E8FEZPF
    *[email protected]&[email protected]&
            ....PK  [end text with some blank tape]

 [Runge-Kutta: auxiliary subroutine to calculate (2^m)*h*(dy1/dt) and (2^m)*h*(dy2/dt)
    from y1, y2, where y1 is the function y in Rosetta Code (but scaled) and y2 = t.
  For the Rosetta code example we're using  m = 5, h = 2^(-7)]
          E25K  TX   GK
          A3F  [email protected]           [set up return as usual]
          H2#G  V2#G  TD      [acc := t^2, temp store in 0D]
          H#G  VD  LD  YF  TD [y1 times t^2, shift left, round, temp store in 0D]
          H2#C  VD  YF  T4D   [times (2^23)/(10^7), round, to 4D for square root]
     [14] [email protected]  GV  A4D  T4#G [call square root, result in 4D, copy to (2^m)hy']
          [email protected]  T6#G          [1/4, i.e. (2^m)h with m and h as above, to (2^m)ht']
     [20] ZF                  [overwritten by jump back to caller]
     [21] RF                  [constant 1/4]

  [Main routine, with two subroutines in the same address block as the main routine.]
          E25K  TA  GK
      [0] #F                  [figures shift on teleprinter]
      [1] MF                  [decimal point (in figures mode)]
      [2] !F  @F  &F          [space, carriage return, line feed,]
      [5] K4096F              [null char]
      [6] P100F               [constant: nr of Runge-Kutta steps (in address field)]
      [7] PF                  [negative count of Runge-Kutta steps]
      [8] P10F                [constant: number of steps between printed values]
      [9] PF                  [negative count of steps between printed values]
     [Enter with acc = 0]
     [10] [email protected]                  [set teleprinter to figures]
          [email protected]  [email protected]            [init negative count of R-K steps]
          [email protected]  [email protected]            [init negative count of print steps]
     [Before using library subroutine G1, clear its working registers (WWG page 33)]
          T8#G  T10#G
     [Set up initial values of y1 and y2 (where y2 = t)]
          A#C  T#G            [load 0.001 from constants section, store in y1]
          T2#G                [y2 = t = 0]
     [20] [email protected]  [email protected]          [call subroutine to print initial values]
     [Loop round Runge-Kutta steps]
     [22] TF  [email protected]  G12G      [clear accumulator, call G1 for Runge-Kutta step]
          [email protected]  A2F  [email protected]       [update negative print count]
          [email protected]                [skip printing if not reached 0]
          [email protected]  [email protected]            [reset negative print count]
          [email protected]  [email protected]          [call subroutine to print values]
     [33] TF                  [clear accumulator]
          [email protected]  A2F  [email protected]       [increment negative count of Runge-Kutta steps]
          [email protected]                [loop till count = 0]
          [email protected]  ZF             [flush teleprinter buffer; stop]

 [Subroutine to print y1 as calculated (1) by Runge-Kutta (2) direct from formula]
     [40] A3F  [email protected]           [set up return as usual]
          A2#G  TD            [latest t (= y2) from Runge-Kutta, to 0D for printing]
     [44] [email protected]  [email protected]          [call subroutine to print t]
          [email protected]  [email protected]            [followed by 2 spaces]
          A#G  TD             [latest y1 from Runge-Kutta, to 0D for printing]
     [50] [email protected]  [email protected]          [call subroutine to print y1]
          [email protected]  [email protected]            [followed by 2 spaces]
          A    4#C            [load constant 25/(2^10)]
          H2#G  V2#G  TD      [add t^2, temp store result in 0D]
          HD  VD  LD  YF  TD  [square, shift 1 left, round, result to 0D]
          H2#C  VD  YF  TD    [times (2^23)/(10^7), round, to 0D for printing]
     [67] [email protected]  [email protected]          [call subroutine to print y]
          [email protected]  [email protected]            [print CR, LF]
     [71] ZF                  [overwritten by jump back to caller]

 [Second-level subroutine to print number in 0D to 9 decimal places]
     [72] A3F  [email protected]           [set up return as usual]
          AD  A6#C  TD        [load number, add decimal rounding, to 0D for printing]
          [email protected]  [email protected]           [print '0.' since P1 doesn't do so]
          [email protected]  GB            [call library subroutine P1 for printing]
     [81] P9F                 [parameter for P1, 9 decimals]
     [82] ZF                  [overwritten by jump back to caller]

 [Library subroutine G1 for Runge-Kutta process. 66 locations, even address.]
            E25K  T12G
    GKT4#ZH682DT6#ZPNT12#Z!1405DT14#ZTHT16#[email protected]@[email protected]&FT6ZPN
    T8ZMMO&[email protected]@E[email protected]#@S12#@T12#@[email protected]#@[email protected]
    [email protected]@S6#@A16#@U46#@[email protected]@[email protected]@[email protected]@ZFR1057#@ZFYFU6DV6DRLYF
    UDZFZFADLDADLLS6DN4DYFZFA46#@S14#@[email protected]@[email protected]@[email protected]

 [Replacement for library routine S2 (square root). 38 locations, even address.
  Advantages: More accurate for small values of the argument.
              Calculates sqrt(0) without going into an infinite loop.
  Disadvantages: Longer and slower than S2 (calculates one bit at a time).]
            E25K  TV
    [email protected]@[email protected]#@[email protected]#@[email protected]#@[email protected]#@A4DS34#@
    T4DA36#@[email protected]@TFA36#@[email protected]#@T36#@A34#@[email protected]

 [Library subroutine P1 - print a single positive number. 21 locations.
  Prints number in 0D to n places of decimals, where
  n is specified by 'P n F' pseudo-order after subroutine call.]
            E25K  TB
    [email protected]@[email protected]@[email protected]@[email protected]@EFU3FJFM1F

  [Define entry point in main routine]
            E25K  TA  GK
            E10Z  PF  [enter at relative address 10 with accumulator = 0]


#!/usr/bin/ruby

require 'openssl' # for mod_exp only
require 'prime'

def rsa_encode blocks, e, n
  blocks.map{|b| b.to_bn.mod_exp(e, n).to_i}
end

def rsa_decode ciphers, d, n
  rsa_encode ciphers, d, n
end

# all numbers in blocks have to be < modulus, or information is lost
# for secure encryption only use big modulus and blocksizes
def text_to_blocks text, blocksize=64 # 1 hex = 4 bit => default is 256bit
  text.each_byte.reduce(""){|acc,b| acc << b.to_s(16).rjust(2, "0")} # convert text to hex (preserving leading 0 chars)
      .each_char.each_slice(blocksize).to_a                          # slice hexnumbers in pieces of blocksize
      .map{|a| a.join("").to_i(16)}                                  # convert each slice into internal number
end

def blocks_to_text blocks
  blocks.map{|d| d.to_s(16)}.join("")                                # join all blocks into one hex-string
        .each_char.each_slice(2).to_a                                # group into pairs
	.map{|s| s.join("").to_i(16)}                                # number from 2 hexdigits is byte
	.flatten.pack("C*")                                          # pack bytes into ruby-string
	.force_encoding(Encoding::default_external)                  # reset encoding
end

def generate_keys p1, p2
  n = p1 * p2
  t = (p1 - 1) * (p2 - 1)
  e = 2.step.each do |i|
    break i if i.gcd(t) == 1
  end
  d = 1.step.each do |i|
    break i if (i * e) % t == 1
  end
  return e, d, n
end

p1, p2 = Prime.take(100).last(2)
public_key, private_key, modulus =
  generate_keys p1, p2

print "Message: "
message = gets
blocks = text_to_blocks message, 4 # very small primes
print "Numbers: "; p blocks
encoded = rsa_encode(blocks, public_key, modulus)
print "Encrypted as: "; p encoded
decoded = rsa_decode(encoded, private_key, modulus)
print "Decrypted to: "; p decoded
final = blocks_to_text(decoded)
print "Decrypted Message: "; puts final


extern crate num;

use num::bigint::BigUint;
use num::integer::Integer;
use num::traits::{One, Zero};

fn mod_exp(b: &BigUint, e: &BigUint, n: &BigUint) -> Result<BigUint, &'static str> {
    if n.is_zero() {
        return Err("modulus is zero");
    }
    if b >= n {
        // base is too large and should be split into blocks
        return Err("base is >= modulus");
    }
    if b.gcd(n) != BigUint::one() {
        return Err("base and modulus are not relatively prime");
    }

    let mut bb = b.clone();
    let mut ee = e.clone();
    let mut result = BigUint::one();
    while !ee.is_zero() {
        if ee.is_odd() {
            result = (result * &bb) % n;
        }
        ee >>= 1;
        bb = (&bb * &bb) % n;
    }
    Ok(result)
}

fn main() {
    let msg = "Rosetta Code";

    let n = "9516311845790656153499716760847001433441357"
        .parse()
        .unwrap();
    let e = "65537".parse().unwrap();
    let d = "5617843187844953170308463622230283376298685"
        .parse()
        .unwrap();

    let msg_int = BigUint::from_bytes_be(msg.as_bytes());
    let enc = mod_exp(&msg_int, &e, &n).unwrap();
    let dec = mod_exp(&enc, &d, &n).unwrap();
    let msg_dec = String::from_utf8(dec.to_bytes_be()).unwrap();

    println!("msg as txt: {}", msg);
    println!("msg as num: {}", msg_int);
    println!("enc as num: {}", enc);
    println!("dec as num: {}", dec);
    println!("dec as txt: {}", msg_dec);
}


PROGRAM RUNGE_KUTTA

CONST DELTA_T=0.1

FUNCTION Y1(T,Y)
     Y1=T*SQR(Y)
END FUNCTION

BEGIN
   Y=1.0
   FOR I%=0 TO 100 DO
      T=I%*DELTA_T

      IF T=INT(T) THEN           ! print every tenth
          ACTUAL=((T^2+4)^2)/16  ! exact solution
          PRINT("Y(";T;")=";Y;TAB(20);"Error=";ACTUAL-Y)
      END IF

      K1=Y1(T,Y)
      K2=Y1(T+DELTA_T/2,Y+DELTA_T/2*K1)
      K3=Y1(T+DELTA_T/2,Y+DELTA_T/2*K2)
      K4=Y1(T+DELTA_T,Y+DELTA_T*K3)
      Y+=DELTA_T*(K1+2*(K2+K3)+K4)/6
   END FOR
END PROGRAM


open System

let y'(t,y) = t * sqrt(y)

let RungeKutta4 t0 y0 t_max dt =

    let dy1(t,y) = dt * y'(t,y)
    let dy2(t,y) = dt * y'(t+dt/2.0, y+dy1(t,y)/2.0)
    let dy3(t,y) = dt * y'(t+dt/2.0, y+dy2(t,y)/2.0)
    let dy4(t,y) = dt * y'(t+dt, y+dy3(t,y))

    (t0,y0) |> Seq.unfold (fun (t,y) ->
        if ( t <= t_max) then Some((t,y), (Math.Round(t+dt, 6), y + ( dy1(t,y) + 2.0*dy2(t,y) + 2.0*dy3(t,y) + dy4(t,y))/6.0))
        else None
        )

let y_exact t = (pown (pown t 2 + 4.0) 2)/16.0

RungeKutta4 0.0 1.0 10.0 0.1
    |> Seq.filter (fun (t,y) -> t % 1.0 = 0.0 )
    |> Seq.iter (fun (t,y) -> Console.WriteLine("y({0})={1}\t(relative error:{2})", t, y, (y / y_exact(t))-1.0) )


program rungekutta
    implicit none
    integer, parameter :: dp = kind(1d0)
    real(dp) :: t, dt, tstart, tstop
    real(dp) :: y, k1, k2, k3, k4

    tstart = 0.0d0
    tstop = 10.0d0
    dt = 0.1d0
    y = 1.0d0
    t = tstart
    write (6, '(a,f4.1,a,f12.8,a,es13.6)') 'y(', t, ') = ', y, ' error = ', &
        abs(y-(t**2+4)**2/16)
    do while (t < tstop)
        k1 = dt*f(t, y)
        k2 = dt*f(t+dt/2, y+k1/2)
        k3 = dt*f(t+dt/2, y+k2/2)
        k4 = dt*f(t+dt, y+k3)
        y = y+(k1+2*(k2+k3)+k4)/6
        t = t+dt
        if (abs(nint(t)-t) <= 1d-12) then
            write (6, '(a,f4.1,a,f12.8,a,es13.6)') 'y(', t, ') = ', y, ' error = ', &
                abs(y-(t**2+4)**2/16)
        end if
    end do
contains
    function f(t,y)
        real(dp), intent(in) :: t, y
        real(dp) :: f

        f = t*sqrt(y)
    end function f
end program rungekutta


object RSA_saket{
    val d = BigInt("5617843187844953170308463622230283376298685")
    val n = BigInt("9516311845790656153499716760847001433441357")
    val e = 65537
    val text = "Rosetta Code"
    val encode = (msg:BigInt) => pow_mod(msg,e,n)
    val decode = (msg:BigInt) => pow_mod(msg,d,n)
    val getmsg = (txt:String) => BigInt(txt.map(x => "%03d".format(x.toInt)).reduceLeft(_+_))
    def pow_mod(p:BigInt, q:BigInt, n:BigInt):BigInt = {
        if(q==0)            BigInt(1)
        else if(q==1)       p
        else if(q%2 == 1)   pow_mod(p,q-1,n)*p % n
        else                pow_mod(p*p % n,q/2,n)
    }
    def gettxt(num:String) = {
        if(num.size%3==2)
            ("0" + num).grouped(3).toList.foldLeft("")(_ + _.toInt.toChar)
        else
            num.grouped(3).toList.foldLeft("")(_ + _.toInt.toChar)
    }
    def main(args: Array[String]): Unit = {
        println(f"Original String \t: "+text)
        val msg = getmsg(text)
        println(f"Converted Signal \t: "+msg)
        val enc_sig = encode(msg)
        println("Encoded Signal \t\t: "+ enc_sig)
        val dec_sig = decode(enc_sig)
        println("Decoded String \t\t: "+ dec_sig)
        val rec_msg = gettxt(dec_sig.toString)
        println("Retrieved Signal \t: "+rec_msg)
    }
}


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

const proc: main is func
  local
    const string: plainText is "Rosetta Code";
    # Use a key big enough to hold 16 bytes of plain text in a single block.
    const bigInteger: modulus is 9516311845790656153499716760847001433441357_;
    const bigInteger: encode is 65537_;
    const bigInteger: decode is 5617843187844953170308463622230283376298685_;
    var bigInteger: plainTextNumber is 0_;
    var bigInteger: encodedNumber is 0_;
    var bigInteger: decodedNumber is 0_;
    var string: decodedText is "";
  begin
    writeln("Plain text:             " <& plainText);
    plainTextNumber := bytes2BigInt(plainText, UNSIGNED, BE);
    if plainTextNumber >= modulus then
      writeln("Plain text message too long");
    else
      writeln("Plain text as a number: " <& plainTextNumber);
      encodedNumber := modPow(plainTextNumber, encode, modulus);
      writeln("Encoded:                " <& encodedNumber);
      decodedNumber := modPow(encodedNumber, decode, modulus);
      writeln("Decoded:                " <& decodedNumber);
      decodedText := bytes(decodedNumber, UNSIGNED, BE);
      writeln("Decoded number as text: " <& decodedText);
    end if;
  end func;


' version 03-10-2015
' compile with: fbc -s console
' translation of BBC BASIC

Dim As Double y = 1, t, actual, k1, k2, k3, k4

Print

For i As Integer = 0 To 100

    t = i / 10

    If t = Int(t) Then
        actual = ((t ^ 2 + 4) ^ 2) / 16
        Print  "y("; Str(t); ") ="; y ; Tab(27); "Error = "; actual - y
    End If

    k1 = t * Sqr(y)
    k2 = (t + 0.05) * Sqr(y + 0.05 * k1)
    k3 = (t + 0.05) * Sqr(y + 0.05 * k2)
    k4 = (t + 0.10) * Sqr(y + 0.10 * k3)
    y += 0.1 * (k1 + 2 * (k2 + k3) + k4) / 6

Next i

' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


window 1

def fn dydx( x as double, y as double ) as double = x * sqr(y)
def fn exactY( x as long ) as double = ( x ^2 + 4 ) ^2 / 16

long i
double h, k1, k2, k3, k4, x, y, result

h = 0.1
y = 1
for i = 0 to 100
  x = i * h
  if x == int(x)
    result = fn exactY( x )
    print "y("; mid$( str$(x), 2, len$(str$(x) )); ") = "; y, "Error = "; result - y
  end if

  k1 = h * fn dydx( x, y )
  k2 = h * fn dydx( x + h / 2, y + k1 / 2 )
  k3 = h * fn dydx( x + h / 2, y + k2 / 2 )
  k4 = h * fn dydx( x + h,     y + k3     )

  y = y + 1 / 6 * ( k1 + 2 * k2 + 2 * k3 + k4 )
next

HandleEvents


const n = 9516311845790656153499716760847001433441357
const e = 65537
const d = 5617843187844953170308463622230283376298685

module Message {
    var alphabet = [('A' .. 'Z')..., ' ']
    var rad = alphabet.len
    var code = Hash(^rad -> map {|i| (alphabet[i], i) }...)
    func encode(String t) {
        [code{t.reverse.chars...}] ~Z* t.len.range.map { |i| rad**i } -> sum(0)
    }
    func decode(Number n) {
        ''.join(alphabet[
            gather {
                loop {
                    var (d, m) = n.divmod(rad)
                    take(m)
                    break if (n < rad)
                    n = d
                }
            }...]
        ).reverse
    }
}

var secret_message = "ROSETTA CODE"
say "Secret message is #{secret_message}"

var numeric_message = Message::encode(secret_message)
say "Secret message in integer form is #{numeric_message}"

var numeric_cipher = expmod(numeric_message, e, n)
say "After exponentiation with public exponent we get: #{numeric_cipher}"

var text_cipher = Message::decode(numeric_cipher)
say "This turns into the string #{text_cipher}"

var numeric_cipher2 = Message::encode(text_cipher)
say "If we re-encode it in integer form we get #{numeric_cipher2}"

var numeric_message2 = expmod(numeric_cipher2, d, n)
say "After exponentiation with SECRET exponent we get: #{numeric_message2}"

var secret_message2 = Message::decode(numeric_message2)
say "This turns into the string #{secret_message2}"


package require Tcl 8.5

# This is a straight-forward square-and-multiply implementation that relies on
# Tcl 8.5's bignum support (based on LibTomMath) for speed.
proc modexp {b expAndMod} {
    lassign $expAndMod -> e n
    if {$b >= $n} {puts stderr "WARNING: modulus too small"}
    for {set r 1} {$e != 0} {set e [expr {$e >> 1}]} {
	if {$e & 1} {
	    set r [expr {($r * $b) % $n}]
	}
	set b [expr {($b ** 2) % $n}]
    }
    return $r
}

# Assumes that messages are shorter than the modulus
proc rsa_encrypt {message publicKey} {
    if {[lindex $publicKey 0] ne "publicKey"} {error "key handling"}
    set toEnc 0
    foreach char [split [encoding convertto utf-8 $message] ""] {
	set toEnc [expr {$toEnc * 256 + [scan $char "%c"]}]
    }
    return [modexp $toEnc $publicKey]
}

proc rsa_decrypt {encrypted privateKey} {
    if {[lindex $privateKey 0] ne "privateKey"} {error "key handling"}
    set toDec [modexp $encrypted $privateKey]
    for {set message ""} {$toDec > 0} {set toDec [expr {$toDec >> 8}]} {
	append message [format "%c" [expr {$toDec & 255}]]
    }
    return [encoding convertfrom utf-8 [string reverse $message]]
}

# Assemble packaged public and private keys
set e 65537
set n 9516311845790656153499716760847001433441357
set d 5617843187844953170308463622230283376298685
set publicKey  [list "publicKey"  $e $n]
set privateKey [list "privateKey" $d $n]

# Test on some input strings
foreach input {"Rosetta Code" "UTF-8 \u263a test"} {
    set enc [rsa_encrypt $input $publicKey]
    set dec [rsa_decrypt $enc $privateKey]
    puts "$input -> $enc -> $dec"
}


package main

import (
    "fmt"
    "math"
)

type ypFunc func(t, y float64) float64
type ypStepFunc func(t, y, dt float64) float64

// newRKStep takes a function representing a differential equation
// and returns a function that performs a single step of the forth-order
// Runge-Kutta method.
func newRK4Step(yp ypFunc) ypStepFunc {
    return func(t, y, dt float64) float64 {
        dy1 := dt * yp(t, y)
        dy2 := dt * yp(t+dt/2, y+dy1/2)
        dy3 := dt * yp(t+dt/2, y+dy2/2)
        dy4 := dt * yp(t+dt, y+dy3)
        return y + (dy1+2*(dy2+dy3)+dy4)/6
    }
}

// example differential equation
func yprime(t, y float64) float64 {
    return t * math.Sqrt(y)
}

// exact solution of example
func actual(t float64) float64 {
    t = t*t + 4
    return t * t / 16
}

func main() {
    t0, tFinal := 0, 10 // task specifies times as integers,
    dtPrint := 1        // and to print at whole numbers.
    y0 := 1.            // initial y.
    dtStep := .1        // step value.

    t, y := float64(t0), y0
    ypStep := newRK4Step(yprime)
    for t1 := t0 + dtPrint; t1 <= tFinal; t1 += dtPrint {
        printErr(t, y) // print intermediate result
        for steps := int(float64(dtPrint)/dtStep + .5); steps > 1; steps-- {
            y = ypStep(t, y, dtStep)
            t += dtStep
        }
        y = ypStep(t, y, float64(t1)-t) // adjust step to integer time
        t = float64(t1)
    }
    printErr(t, y) // print final result
}

func printErr(t, y float64) {
    fmt.Printf("y(%.1f) = %f Error: %e\n", t, y, math.Abs(actual(t)-y))
}


Imports System
Imports System.Numerics
Imports System.Text

Module Module1
    Sub Main()
        Dim n As BigInteger = BigInteger.Parse("9516311845790656153499716760847001433441357")
        Dim e As BigInteger = 65537
        Dim d As BigInteger = BigInteger.Parse("5617843187844953170308463622230283376298685")
        Dim plainTextStr As String = "Hello, Rosetta!"
        Dim plainTextBA As Byte() = ASCIIEncoding.ASCII.GetBytes(plainTextStr)
        Dim pt As BigInteger = New BigInteger(plainTextBA)
        If pt > n Then Throw New Exception() ' Blocking not implemented
        Dim ct As BigInteger = BigInteger.ModPow(pt, e, n)
        Console.WriteLine(" Encoded: " & ct.ToString("X"))
        Dim dc As BigInteger = BigInteger.ModPow(ct, d, n)
        Console.WriteLine(" Decoded: " & dc.ToString("X"))
        Dim decoded As String = ASCIIEncoding.ASCII.GetString(dc.ToByteArray())
        Console.WriteLine("As ASCII: " & decoded)
    End Sub
End Module


/*import math.big
fn main() {
    //var bb, ptn, etn, dtn big.Int
    pt := "Rosetta Code"
    println("Plain text:            $pt")

    // a key set big enough to hold 16 bytes of plain text in
    // a single block (to simplify the example) and also big enough
    // to demonstrate efficiency of modular exponentiation.
    n := big.integer_from_string("9516311845790656153499716760847001433441357")?
    e := big.integer_from_string("65537")?
    d := big.integer_from_string("5617843187844953170308463622230283376298685")?

    mut ptn := big.zero_int
    // convert plain text to a number
    for b in pt.bytes() {
        bb := big.integer_from_i64(i64(b))
        ptn = ptn.lshift(8).bitwise_or(bb)
    }
    if ptn >= n {
        println("Plain text message too long")
        return
    }
    println("Plain text as a number:$ptn")

    // encode a single number
    etn := ptn.big_mod_pow(e,n)
    println("Encoded:               $etn")

    // decode a single number
    mut dtn := etn.big_mod_pow(d,n)
    println("Decoded:               $dtn")

    // convert number to text
    mut db := [16]u8{}
    mut dx := 16
    bff := big.integer_from_int(0xff)
    for dtn.bit_len() > 0 {
        dx--
        bb := dtn.bitwise_and(bff)
        db[dx] = u8(i64(bb.int()))
        dtn = dtn.rshift(8)
        println('${db[0..].bytestr()} ${dtn.bit_len()}')
    }
    println("Decoded number as text: ${db[dx..].bytestr()}")
}*/

import math.big
fn main() {
    //var bb, ptn, etn, dtn big.Int
    pt := "Hello World"
    println("Plain text:            $pt")

    // a key set big enough to hold 16 bytes of plain text in
    // a single block (to simplify the example) and also big enough
    // to demonstrate efficiency of modular exponentiation.
    n := big.integer_from_string("9516311845790656153499716760847001433441357")?
    e := big.integer_from_string("65537")?
    d := big.integer_from_string("5617843187844953170308463622230283376298685")?

    mut ptn := big.zero_int
    // convert plain text to a number
    for b in pt.bytes() {
        bb := big.integer_from_i64(i64(b))
        ptn = ptn.lshift(8).bitwise_or(bb)
    }
    if ptn >= n {
        println("Plain text message too long")
        return
    }
    println("Plain text as a number:$ptn")

    // encode a single number
    etn := ptn.big_mod_pow(e,n)
    println("Encoded:               $etn")

    // decode a single number
    mut dtn := etn.big_mod_pow(d,n)
    println("Decoded:               $dtn")

    // convert number to text
    mut db := [16]u8{}
    mut dx := 16
    bff := big.integer_from_int(0xff)
    for dtn.bit_len() > 0 {
        dx--
        bb := dtn.bitwise_and(bff)
        db[dx] = u8(i64(bb.int()))
        dtn = dtn.rshift(8)
    }
    println("Decoded number as text: ${db[dx..].bytestr()}")
}


class Runge_Kutta{
static void main(String[] args){
def y=1.0,t=0.0,counter=0;
def dy1,dy2,dy3,dy4;
def real;
while(t<=10)
{if(counter%10==0)
{real=(t*t+4)*(t*t+4)/16;
println("y("+t+")="+ y+ " Error:"+ (real-y));
}

dy1=dy(dery(y,t));
dy2=dy(dery(y+dy1/2,t+0.05));
dy3=dy(dery(y+dy2/2,t+0.05));
dy4=dy(dery(y+dy3,t+0.1));

y=y+(dy1+2*dy2+2*dy3+dy4)/6;
t=t+0.1;
counter++;
}
}
static def dery(def y,def t){return t*(Math.sqrt(y));}
static def dy(def x){return x*0.1;}
}


import "/big" for BigInt

var pt = "Rosetta Code"
System.print("Plain text:            : %(pt)")
var n = BigInt.new("9516311845790656153499716760847001433441357")
var e = BigInt.new("65537")
var d = BigInt.new("5617843187844953170308463622230283376298685")
var ptn = BigInt.zero
// convert plain text to a number
for (b in pt.bytes) {
    ptn = (ptn << 8) | BigInt.new(b)
}
if (ptn >= n) {
    System.print("Plain text message too long")
    return
}
System.print("Plain text as a number : %(ptn)")

// encode a single number
var etn = ptn.modPow(e, n)
System.print("Encoded                : %(etn)")

// decode a single number
var dtn = etn.modPow(d, n)
System.print("Decoded                : %(dtn)")

// convert number to text
var db = List.filled(16, 0)
var dx = 16
var bff = BigInt.new(255)
while (dtn.bitLength > 0) {
    dx = dx - 1
    db[dx] = (dtn & bff).toSmall
    dtn = dtn >> 8
}
var s = ""
for (i in dx..15) s = s + String.fromByte(db[i])
System.print("Decoded number as text : %(s)")


var BN=Import.lib("zklBigNum");

n:=BN("9516311845790656153499716760847001433441357");
e:=BN("65537");
d:=BN("5617843187844953170308463622230283376298685");

const plaintext="Rossetta Code";
pt:=BN(Data(Int,0,plaintext));  // convert string (as stream of bytes) to big int
if(pt>n) throw(Exception.ValueError("Message is too large"));

println("Plain text: ",plaintext);
println("As Int:     ",pt);
ct:=pt.powm(e,n);  println("Encoded:    ",ct);
pt =ct.powm(d,n);  println("Decoded:    ",pt);
txt:=pt.toData().text; // convert big int to bytes, treat as string
println("As String:  ",txt);


dv
  :: Floating a
  => a -> a -> a
dv = (. sqrt) . (*)

fy t = 1 / 16 * (4 + t ^ 2) ^ 2

rk4
  :: (Enum a, Fractional a)
  => (a -> a -> a) -> a -> a -> a -> [(a, a)]
rk4 fd y0 a h = zip ts $ scanl (flip fc) y0 ts
  where
    ts = [a,h ..]
    fc t y =
      sum . (y :) . zipWith (*) [1 / 6, 1 / 3, 1 / 3, 1 / 6] $
      scanl
        (\k f -> h * fd (t + f * h) (y + f * k))
        (h * fd t y)
        [1 / 2, 1 / 2, 1]

task =
  mapM_
    (print . (\(x, y) -> (truncate x, y, fy x - y)))
    (filter (\(x, _) -> 0 == mod (truncate $ 10 * x) 10) $
     take 101 $ rk4 dv 1.0 0 0.1)


NB.*rk4 a Solve function using Runge-Kutta method
NB. y is: y(ta) , ta , tb , tstep
NB. u is: function to solve
NB. eg: fyp rk4 1 0 10 0.1
rk4=: adverb define
 'Y0 a b h'=. 4{. y
 T=. a + [email protected]>:&.(%&h) b - a
 Y=. Yt=. Y0
 for_t. }: T do.
   ty=. t,Yt
   k1=. h * u ty
   k2=. h * u ty + -: h,k1
   k3=. h * u ty + -: h,k2
   k4=. h * u ty + h,k3
   Y=. Y, Yt=. Yt + (%6) * 1 2 2 1 +/@:* k1, k2, k3, k4
 end.
T ,. Y
)


import static java.lang.Math.*;
import java.util.function.BiFunction;

public class RungeKutta {

    static void runge(BiFunction<Double, Double, Double> yp_func, double[] t,
            double[] y, double dt) {

        for (int n = 0; n < t.length - 1; n++) {
            double dy1 = dt * yp_func.apply(t[n], y[n]);
            double dy2 = dt * yp_func.apply(t[n] + dt / 2.0, y[n] + dy1 / 2.0);
            double dy3 = dt * yp_func.apply(t[n] + dt / 2.0, y[n] + dy2 / 2.0);
            double dy4 = dt * yp_func.apply(t[n] + dt, y[n] + dy3);
            t[n + 1] = t[n] + dt;
            y[n + 1] = y[n] + (dy1 + 2.0 * (dy2 + dy3) + dy4) / 6.0;
        }
    }

    static double calc_err(double t, double calc) {
        double actual = pow(pow(t, 2.0) + 4.0, 2) / 16.0;
        return abs(actual - calc);
    }

    public static void main(String[] args) {
        double dt = 0.10;
        double[] t_arr = new double[101];
        double[] y_arr = new double[101];
        y_arr[0] = 1.0;

        runge((t, y) -> t * sqrt(y), t_arr, y_arr, dt);

        for (int i = 0; i < t_arr.length; i++)
            if (i % 10 == 0)
                System.out.printf("y(%.1f) = %.8f Error: %.6f%n",
                        t_arr[i], y_arr[i],
                        calc_err(t_arr[i], y_arr[i]));
    }
}


function rk4(y, x, dx, f) {
    var k1 = dx * f(x, y),
        k2 = dx * f(x + dx / 2.0,   +y + k1 / 2.0),
        k3 = dx * f(x + dx / 2.0,   +y + k2 / 2.0),
        k4 = dx * f(x + dx,         +y + k3);

    return y + (k1 + 2.0 * k2 + 2.0 * k3 + k4) / 6.0;
}

function f(x, y) {
    return x * Math.sqrt(y);
}

function actual(x) {
    return (1/16) * (x*x+4)*(x*x+4);
}

var y = 1.0,
    x = 0.0,
    step = 0.1,
    steps = 0,
    maxSteps = 101,
    sampleEveryN = 10;

while (steps < maxSteps) {
    if (steps%sampleEveryN === 0) {
        console.log("y(" + x + ") =  \t" + y + "\t ± " + (actual(x) - y).toExponential());
    }

    y = rk4(y, x, step, f);

    // using integer math for the step addition
    // to prevent floating point errors as 0.2 + 0.1 != 0.3
    x = ((x * 10) + (step * 10)) / 10;
    steps += 1;
}


def until(cond; next):
  def _until: if cond then . else (next|_until) end;
  _until;

def while(cond; update):
  def _while:  if cond then ., (update | _while) else empty end;
  _while;


f(x, y) = x * sqrt(y)
theoric(t) = (t ^ 2 + 4.0) ^ 2 / 16.0

rk4(f) = (t, y, δt) ->  # 1st (result) lambda
         ((δy1) ->      # 2nd lambda
         ((δy2) ->      # 3rd lambda
         ((δy3) ->      # 4th lambda
         ((δy4) -> ( δy1 + 2δy2 + 2δy3 + δy4 ) / 6 # 5th and deepest lambda: calc y_{n+1}
         )(δt * f(t + δt, y + δy3))         # calc δy₄
         )(δt * f(t + δt / 2, y + δy2 / 2)) # calc δy₃
         )(δt * f(t + δt / 2, y + δy1 / 2)) # calc δy₂
         )(δt * f(t, y))                    # calc δy₁

δy = rk4(f)
t₀, δt, tmax = 0.0, 0.1, 10.0
y₀ = 1.0

t, y = t₀, y₀
while t ≤ tmax
    if t ≈ round(t) @printf("y(%4.1f) = %10.6f\terror: %12.6e\n", t, y, abs(y - theoric(t))) end
    y += δy(t, y, δt)
    t += δt
end


// version 1.1.2

typealias Y  = (Double) -> Double
typealias Yd = (Double, Double) -> Double

fun rungeKutta4(t0: Double, tz: Double, dt: Double, y: Y, yd: Yd) {
    var tn = t0
    var yn = y(tn)
    val z = ((tz  - t0) / dt).toInt()
    for (i in 0..z) {
        if (i % 10 == 0) {
            val exact = y(tn)
            val error = yn - exact
            println("%4.1f  %10f  %10f  %9f".format(tn, yn, exact, error))
        }
        if (i == z) break
        val dy1 = dt * yd(tn, yn)
        val dy2 = dt * yd(tn + 0.5 * dt, yn + 0.5 * dy1)
        val dy3 = dt * yd(tn + 0.5 * dt, yn + 0.5 * dy2)
        val dy4 = dt * yd(tn + dt, yn + dy3)
        yn += (dy1 + 2.0 * dy2 + 2.0 * dy3 + dy4) / 6.0
        tn += dt
    }
}

fun main(args: Array<String>) {
    println("  T        RK4        Exact      Error")
    println("----  ----------  ----------  ---------")
    val y = fun(t: Double): Double {
        val x = t * t + 4.0
        return x * x / 16.0
    }
    val yd = fun(t: Double, yt: Double) = t * Math.sqrt(yt)
    rungeKutta4(0.0, 10.0, 0.1, y, yd)
}


'[RC] Runge-Kutta method
'initial conditions
x0 = 0
y0 = 1
'step
h = 0.1
'number of points
N=101

y=y0
FOR i = 0 TO N-1
    x = x0+ i*h
    IF x = INT(x) THEN
        actual = exactY(x)
        PRINT "y("; x ;") = "; y; TAB(20); "Error = ";  actual - y
    END IF

    k1 = h*dydx(x,y)
    k2 = h*dydx(x+h/2,y+k1/2)
    k3 = h*dydx(x+h/2,y+k2/2)
    k4 = h*dydx(x+h,y+k3)
    y = y + 1/6 * (k1 + 2*k2 + 2*k3 + k4)
NEXT i

function dydx(x,y)
    dydx=x*sqr(y)
end function

function exactY(x)
    exactY=(x^2 + 4)^2 / 16
end function


function testRK4Programs
    figure
    hold on
    t = 0:0.1:10;
    y = 0.0625.*(t.^2+4).^2;
    plot(t, y, '-k')
    [tode4, yode4] = testODE4(t);
    plot(tode4, yode4, '--b')
    [trk4, yrk4] = testRK4(t);
    plot(trk4, yrk4, ':r')
    legend('Exact', 'ODE4', 'RK4')
    hold off
    fprintf('Time\tExactVal\tODE4Val\tODE4Error\tRK4Val\tRK4Error\n')
    for k = 1:10:length(t)
        fprintf('%.f\t\t%7.3f\t\t%7.3f\t%7.3g\t%7.3f\t%7.3g\n', t(k), y(k), ...
            yode4(k), abs(y(k)-yode4(k)), yrk4(k), abs(y(k)-yrk4(k)))
    end
end

function [t, y] = testODE4(t)
    y0 = 1;
    y = ode4(@(tVal,yVal)tVal*sqrt(yVal), t, y0);
end

function [t, y] = testRK4(t)
    dydt = @(tVal,yVal)tVal*sqrt(yVal);
    y = zeros(size(t));
    y(1) = 1;
    for k = 1:length(t)-1
        dt = t(k+1)-t(k);
        dy1 = dt*dydt(t(k), y(k));
        dy2 = dt*dydt(t(k)+0.5*dt, y(k)+0.5*dy1);
        dy3 = dt*dydt(t(k)+0.5*dt, y(k)+0.5*dy2);
        dy4 = dt*dydt(t(k)+dt, y(k)+dy3);
        y(k+1) = y(k)+(dy1+2*dy2+2*dy3+dy4)/6;
    end
end


/* Here is how to solve a differential equation */
'diff(y, x) = x * sqrt(y);
ode2(%, y, x);
ic1(%, x = 0, y = 1);
factor(solve(%, y)); /* [y = (x^2 + 4)^2 / 16] */

/* The Runge-Kutta solver is builtin */

load(dynamics)$
sol: rk(t * sqrt(y), y, 1, [t, 0, 10, 1.0])$
plot2d([discrete, sol])$

/* An implementation of RK4 for one equation */

rk4(f, x0, y0, x1, n) := block([h, x, y, vx, vy, k1, k2, k3, k4],
   h: bfloat((x1 - x0) / (n - 1)),
   x: x0,
   y: y0,
   vx: makelist(0, n + 1),
   vy: makelist(0, n + 1),
   vx[1]: x0,
   vy[1]: y0,
   for i from 1 thru n do (
      k1: bfloat(h * f(x, y)),
      k2: bfloat(h * f(x + h / 2, y + k1 / 2)),
      k3: bfloat(h * f(x + h / 2, y + k2 / 2)),
      k4: bfloat(h * f(x + h, y + k3)),
      vy[i + 1]: y: y + (k1 + 2 * k2 + 2 * k3 + k4) / 6,
      vx[i + 1]: x: x + h
   ),
   [vx, vy]
)$

[x, y]: rk4(lambda([x, y], x * sqrt(y)), 0, 1, 10, 101)$

plot2d([discrete, x, y])$

s: map(lambda([x], (x^2 + 4)^2 / 16), x)$

for i from 1 step 10 thru 101 do print(x[i], " ", y[i], " ", y[i] - s[i]);


ПП	38	П1	ПП	30	П2	ПП	35	П3	2
*	ПП	30	ИП2	ИП3	+	2	*	+	ИП1
+	3	/	ИП7	+	П7	П8	С/П	БП	00
ИП6	ИП5	+	П6	<->	ИП7	+	П8

ИП8	КвКор	ИП6	*

ИП5	*	В/О


import math

proc fn(t, y: float): float =
    result = t * math.sqrt(y)

proc solution(t: float): float =
    result = (t^2 + 4)^2 / 16

proc rk(start, stop, step: float) =
    let nsteps = int(round((stop - start) / step)) + 1
    let delta = (stop - start) / float(nsteps - 1)
    var cur_y = 1.0
    for i in 0..(nsteps - 1):
        let cur_t = start + delta * float(i)

        if abs(cur_t - math.round(cur_t)) < 1e-5:
            echo "y(", cur_t, ") = ", cur_y, ", error = ", solution(cur_t) - cur_y

        let dy1 = step * fn(cur_t, cur_y)
        let dy2 = step * fn(cur_t + 0.5 * step, cur_y + 0.5 * dy1)
        let dy3 = step * fn(cur_t + 0.5 * step, cur_y + 0.5 * dy2)
        let dy4 = step * fn(cur_t + step, cur_y + dy3)
import math, strformat

proc fn(t, y: float): float =
    result = t * math.sqrt(y)

proc solution(t: float): float =
    result = (t^2 + 4)^2 / 16

proc rk(start, stop, step: float) =
    let nsteps = int(round((stop - start) / step)) + 1
    let delta = (stop - start) / float(nsteps - 1)
    var cur_y = 1.0
    for i in 0..<nsteps:
        let cur_t = start + delta * float(i)

        if abs(cur_t - math.round(cur_t)) < 1e-5:
            echo &"y({cur_t}) = {cur_y}, error = {solution(cur_t) - cur_y}"

        let dy1 = step * fn(cur_t, cur_y)
        let dy2 = step * fn(cur_t + 0.5 * step, cur_y + 0.5 * dy1)
        let dy3 = step * fn(cur_t + 0.5 * step, cur_y + 0.5 * dy2)
        let dy4 = step * fn(cur_t + step, cur_y + dy3)

        cur_y += (dy1 + 2 * (dy2 + dy3) + dy4) / 6

rk(start = 0, stop = 10, step = 0.1)
        cur_y += (dy1 + 2.0 * (dy2 + dy3) + dy4)


class RungeKuttaMethod {
  function : Main(args : String[]) ~ Nil {
    x0 := 0.0; x1 := 10.0; dx := .1;

    n := 1 + (x1 - x0)/dx;
    y := Float->New[n->As(Int)];

    y[0] := 1;
    for(i := 1; i < n; i++;) {
      y[i] := Rk4(Rate(Float, Float) ~ Float, dx, x0 + dx * (i - 1), y[i-1]);
    };

    for(i := 0; i < n; i += 10;) {
      x := x0 + dx * i;
      y2 := (x * x / 4 + 1)->Power(2.0);

      x_value := x->As(Int);
      y_value := y[i];
      rel_value := y_value/y2 - 1.0;
      "y({$x_value})={$y_value}; error: {$rel_value}"->PrintLine();
    };
  }

  function : native : Rk4(f : (Float, Float) ~ Float, dx : Float, x : Float, y : Float) ~ Float {
    k1 := dx * f(x, y);
    k2 := dx * f(x + dx / 2, y + k1 / 2);
    k3 := dx * f(x + dx / 2, y + k2 / 2);
    k4 := dx * f(x + dx, y + k3);

    return y + (k1 + 2 * k2 + 2 * k3 + k4) / 6;
  }

  function : native : Rate(x : Float, y : Float) ~ Float {
    return x * y->SquareRoot();
  }
}


let y' t y = t *. sqrt y
let exact t = let u = 0.25*.t*.t +. 1.0 in u*.u

let rk4_step (y,t) h =
  let k1 = h *. y' t y in
  let k2 = h *. y' (t +. 0.5*.h) (y +. 0.5*.k1) in
  let k3 = h *. y' (t +. 0.5*.h) (y +. 0.5*.k2) in
  let k4 = h *. y' (t +. h) (y +. k3) in
  (y +. (k1+.k4)/.6.0 +. (k2+.k3)/.3.0, t +. h)

let rec loop h n (y,t) =
  if n mod 10 = 1 then
    Printf.printf "t = %f,\ty = %f,\terr = %g\n" t y (abs_float (y -. exact t));
  if n < 102 then loop h (n+1) (rk4_step (y,t) h)

let _ = loop 0.1 1 (1.0, 0.0)


#Applying the Runge-Kutta method (This code must be implement on a different file than the main one).

function temp = rk4(func,x,pvi,h)
    K1 = h*func(x,pvi);
    K2 = h*func(x+0.5*h,pvi+0.5*K1);
    K3 = h*func(x+0.5*h,pvi+0.5*K2);
    K4 = h*func(x+h,pvi+K3);
    temp = pvi + (K1 + 2*K2 + 2*K3 + K4)/6;
endfunction

#Main Program.

f  = @(t) (1/16)*((t.^2 + 4).^2);
df = @(t,y) t*sqrt(y);

pvi = 1.0;
h   = 0.1;
Yn  = pvi;

for x = 0:h:10-h
    pvi = rk4(df,x,pvi,h);
    Yn = [Yn pvi];
endfor

fprintf('Time \t Exact Value \t ODE4 Value \t Num. Error\n');

for i=0:10
    fprintf('%d \t %.5f \t %.5f \t %.4g \n',i,f(i),Yn(1+i*10),f(i)-Yn(1+i*10));
endfor


program RungeKuttaExample;

uses sysutils;

type
    TDerivative = function (t, y : Real) : Real;

procedure RungeKutta(yDer : TDerivative;
                     var t, y : array of Real;
                     dt   : Real);
var
    dy1, dy2, dy3, dy4 : Real;
    idx                : Cardinal;

begin
    for idx := Low(t) to High(t) - 1 do
    begin
        dy1 := dt * yDer(t[idx],            y[idx]);
        dy2 := dt * yDer(t[idx] + dt / 2.0, y[idx] + dy1 / 2.0);
        dy3 := dt * yDer(t[idx] + dt / 2.0, y[idx] + dy2 / 2.0);
        dy4 := dt * yDer(t[idx] + dt,       y[idx] + dy3);

        t[idx + 1] := t[idx] + dt;
        y[idx + 1] := y[idx] + (dy1 + 2.0 * (dy2 + dy3) + dy4) / 6.0;
    end;
end;

function CalcError(t, y : Real) : Real;
var
    trueVal : Real;

begin
    trueVal := sqr(sqr(t) + 4.0) / 16.0;
    CalcError := abs(trueVal - y);
end;

procedure Print(t, y : array of Real;
                modnum : Integer);
var
    idx : Cardinal;

begin
    for idx := Low(t) to High(t) do
    begin
        if idx mod modnum = 0 then
        begin
            WriteLn(Format('y(%4.1f) = %12.8f  Error: %12.6e',
                [t[idx], y[idx], CalcError(t[idx], y[idx])]));
        end;
    end;
end;

function YPrime(t, y : Real) : Real;
begin
    YPrime := t * sqrt(y);
end;

const
    dt = 0.10;
    N = 100;

var
    tArr, yArr : array [0..N] of Real;

begin
    tArr[0] := 0.0;
    yArr[0] := 1.0;

    RungeKutta(@YPrime, tArr, yArr, dt);
    Print(tArr, yArr, 10);
end.


with javascript_semantics
constant dt = 0.1
atom y = 1.0
printf(1,"  x    true/actual y   calculated y    relative error\n")
printf(1," ---   -------------   -------------   --------------\n")
for i=0 to 100 do
    atom t = i*dt
    if integer(t) then
        atom act = power(t*t+4,2)/16
        printf(1,"%4.1f  %14.9f  %14.9f   %.9e\n",{t,act,y,abs(y-act)})
    end if
    atom k1 = t*sqrt(y),
         k2 = (t+dt/2)*sqrt(y+dt/2*k1),
         k3 = (t+dt/2)*sqrt(y+dt/2*k2),
         k4 = (t+dt)*sqrt(y+dt*k3)
    y += dt*(k1+2*(k2+k3)+k4)/6
end for


Runge_Kutta: procedure options (main);           /* 10 March 2014 */
   declare (y, dy1, dy2, dy3, dy4) float (18);
   declare t fixed decimal (10,1);
   declare dt float (18) static initial (0.1);

   y = 1;
   do t = 0 to 10 by 0.1;
      dy1 = dt * ydash(t, y);
      dy2 = dt * ydash(t + dt/2, y + dy1/2);
      dy3 = dt * ydash(t + dt/2, y + dy2/2);
      dy4 = dt * ydash(t + dt,   y + dy3);

      if mod(t, 1.0) = 0 then
         put skip edit('y(', trim(t), ')=', y, ', error = ', abs(y - (t**2 + 4)**2 / 16 ))
                      (3 a, column(9), f(16,10), a, f(13,10));
      y = y + (dy1 + 2*dy2 + 2*dy3 + dy4)/6;
   end;

ydash: procedure (t, y) returns (float(18));
   declare (t, y) float (18) nonassignable;
   return ( t*sqrt(y) );
end ydash;

end Runge_kutta;


    The Runge─Kutta method is used to solve the following differential equation:

                     y'(t) =  t2  √ y(t)

    The exact solution:   y(t)  =  (t2+4)2 ÷ 16


def calc_rk4(f)
  return ->(t,y,dt){
         ->(dy1   ){
         ->(dy2   ){
         ->(dy3   ){
         ->(dy4   ){ ( dy1 + 2*dy2 + 2*dy3 + dy4 ) / 6 }.call(
           dt * f.call( t + dt  , y + dy3   ))}.call(
           dt * f.call( t + dt/2, y + dy2/2 ))}.call(
           dt * f.call( t + dt/2, y + dy1/2 ))}.call(
           dt * f.call( t       , y         ))}
end

TIME_MAXIMUM, WHOLE_TOLERANCE = 10.0, 1.0e-5
T_START, Y_START, DT          =  0.0, 1.0, 0.10

def my_diff_eqn(t,y) ; t * Math.sqrt(y)                    ; end
def my_solution(t  ) ; (t**2 + 4)**2 / 16                  ; end
def  find_error(t,y) ; (y - my_solution(t)).abs            ; end
def   is_whole?(t  ) ; (t.round - t).abs < WHOLE_TOLERANCE ; end

dy = calc_rk4( ->(t,y){my_diff_eqn(t,y)} )

t, y = T_START, Y_START
while t <= TIME_MAXIMUM
  printf("y(%4.1f)\t= %12.6f \t error: %12.6e\n",t,y,find_error(t,y)) if is_whole?(t)
  t, y = t + DT, y + dy.call(t,y,DT)
end


object Main extends App {
   val f = (t: Double, y: Double) => t * Math.sqrt(y) // Runge-Kutta solution
   val g = (t: Double) => Math.pow(t * t + 4, 2) / 16 // Exact solution
   new Calculator(f, Some(g)).compute(100, 0, .1, 1)
}

class Calculator(f: (Double, Double) => Double, g: Option[Double => Double] = None) {
   def compute(counter: Int, tn: Double, dt: Double, yn: Double): Unit = {
      if (counter % 10 == 0) {
         val c = (x: Double => Double) => (t: Double) => {
            val err = Math.abs(x(t) - yn)
            f" Error: $err%7.5e"
         }
         val s = g.map(c(_)).getOrElse((x: Double) => "") // If we don't have exact solution, just print nothing
         println(f"y($tn%4.1f) = $yn%12.8f${s(tn)}") // Else, print Error estimation here
      }
      if (counter > 0) {
         val dy1 = dt * f(tn, yn)
         val dy2 = dt * f(tn + dt / 2, yn + dy1 / 2)
         val dy3 = dt * f(tn + dt / 2, yn + dy2 / 2)
         val dy4 = dt * f(tn + dt, yn + dy3)
         val y = yn + (dy1 + 2 * dy2 + 2 * dy3 + dy4) / 6
         val t = tn + dt
         compute(counter - 1, t, dt, y)
      }
   }
}


func runge_kutta(yp) {
    func (t, y, δt) {
        var a = (δt * yp(t, y));
        var b = (δt * yp(t + δt/2, y + a/2));
        var c = (δt * yp(t + δt/2, y + b/2));
        var d = (δt * yp(t + δt, y + c));
        (a + 2*(b + c) + d) / 6;
    }
}

define δt = 0.1;
var δy = runge_kutta(func(t, y) { t * y.sqrt });

var(t, y) = (0, 1);
loop {
    t.is_int &&
        printf("y(%2d) = %12f ± %e\n", t, y, abs(y - ((t**2 + 4)**2 / 16)));
    t <= 10 || break;
    y += δy(t, y, δt);
    t += δt;
}


fun step y' (tn,yn) dt =
    let
        val dy1 = dt * y'(tn,yn)
        val dy2 = dt * y'(tn + 0.5 * dt, yn + 0.5 * dy1)
        val dy3 = dt * y'(tn + 0.5 * dt, yn + 0.5 * dy2)
        val dy4 = dt * y'(tn + dt, yn + dy3)
    in
        (tn + dt, yn + (1.0 / 6.0) * (dy1 + 2.0*dy2 + 2.0*dy3 + dy4))
    end

(* Suggested test case *)
fun testy' (t,y) =
    t * Math.sqrt y

fun testy t =
    (1.0 / 16.0) * Math.pow(Math.pow(t,2.0) + 4.0, 2.0)

(* Test-runner that iterates the step function and prints the results. *)
fun test t0 y0 dt steps print_freq y y' =
    let
        fun loop i (tn,yn) =
            if i = steps then ()
            else
                let
                    val (t1,y1) = step y' (tn,yn) dt
                    val y1' = y tn
                    val () = if i mod print_freq = 0 then
                                 (print ("Time: " ^ Real.toString tn ^ "\n");
                                  print ("Exact: " ^ Real.toString y1' ^ "\n");
                                  print ("Approx: " ^ Real.toString yn ^ "\n");
                                  print ("Error: " ^ Real.toString (y1' - yn) ^ "\n\n"))
                             else ()
                 in
                     loop (i+1) (t1,y1)
                end
    in
        loop 0 (t0,y0)
    end

(* Run the suggested test case *)
val () = test 0.0 1.0 0.1 101 10 testy testy'


import Foundation

func rk4(dx: Double, x: Double, y: Double, f: (Double, Double) -> Double) -> Double {
    let k1 = dx * f(x, y)
    let k2 = dx * f(x + dx / 2, y + k1 / 2)
    let k3 = dx * f(x + dx / 2, y + k2 / 2)
    let k4 = dx * f(x + dx, y + k3)

    return y + (k1 + 2 * k2 + 2 * k3 + k4) / 6
}

var y = [Double]()
var x: Double = 0.0
var y2: Double = 0.0

var x0: Double = 0.0
var x1: Double = 10.0
var dx: Double = 0.1

var i = 0
var n = Int(1 + (x1 - x0) / dx)

y.append(1)
for i in 1..<n {
    y.append(rk4(dx, x: x0 + dx * (Double(i) - 1), y: y[i - 1]) { (x: Double, y: Double) -> Double in
        return x * sqrt(y)
    })
}

print(" x         y        rel. err.")
print("------------------------------")

for (var i = 0; i < n; i += 10) {
    x = x0 + dx * Double(i)
    y2 = pow(x * x / 4 + 1, 2)

    print(String(format: "%2g  %11.6g    %11.5g", x, y[i], y[i]/y2 - 1))
}


package require Tcl 8.5

# Hack to bring argument function into expression
proc tcl::mathfunc::dy {t y} {upvar 1 dyFn dyFn; $dyFn $t $y}

proc rk4step {dyFn y* t* dt} {
    upvar 1 ${y*} y ${t*} t
    set dy1 [expr {$dt * dy($t,       $y)}]
    set dy2 [expr {$dt * dy($t+$dt/2, $y+$dy1/2)}]
    set dy3 [expr {$dt * dy($t+$dt/2, $y+$dy2/2)}]
    set dy4 [expr {$dt * dy($t+$dt,   $y+$dy3)}]
    set y [expr {$y + ($dy1 + 2*$dy2 + 2*$dy3 + $dy4)/6.0}]
    set t [expr {$t + $dt}]
}

proc y {t} {expr {($t**2 + 4)**2 / 16}}
proc δy {t y} {expr {$t * sqrt($y)}}

proc printvals {t y} {
    set err [expr {abs($y - [y $t])}]
    puts [format "y(%.1f) = %.8f\tError: %.8e" $t $y $err]
}

set t 0.0
set y 1.0
set dt 0.1
printvals $t $y
for {set i 1} {$i <= 101} {incr i} {
    rk4step  δy  y t  $dt
    if {$i%10 == 0} {
	printvals $t $y
    }
}


import "/fmt" for Fmt

var rungeKutta4 = Fn.new { |t0, tz, dt, y, yd|
    var tn = t0
    var yn = y.call(tn)
    var z = ((tz - t0)/dt).truncate
    for (i in 0..z) {
        if (i % 10 == 0) {
            var exact = y.call(tn)
            var error = yn - exact
            Fmt.print("$4.1f  $10f  $10f  $9f", tn, yn, exact, error)
        }
        if (i == z) break
        var dy1 = dt * yd.call(tn, yn)
        var dy2 = dt * yd.call(tn + 0.5 * dt, yn + 0.5 * dy1)
        var dy3 = dt * yd.call(tn + 0.5 * dt, yn + 0.5 * dy2)
        var dy4 = dt * yd.call(tn + dt, yn + dy3)
        yn = yn + (dy1 + 2.0 * dy2 + 2.0 * dy3 + dy4) / 6.0
        tn = tn + dt
    }
}

System.print("  T        RK4        Exact      Error")
System.print("----  ---------  ----------  ---------")
var y = Fn.new { |t|
    var x = t * t + 4.0
    return x * x / 16.0
}
var yd = Fn.new { |t, yt| t * yt.sqrt }
rungeKutta4.call(0, 10, 0.1, y, yd)


T Token
   T.enum Kind
      INT
      FLOAT
      STRING
      IDENT
      LPAR
      RPAR
      END

   Kind kind
   String val

   F (kind, val = ‘’)
      .kind = kind
      .val = val

F lex(input_str)
   [Token] result
   V pos = 0

   F current()
      R I @pos < @input_str.len {@input_str[@pos]} E Char("\0")

   L pos < input_str.len
      V ch = input_str[pos]
      I ch == ‘(’
         pos++
         result.append(Token(Token.Kind.LPAR))
      E I ch == ‘)’
         pos++
         result.append(Token(Token.Kind.RPAR))
      E I ch C ‘0’..‘9’
         V num = ‘’
         V kind = Token.Kind.INT
         L current() C ‘0’..‘9’
            num ‘’= current()
            pos++
         I current() == ‘.’
            num ‘’= current()
            kind = FLOAT
            pos++
            L current() C ‘0’..‘9’
               num ‘’= current()
               pos++
         result.append(Token(kind, num))
      E I ch C (‘ ’, "\t", "\n", "\r")
         pos++
      E I ch == ‘"’
         V str = ‘’
         pos++
         L current() != ‘"’
            str ‘’= current()
            pos++
         pos++
         result.append(Token(Token.Kind.STRING, str))
      E
         V BannedChars = Set([‘ ’, "\t", ‘"’, ‘(’, ‘)’, ‘;’])
         V ident = ‘’
         L current() !C BannedChars
            ident ‘’= current()
            pos++
         result.append(Token(Token.Kind.IDENT, ident))

   result.append(Token(Token.Kind.END))
   R result

F indent(s, count)
   R (count * ‘ ’)‘’s.replace("\n", "\n"(count * ‘ ’))

T SExpr
   T.enum Kind
      INT
      FLOAT
      STRING
      IDENT
      LIST

   Kind kind
   String val
   [SExpr] children

   F (kind, val = ‘’)
      .kind = kind
      .val = val

   F to_str()
      I .kind C (SExpr.Kind.INT, SExpr.Kind.FLOAT, SExpr.Kind.IDENT)
         R .val
      E I .kind == STRING
         R ‘"’(.val)‘"’
      E I .kind == LIST
         V result = ‘(’
         L(i, ex) enumerate(.children)
            I ex.kind == LIST & ex.children.len > 1
               result ‘’= "\n"
               result ‘’= indent(ex.to_str(), 2)
            E
               I i > 0
                  result ‘’= ‘ ’
               result ‘’= ex.to_str()
         R result‘)’
      assert(0B)

V input_str = ‘
((data "quoted data" 123 4.5)
 (data ([email protected]# (4.5) "(more" "data)")))
’
V tokens = lex(input_str)
V pos = 0

F current()
   R I :pos < :tokens.len {:tokens[:pos]} E Token(Token.Kind.END)

F parse() -> SExpr
   V token = current()
   :pos++
   I token.kind == INT
      R SExpr(SExpr.Kind.INT, token.val)
   E I token.kind == FLOAT
      R SExpr(SExpr.Kind.FLOAT, token.val)
   E I token.kind == STRING
      R SExpr(SExpr.Kind.STRING, token.val)
   E I token.kind == IDENT
      R SExpr(SExpr.Kind.IDENT, token.val)
   E I token.kind == LPAR
      V result = SExpr(SExpr.Kind.LIST)
      L current().kind !C (Token.Kind.RPAR, Token.Kind.END)
         result.children.append(parse())
      assert(current().kind != END, ‘Missing right paren ')'’)
      :pos++
      R result
   assert(0B)

print(parse().to_str())


with Ada.Strings.Unbounded;
private with Ada.Containers.Indefinite_Vectors;

generic
   with procedure Print_Line(Indention: Natural; Line: String);
package S_Expr is

   function "-"(S: String) return Ada.Strings.Unbounded.Unbounded_String
     renames Ada.Strings.Unbounded.To_Unbounded_String;

   function "+"(U: Ada.Strings.Unbounded.Unbounded_String) return String
     renames Ada.Strings.Unbounded.To_String;

   type Empty_Data is tagged null record;
   subtype Data is Empty_Data'Class;
   procedure Print(This: Empty_Data; Indention: Natural);
   -- any object form class Data knows how to print itself
   -- objects of class data are either List of Data or Atomic
   -- atomic objects hold either an integer or a float or a string

   type List_Of_Data is new Empty_Data with private;
   overriding procedure Print(This: List_Of_Data; Indention: Natural);
   function First(This: List_Of_Data) return Data;
   function Rest(This: List_Of_Data) return List_Of_Data;
   function Empty(This: List_Of_Data) return Boolean;

   type Atomic is new Empty_Data with null record;

   type Str_Data is new Atomic with record
      Value: Ada.Strings.Unbounded.Unbounded_String;
      Quoted: Boolean := False;
   end record;
   overriding procedure Print(This: Str_Data; Indention: Natural);

   type Int_Data is new Atomic with record
      Value: Integer;
   end record;
   overriding procedure Print(This: Int_Data; Indention: Natural);

   type Flt_Data is new Atomic with record
      Value: Float;
   end record;
   overriding procedure Print(This: Flt_Data; Indention: Natural);

private

   package Vectors is new Ada.Containers.Indefinite_Vectors
     (Index_Type   => Positive,
      Element_Type => Data);

   type List_Of_Data is new Empty_Data with record
      Values: Vectors.Vector;
   end record;

end S_Expr;


# S-Expressions #
CHAR nl = REPR 10;
# mode representing an S-expression #
MODE SEXPR = STRUCT( UNION( VOID, STRING, REF SEXPR ) element, REF SEXPR next );
# creates an initialises an SEXPR #
PROC new s expr = REF SEXPR: HEAP SEXPR := ( EMPTY, NIL );
# reports an error #
PROC error = ( STRING msg )VOID: print( ( "**** ", msg, newline ) );
# S-expression reader - reads and returns an S-expression from the string s #
PROC s reader = ( STRING s )REF SEXPR:
     BEGIN
        PROC at end      = BOOL: s pos > UPB s;
        PROC curr        = CHAR: IF at end THEN REPR 0 ELSE s[ s pos ] FI;
        PROC skip spaces = VOID: WHILE NOT at end AND ( curr = " " OR curr = nl ) DO s pos +:= 1 OD;
        PROC end of list = BOOL: at end OR curr = ")";
        INT s pos := LWB s;
        INT t pos;
        [ ( UPB s - LWB s ) + 1 ]CHAR token; # token text - large enough to hold the whole string if necessary #
        # adds the current character to the token #
        PROC add curr    = VOID: token[ t pos +:= 1 ] := curr;
        # get an s expression element from s #
        PROC get element = REF SEXPR:
             BEGIN
                REF SEXPR result = new s expr;
                skip spaces;
                # get token text #
                IF   at end THEN
                    # no element #
                    element OF result := EMPTY
                ELIF curr = "("  THEN
                    s pos +:= 1;
                    skip spaces;
                    IF NOT end of list
                    THEN
                        REF SEXPR nested expression = get element;
                        REF SEXPR element pos      := nested expression;
                        element OF result          := nested expression;
                        skip spaces;
                        WHILE NOT end of list
                        DO
                            element pos := next OF element pos := get element;
                            skip spaces
                        OD
                    FI;
                    IF curr = ")" THEN
                        s pos +:= 1
                    ELSE
                        error( "Missing "")""" )
                    FI
                ELIF curr = ")" THEN
                    s pos +:= 1;
                    error( "Unexpected "")""" );
                    element OF result := EMPTY
                ELSE
                    # quoted or unquoted string #
                    t pos := LWB token - 1;
                    IF curr /= """" THEN
                        # unquoted string #
                        WHILE add curr;
                              s pos +:= 1;
                              NOT at end AND curr /= " " AND curr /= "("
                                         AND curr /= ")" AND curr /= """"
                                         AND curr /= nl
                        DO SKIP OD
                    ELSE
                        # quoted string #
                        WHILE add curr;
                              s pos +:= 1;
                              NOT at end AND curr /= """"
                        DO SKIP OD;
                        IF curr /= """" THEN
                            # missing string quote #
                            error( "Unterminated string: <<" + token[ : t pos ] + ">>" )
                        ELSE
                            # have the closing quote #
                            add curr;
                            s pos +:= 1
                        FI
                    FI;
                    element OF result := token[ : t pos ]
                FI;
                result
             END # get element # ;

        REF SEXPR s expr = get element;
        skip spaces;
        IF NOT at end THEN
            # extraneuos text after the expression #
            error( "Unexpected text at end of expression: " + s[ s pos : ] )
        FI;

        s expr
     END # s reader # ;
# prints an S expression #
PROC s writer = ( REF SEXPR s expr )VOID:
     BEGIN
        # prints an S expression with a suitable indent #
        PROC print indented s expression = ( REF SEXPR s expr, INT indent )VOID:
             BEGIN
                REF SEXPR s pos := s expr;
                WHILE REF SEXPR( s pos ) ISNT REF SEXPR( NIL ) DO
                    FOR i TO indent DO print( ( " " ) ) OD;
                    CASE element OF s pos
                    IN  (VOID       ): print( ( "()", newline ) )
                     ,  (STRING    s): print( ( s,    newline ) )
                     ,  (REF SEXPR e): BEGIN
                                          print( ( "(", newline ) );
                                          print indented s expression( e, indent + 4 );
                                          FOR i TO indent DO print( ( " " ) ) OD;
                                          print( ( ")", newline ) )
                                      END
                    OUT
                        error( "Unexpected S expression element" )
                    ESAC;
                    s pos := next OF s pos
                OD
             END # print indented s expression # ;

        print indented s expression( s expr, 0 )
     END # s writer # ;
# test the eader and writer with the example from the task #
s writer( s reader( "((data ""quoted data"" 123 4.5)"
                  + nl
                  + " (data ([email protected]# (4.5) ""(more"" ""data)"")))"
                  + nl
                  )
        )


code: {
    ((data "quoted data" 123 4.5)
     (data ([email protected]# (4.5) "(more" "data)")))
}

s: first to :block code
inspect.muted s
print as.code s


S_Expressions(Str){
	Str := RegExReplace(Str, "s)(?<![\\])"".*?[^\\]""(*SKIP)(*F)|((?<![\\])[)(]|\s)", "`n$0`n")
	Str := RegExReplace(Str, "`am)^\s*\v+")	,	Cnt := 0
	loop, parse, Str, `n, `r
	{
		Cnt := A_LoopField=")" ? Cnt-1 : Cnt
		Res .= tabs(Cnt) A_LoopField "`r`n"
		Cnt := A_LoopField="(" ? Cnt+1 : Cnt
	}
	return Res
}
tabs(n){
	loop, % n
		Res .= "`t"
	return Res
}


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

enum { S_NONE, S_LIST, S_STRING, S_SYMBOL };

typedef struct {
	int type;
	size_t len;
	void *buf;
} s_expr, *expr;

void whine(const char *s)
{
	fprintf(stderr, "parse error before ==>%.10s\n", s);
}

expr parse_string(const char *s, char **e)
{
	expr ex = calloc(sizeof(s_expr), 1);
	char buf[256] = {0};
	int i = 0;

	while (*s) {
		if (i >= 256) {
			fprintf(stderr, "string too long:\n");
			whine(s);
			goto fail;
		}
		switch (*s) {
		case '\\':
			switch (*++s) {
			case '\\':
			case '"':	buf[i++] = *s++;
					continue;

			default:	whine(s);
					goto fail;
			}
		case '"':	goto success;
		default:	buf[i++] = *s++;
		}
	}
fail:
	free(ex);
	return 0;

success:
	*(const char **)e = s + 1;
	ex->type = S_STRING;
	ex->buf = strdup(buf);
	ex->len = strlen(buf);
	return ex;
}

expr parse_symbol(const char *s, char **e)
{
	expr ex = calloc(sizeof(s_expr), 1);
	char buf[256] = {0};
	int i = 0;

	while (*s) {
		if (i >= 256) {
			fprintf(stderr, "symbol too long:\n");
			whine(s);
			goto fail;
		}
		if (isspace(*s)) goto success;
		if (*s == ')' || *s == '(') {
			s--;
			goto success;
		}

		switch (*s) {
		case '\\':
			switch (*++s) {
			case '\\': case '"': case '(': case ')':
					buf[i++] = *s++;
					continue;
			default:	whine(s);
					goto fail;
			}
		case '"':	whine(s);
				goto success;
		default:	buf[i++] = *s++;
		}
	}
fail:
	free(ex);
	return 0;

success:
	*(const char **)e = s + 1;
	ex->type = S_SYMBOL;
	ex->buf = strdup(buf);
	ex->len = strlen(buf);
	return ex;
}

void append(expr list, expr ele)
{
	list->buf = realloc(list->buf, sizeof(expr) * ++list->len);
	((expr*)(list->buf))[list->len - 1] = ele;
}

expr parse_list(const char *s, char **e)
{
	expr ex = calloc(sizeof(s_expr), 1), chld;
	char *next;

	ex->len = 0;

	while (*s) {
		if (isspace(*s)) {
			s++;
			continue;
		}

		switch (*s) {
		case '"':
			chld = parse_string(s+1, &next);
			if (!chld) goto fail;
			append(ex, chld);
			s = next;
			continue;
		case '(':
			chld = parse_list(s+1, &next);
			if (!chld) goto fail;
			append(ex, chld);
			s = next;
			continue;
		case ')':
			goto success;

		default:
			chld = parse_symbol(s, &next);
			if (!chld) goto fail;
			append(ex, chld);
			s = next;
			continue;
		}
	}

fail:
	whine(s);
	free(ex);
	return 0;

success:
	*(const char **)e = s+1;
	ex->type = S_LIST;
	return ex;
}

expr parse_term(const char *s, char **e)
{
	while (*s) {
		if (isspace(*s)) {
			s++;
			continue;
		}
		switch(*s) {
		case '(':
			return parse_list(s+1, e);
		case '"':
			return parse_string(s+1, e);
		default:
			return parse_symbol(s+1, e);
		}
	}
	return 0;
}

void print_expr(expr e, int depth)
{
#define sep() for(i = 0; i < depth; i++) printf("    ")
	int i;
	if (!e) return;

	switch(e->type) {
	case S_LIST:
		sep();
		puts("(");
		for (i = 0; i < e->len; i++)
			print_expr(((expr*)e->buf)[i], depth + 1);
		sep();
		puts(")");
		return;
	case S_SYMBOL:
	case S_STRING:
		sep();
		if (e->type == S_STRING) putchar('"');
		for (i = 0; i < e->len; i++) {
			switch(((char*)e->buf)[i]) {
			case '"':
			case '\\':
				putchar('\\');
				break;
			case ')': case '(':
				if (e->type == S_SYMBOL)
					putchar('\\');
			}

			putchar(((char*)e->buf)[i]);
		}
		if (e->type == S_STRING) putchar('"');
		putchar('\n');
		return;
	}
}

int main()
{
	char *next;
	const char *in = "((data da\\(\\)ta \"quot\\\\ed data\" 123 4.5)\n"
			" (\"data\" ([email protected]# (4.5) \"(mo\\\"re\" \"data)\")))";

	expr x = parse_term(in, &next);

	printf("input is:\n%s\n", in);
	printf("parsed as:\n");
	print_expr(x, 0);
	return 0;
}


using System;
using System.Collections.Generic;
using System.Text;

  public class SNode
    {
        private List<SNode> _items;
        public string Name { get; set; }
        public IReadOnlyCollection<SNode> Items { get { return _items.AsReadOnly(); } }
        public SNode()
        {
            this._items = new List<SNode>();
        }
        public SNode(string name):this()
        {
            this.Name=name;
        }
        public void AddNode(SNode node)
        {
            this._items.Add(node);
        }
    }

    public class SNodeFull : SNode
    {
        private bool _isLeaf;
        public bool IsLeaf { get => _isLeaf; }
        public SNodeFull(bool isLeaf) : base()
        {
            this._isLeaf = isLeaf;
        }

        public SNodeFull(string name, bool isLeaf) : base(name)
        {
            this._isLeaf = isLeaf;
        }

        public SNodeFull RootNode { get; set; }

        public void AddNode(SNodeFull node)
        {
            base.AddNode(node);
            node.RootNode = this;
        }
    }


#include <cctype>
#include <iomanip>
#include <iostream>
#include <list>
#include <memory>
#include <sstream>
#include <string>
#include <variant>

namespace s_expr {

enum class token_type { none, left_paren, right_paren, symbol, string, number };
enum class char_type { left_paren, right_paren, quote, escape, space, other };
enum class parse_state { init, quote, symbol };

struct token {
    token_type type = token_type::none;
    std::variant<std::string, double> data;
};

char_type get_char_type(char ch) {
    switch (ch) {
    case '(':
        return char_type::left_paren;
    case ')':
        return char_type::right_paren;
    case '"':
        return char_type::quote;
    case '\\':
        return char_type::escape;
    }
    if (isspace(static_cast<unsigned char>(ch)))
        return char_type::space;
    return char_type::other;
}

bool parse_number(const std::string& str, token& tok) {
    try {
        size_t pos = 0;
        double num = std::stod(str, &pos);
        if (pos == str.size()) {
            tok.type = token_type::number;
            tok.data = num;
            return true;
        }
    } catch (const std::exception&) {
    }
    return false;
}

bool get_token(std::istream& in, token& tok) {
    char ch;
    parse_state state = parse_state::init;
    bool escape = false;
    std::string str;
    token_type type = token_type::none;
    while (in.get(ch)) {
        char_type ctype = get_char_type(ch);
        if (escape) {
            ctype = char_type::other;
            escape = false;
        } else if (ctype == char_type::escape) {
            escape = true;
            continue;
        }
        if (state == parse_state::quote) {
            if (ctype == char_type::quote) {
                type = token_type::string;
                break;
            }
            else
                str += ch;
        } else if (state == parse_state::symbol) {
            if (ctype == char_type::space)
                break;
            if (ctype != char_type::other) {
                in.putback(ch);
                break;
            }
            str += ch;
        } else if (ctype == char_type::quote) {
            state = parse_state::quote;
        } else if (ctype == char_type::other) {
            state = parse_state::symbol;
            type = token_type::symbol;
            str = ch;
        } else if (ctype == char_type::left_paren) {
            type = token_type::left_paren;
            break;
        } else if (ctype == char_type::right_paren) {
            type = token_type::right_paren;
            break;
        }
    }
    if (type == token_type::none) {
        if (state == parse_state::quote)
            throw std::runtime_error("syntax error: missing quote");
        return false;
    }
    tok.type = type;
    if (type == token_type::string)
        tok.data = str;
    else if (type == token_type::symbol) {
        if (!parse_number(str, tok))
            tok.data = str;
    }
    return true;
}

void indent(std::ostream& out, int level) {
    for (int i = 0; i < level; ++i)
        out << "   ";
}

class object {
public:
    virtual ~object() {}
    virtual void write(std::ostream&) const = 0;
    virtual void write_indented(std::ostream& out, int level) const {
        indent(out, level);
        write(out);
    }
};

class string : public object {
public:
    explicit string(const std::string& str) : string_(str) {}
    void write(std::ostream& out) const { out << std::quoted(string_); }
private:
    std::string string_;
};

class symbol : public object {
public:
    explicit symbol(const std::string& str) : string_(str) {}
    void write(std::ostream& out) const {
        for (char ch : string_) {
            if (get_char_type(ch) != char_type::other)
                out << '\\';
            out << ch;
        }
    }
private:
    std::string string_;
};

class number : public object {
public:
    explicit number(double num) : number_(num) {}
    void write(std::ostream& out) const { out << number_; }
private:
    double number_;
};

class list : public object {
public:
    void write(std::ostream& out) const;
    void write_indented(std::ostream&, int) const;
    void append(const std::shared_ptr<object>& ptr) {
        list_.push_back(ptr);
    }
private:
    std::list<std::shared_ptr<object>> list_;
};

void list::write(std::ostream& out) const {
    out << "(";
    if (!list_.empty()) {
        auto i = list_.begin();
        (*i)->write(out);
        while (++i != list_.end()) {
            out << ' ';
            (*i)->write(out);
        }
    }
    out << ")";
}

void list::write_indented(std::ostream& out, int level) const {
    indent(out, level);
    out << "(\n";
    if (!list_.empty()) {
        for (auto i = list_.begin(); i != list_.end(); ++i) {
            (*i)->write_indented(out, level + 1);
            out << '\n';
        }
    }
    indent(out, level);
    out << ")";
}

class tokenizer {
public:
    tokenizer(std::istream& in) : in_(in) {}
    bool next() {
        if (putback_) {
            putback_ = false;
            return true;
        }
        return get_token(in_, current_);
    }
    const token& current() const {
        return current_;
    }
    void putback() {
        putback_ = true;
    }
private:
    std::istream& in_;
    bool putback_ = false;
    token current_;
};

std::shared_ptr<object> parse(tokenizer&);

std::shared_ptr<list> parse_list(tokenizer& tok) {
    std::shared_ptr<list> lst = std::make_shared<list>();
    while (tok.next()) {
        if (tok.current().type == token_type::right_paren)
            return lst;
        else
            tok.putback();
        lst->append(parse(tok));
    }
    throw std::runtime_error("syntax error: unclosed list");
}

std::shared_ptr<object> parse(tokenizer& tokenizer) {
    if (!tokenizer.next())
        return nullptr;
    const token& tok = tokenizer.current();
    switch (tok.type) {
    case token_type::string:
        return std::make_shared<string>(std::get<std::string>(tok.data));
    case token_type::symbol:
        return std::make_shared<symbol>(std::get<std::string>(tok.data));
    case token_type::number:
        return std::make_shared<number>(std::get<double>(tok.data));
    case token_type::left_paren:
        return parse_list(tokenizer);
    default:
        break;
    }
    throw std::runtime_error("syntax error: unexpected token");
}

} // namespace s_expr

void parse_string(const std::string& str) {
    std::istringstream in(str);
    s_expr::tokenizer tokenizer(in);
    auto exp = s_expr::parse(tokenizer);
    if (exp != nullptr) {
        exp->write_indented(std::cout, 0);
        std::cout << '\n';
    }
}

int main(int argc, char** argv) {
    std::string test_string =
        "((data \"quoted data\" 123 4.5)\n"
        " (data ([email protected]# (4.5) \"(more\" \"data)\")))";
    if (argc == 2)
        test_string = argv[1];
    try {
        parse_string(test_string);
    } catch (const std::exception& ex) {
        std::cerr << ex.what() << '\n';
    }
    return 0;
}


random:seed(Int(Time().unix_time()))
V total = 0
V count = 0

[Int] attributes
L total < 75 | count < 2
   attributes = (0..5).map(attribute -> (sum(sorted((0..3).map(roll -> random:(1 .. 6)))[1..])))

   L(attribute) attributes
      I attribute >= 15
         count++

   total = sum(attributes)

print(total‘ ’attributes)


class Symbol(symbol) {
    shared String symbol;
    string => symbol;
}

abstract class Token()
        of  DataToken | leftParen | rightParen {}

abstract class DataToken(data)
        of StringToken | IntegerToken | FloatToken | SymbolToken
        extends Token() {

    shared String|Integer|Float|Symbol data;
    string => data.string;
}

class StringToken(String data) extends DataToken(data) {}
class IntegerToken(Integer data) extends DataToken(data) {}
class FloatToken(Float data) extends DataToken(data) {}
class SymbolToken(Symbol data) extends DataToken(data) {}

object leftParen extends Token() {
    string => "(";
}
object rightParen extends Token() {
    string => ")";
}

class Tokens(String input) satisfies {Token*} {
    shared actual Iterator<Token> iterator() => object satisfies Iterator<Token> {

        variable value index = 0;

        shared actual Token|Finished next() {

            while(exists nextChar = input[index], nextChar.whitespace) {
                index++;
            }

            if(index >= input.size) {
                return finished;
            }

            assert(exists char = input[index]);

            if(char == '(') {
                index++;
                return leftParen;
            }
            if(char == ')') {
                index++;
                return rightParen;
            }

            if(char == '"') {
                value builder = StringBuilder();
                while(exists nextChar = input[++index]) {
                    if(nextChar == '"') {
                        index++;
                        break;
                    }
                    if(nextChar == '\\') {
                        if(exists nextNextChar = input[++index]) {
                            switch(nextNextChar)
                            case('\\') {
                                builder.append("\\");
                            }
                            case('t') {
                                builder.append("\t");
                            }
                            case('n') {
                                builder.append("\n");
                            }
                            case('"') {
                                builder.append("\"");
                            }
                            else {
                                throw Exception("unknown escaped character");
                            }
                        } else {
                            throw Exception("unclosed string");
                        }
                    } else {
                        builder.appendCharacter(nextChar);
                    }
                }
                return StringToken(builder.string);
            }

            value builder = StringBuilder();
            while(exists nextChar = input[index], !nextChar.whitespace && nextChar != '(' && nextChar != ')') {
                builder.appendCharacter(nextChar);
                index++;
            }
            value string = builder.string;
            if(is Integer int = Integer.parse(string)) {
                return IntegerToken(int);
            } else if(is Float float = Float.parse(string)) {
                return FloatToken(float);
            } else {
                return SymbolToken(Symbol(string));
            }
        }
    };
}

abstract class Node() of Atom | Group {}

class Atom(data) extends Node() {
    shared String|Integer|Float|Symbol data;
    string => data.string;
}
class Group() extends Node() satisfies {Node*} {
    shared variable Node[] nodes = [];
    string => nodes.string;
    shared actual Iterator<Node> iterator() => nodes.iterator();

}

Node buildTree(Tokens tokens) {

    [Group, Integer] recursivelyBuild(Token[] tokens, variable Integer index = 0) {
        value result = Group();
        while(exists token = tokens[index]) {
            switch (token)
            case (leftParen) {
                value [newNode, newIndex] = recursivelyBuild(tokens, index + 1);
                index = newIndex;
                result.nodes = result.nodes.append([newNode]);
            }
            case (rightParen) {
                return [result, index];
            }
            else {
                result.nodes = result.nodes.append([Atom(token.data)]);
            }
            index++;
        }
        return [result, index];
    }

    value root = recursivelyBuild(tokens.sequence())[0];
    return root.first else Group();
}

void prettyPrint(Node node, Integer indentation = 0) {

    void paddedPrint(String s) => print(" ".repeat(indentation) + s);

    if(is Atom node) {
        paddedPrint(node.string);
    } else {
        paddedPrint("(");
        for(n in node.nodes) {
            prettyPrint(n, indentation + 2);
        }
        paddedPrint(")");
    }
}

shared void run() {
    value tokens = Tokens("""((data "quoted data" 123 4.5)
                               (data ([email protected]# (4.5) "(more" "data)")))""");
    print(tokens);

    value tree = buildTree(tokens);
    prettyPrint(tree);
}


# This code works with Lisp-like s-expressions.
#
# We lex tokens then do recursive descent on the tokens
# to build our data structures.

sexp = (data) ->
  # Convert a JS data structure to a string s-expression.  A sexier version
  # would remove quotes around strings that don't need them.
  s = ''
  if Array.isArray data
    children = (sexp elem for elem in data).join ' '
    '(' + children + ')'
  else
    return JSON.stringify data

parse_sexp = (sexp) ->
  tokens = lex_sexp sexp
  i = 0

  _parse_list = ->
    i += 1
    arr = []
    while i < tokens.length and tokens[i].type != ')'
      arr.push _parse()
    if i < tokens.length
      i += 1
    else
     throw Error "missing end paren"
    arr

  _guess_type = (word) ->
    # This is crude, doesn't handle all forms of floats.
    if word.match /^\d+\.\d+$/
      parseFloat(word)
    else if word.match /^\d+/
      parseInt(word)
    else
      word

  _parse_word = ->
    token = tokens[i]
    i += 1
    if token.type == 'string'
      token.word
    else
      _guess_type token.word

  _parse = ->
    return undefined unless i < tokens.length
    token = tokens[i]
    if token.type == '('
      _parse_list()
    else
      _parse_word()

  exp = _parse()
  throw Error "premature termination" if i < tokens.length
  exp

lex_sexp = (sexp) ->
  is_whitespace = (c) -> c in [' ', '\t', '\n']
  i = 0
  tokens = []

  test = (f) ->
    return false unless i < sexp.length
    f(sexp[i])

  eat_char = (c) ->
    tokens.push
      type: c
    i += 1

  eat_whitespace = ->
    i += 1
    while test is_whitespace
      i += 1

  eat_word = ->
    token = c
    i += 1
    word_char = (c) ->
      c != ')' and !is_whitespace c
    while test word_char
      token += sexp[i]
      i += 1
    tokens.push
      type: "word"
      word: token

  eat_quoted_word = ->
    start = i
    i += 1
    token = ''
    while test ((c) -> c != '"')
      if sexp[i] == '\\'
        i += 1
        throw Error("escaping error") unless i < sexp.length
      token += sexp[i]
      i += 1
    if test ((c) -> c == '"')
      tokens.push
        type: "string"
        word: token
      i += 1
    else
      throw Error("end quote missing #{sexp.substring(start, i)}")

  while i < sexp.length
    c = sexp[i]
    if c == '(' or c == ')'
      eat_char c
    else if is_whitespace c
      eat_whitespace()
    else if c == '"'
      eat_quoted_word()
    else
      eat_word()
  tokens

do ->
  input = """
    ((data "quoted data with escaped \\"" 123 4.5 "14")
     (data ([email protected]# (4.5) "(more" "data)")))
  """
  console.log "input:\n#{input}\n"
  output = parse_sexp(input)
  pp = (data) -> JSON.stringify data, null, '  '
  console.log "output:\n#{pp output}\n"
  console.log "round trip:\n#{sexp output}\n"


	bits	16
	cpu	8086
putch:	equ	2h
time:	equ	2ch
	org	100h
section	.text
	mov	ah,time		; Retrieve system time from MS-DOS
	int	21h
	call	rseed		; Seed the RNG
rolls:	xor	ah,ah		; AH=0 (running total)
	mov	dx,6		; DH=0 (amount >=15), DL=6 (counter)
	mov	di,attrs
attr:	call	roll4		; Roll an attribute
	mov	al,14
	cmp	al,bh		; Set carry if BH=15 or more
	mov	al,bh		; AL = roll
	sbb	bh,bh		; BH=0 if no carry, -1 if carry
	sub	dh,bh		; DH+=1 if >=15
	add	ah,al		; Add to running total
	mov	[di],al		; Save roll
	inc	di		; Next memory address
	dec	dl		; One fewer roll left
	jnz	attr
	cmp	ah,75		; Rolling total < 75?
	jb	rolls		; Then roll again.
	cmp	dh,2		; Fewer than 2 attrs < 15?
	jb	rolls		; Then roll again.
	;;;	Print the attributes
	mov	cx,6		; 6 attributes
p2:	mov	bl,10		; divide by 10 to get digits
	mov	di,attrs
print:	xor	ah,ah		; AX = attribute
	mov	al,[di]
	div	bl		; divide by 10
	add	ax,3030h	; add '0' to quotient (AH) and remainder (AL)
	mov	dx,ax
	mov	ah,putch
	int	21h		; print quotient first
	mov	dl,dh		; then remainder
	int	21h
	mov	dl,' '		; then a space
	int	21h
	inc	di		; Next attribute
	loop	print
	ret			; Back to DOS
	;;;	Do 4 rolls, and get result of max 3
roll4:	xor	bx,bx		; BH = running total
	dec	bl		; BL = lowest value
	mov	cx,4		; Four times
.roll:	call	d6		; Roll D6
	cmp 	al,bl		; Lower than current lowest value?
	jnb	.high		; If so,
	mov	bl,al		; Set new lowest value
.high:	add	bh,al		; Add to running total
	loop	.roll		; If not 4 rolls yet, loop back
	sub	bh,bl		; Subtract lowest value (giving sum of high 3)
	ret
	;;;	Roll a D6
d6:	call	rand		; Get random number
	and	al,7		; Between 0 and 7
	cmp	al,6		; If 6 or higher,
	jae	d6		; Then get new random number
	inc	al		; [1..6] instead of [0..5]
	ret
	;;;	Seed the random number generator with 4 bytes
rseed:	xor	[rnddat],cx
	xor	[rnddat+2],dx
	;;;	"X ABC" random number generator
	;;;	Generates 8-bit random number in AL
rand:	push	cx		; Keep registers
	push	dx
	mov	cx,[rnddat]	; CL=X CH=A
	mov	dx,[rnddat+2]	; DL=B DH=C
	xor	ch,dh		; A ^= C
	xor	ch,cl		; A ^= X
	add	dl,ch		; B += A
	mov	al,dl		; R = B
	shr	al,1		; R >>= 1
	xor	al,ch		; R ^= A
	add	al,dh		; R += C
	mov	dh,al		; C = R
	mov	[rnddat],cx	; Store new state
	mov	[rnddat+2],dx
	pop	dx		; Restore registers
	pop	cx
	ret
section	.bss
rnddat:	resb	4		; RNG state
attrs:	resb	6		; Rolled attributes


F encode(input_string)
   V count = 1
   V prev = Char("\0")
   [(Char, Int)] lst
   L(character) input_string
      I character != prev
         I prev != Char("\0")
            lst.append((prev, count))
         count = 1
         prev = character
      E
         count++
   lst.append((input_string.last, count))
   R lst

F decode(lst)
   V q = ‘’
   L(character, count) lst
      q ‘’= character * count
   R q

V value = encode(‘aaaaahhhhhhmmmmmmmuiiiiiiiaaaaaa’)
print(‘Encoded value is ’value.map(v -> String(v[1])‘’v[0]))
print(‘Decoded value is ’decode(value))


CL-USER> (read-from-string "((data \"quoted data\" 123 4.5) (data ([email protected]# (4.5) \"(more\" \"data)\")))")
((DATA "quoted data" 123 4.5) (DATA ([email protected]# (4.5) "[more" "data]")))
65
CL-USER> (caar *)  ;;The first element from the first sublist is DATA
DATA
CL-USER> (eval (read-from-string "(concatenate 'string \"foo\" \"bar\")"))  ;;An example with evaluation
"foobar"
CL-USER>


include "cowgol.coh";
include "strings.coh";
include "malloc.coh";

const MAXDEPTH := 256; # Maximum depth (used for stack sizes)
const MAXSTR := 256;   # Maximum string length

# Type markers
const T_ATOM := 1;
const T_STRING := 2;
const T_NUMBER := 3;
const T_LIST := 4;

# Value union
record SVal is
    number @at(0): int32;
    string @at(0): [uint8]; # also used for atoms
    list @at(0): [SExp];
end record;

# Holds a linked list of items
record SExp is
    type: uint8;
    next: [SExp];
    val: SVal;
end record;

# Free an S-Expression
sub FreeSExp(exp: [SExp]) is
    var stack: [SExp][MAXDEPTH];
    stack[0] := exp;
    var sp: @indexof stack := 1;

    while sp > 0 loop
        sp := sp - 1;
        exp := stack[sp];
        while exp != 0 as [SExp] loop
            var next := exp.next;
            case exp.type is
                when T_ATOM:
                    Free(exp.val.string);
                when T_STRING:
                    Free(exp.val.string);
                when T_LIST:
                    stack[sp] := exp.val.list;
                    sp := sp + 1;
            end case;
            Free(exp as [uint8]);
            exp := next;
        end loop;
    end loop;
end sub;

# Build an S-Expression
sub ParseSExp(in: [uint8]): (out: [SExp]) is
    out := 0 as [SExp];

    sub SkipSpace() is
        while ([in] != 0) and ([in] <= 32) loop
            in := @next in;
        end loop;
    end sub;

    sub AtomEnd(): (space: [uint8]) is
        space := in;
        while ([space] > 32)
        and   ([space] != '(')
        and   ([space] != ')') loop
            space := @next space;
        end loop;
    end sub;

    record Stk is
        start: [SExp];
        cur: [SExp];
    end record;

    var strbuf: uint8[MAXSTR];
    var stridx: @indexof strbuf := 0;
    var item: [SExp];
    var stack: Stk[MAXDEPTH];
    var sp: @indexof stack := 0;
    stack[0].start := 0 as [SExp];
    stack[0].cur := 0 as [SExp];

    sub Store(item: [SExp]) is
        if stack[sp].start == 0 as [SExp] then
            stack[sp].start := item;
        end if;
        if stack[sp].cur != 0 as [SExp] then
            stack[sp].cur.next := item;
        end if;
        stack[sp].cur := item;
    end sub;

    # called on error to clean up memory
    sub FreeAll() is
        loop
            FreeSExp(stack[sp].start);
            stack[sp].start := 0;
            if sp == 0 then break; end if;
            sp := sp - 1;
        end loop;
    end sub;

    loop
        SkipSpace();
        case [in] is
            when 0: break;
            when '"':
                var escape: uint8 := 0;
                stridx := 0;
                loop
                    in := @next in;
                    if [in] == 0 then break;
                    elseif escape == 1 then
                        strbuf[stridx] := [in];
                        stridx := stridx + 1;
                        escape := 0;
                    elseif [in] == '\\' then escape := 1;
                    elseif [in] == '"' then break;
                    else
                        strbuf[stridx] := [in];
                        stridx := stridx + 1;
                    end if;
                end loop;

                if [in] == 0 then
                    # missing _"_
                    FreeAll();
                    return;
                end if;
                in := @next in;
                strbuf[stridx] := 0;
                stridx := stridx + 1;

                item := Alloc(@bytesof SExp) as [SExp];
                item.type := T_STRING;
                item.val.string := Alloc(stridx as intptr);
                CopyString(&strbuf[0], item.val.string);
                Store(item);
            when '(':
                in := @next in;
                sp := sp + 1;
                stack[sp].start := 0 as [SExp];
                stack[sp].cur := 0 as [SExp];
            when ')':
                in := @next in;
                if sp == 0 then
                    # stack underflow, error
                    FreeAll();
                    return;
                else
                    item := Alloc(@bytesof SExp) as [SExp];
                    item.type := T_LIST;
                    item.val.list := stack[sp].start;
                    sp := sp - 1;
                    Store(item);
                end if;
            when else:
                var aend := AtomEnd();
                item := Alloc(@bytesof SExp) as [SExp];

                # if this is a valid integer number then store as number
                var ptr: [uint8];
                (item.val.number, ptr) := AToI(in);
                if ptr == aend then
                    # a number was parsed and the whole atom consumed
                    item.type := T_NUMBER;
                else
                    # not a valid integer number, store as atom
                    item.type := T_ATOM;
                    var length := aend - in;
                    item.val.string := Alloc(length + 1);
                    MemCopy(in, length, item.val.string);
                    [item.val.string + length] := 0;
                end if;
                in := aend;
                Store(item);
        end case;
    end loop;

    if sp != 0 then
        # unterminated list!
        FreeAll();
        return;
    else
        # return start of list
        out := stack[0].start;
    end if;
end sub;

# Prettyprint an S-Expression with types
sub prettyprint(sexp: [SExp]) is
    sub PrintNum(n: int32) is
        var buf: uint8[16];
        [IToA(n, 10, &buf[0])] := 0;
        print(&buf[0]);
    end sub;

    sub PrintQuoteStr(s: [uint8]) is
        print_char('"');
        while [s] != 0 loop
            if [s] == '"' or [s] == '\\' then
                print_char('\\');
            end if;
            print_char([s]);
            s := @next s;
        end loop;
        print_char('"');
    end sub;

    var stack: [SExp][MAXDEPTH];
    var sp: @indexof stack := 1;
    stack[0] := sexp;

    sub Indent(n: @indexof stack) is
        while n > 0 loop
            print("    ");
            n := n - 1;
        end loop;
    end sub;

    loop
        sp := sp - 1;
        while stack[sp] != 0 as [SExp] loop
            Indent(sp);
            case stack[sp].type is
                when T_ATOM:
                    print(stack[sp].val.string);
                    print(" :: Atom");
                    stack[sp] := stack[sp].next;
                when T_STRING:
                    PrintQuoteStr(stack[sp].val.string);
                    print(" :: String");
                    stack[sp] := stack[sp].next;
                when T_NUMBER:
                    PrintNum(stack[sp].val.number);
                    print(" :: Number");
                    stack[sp] := stack[sp].next;
                when T_LIST:
                    print_char('(');
                    sp := sp + 1;
                    stack[sp] := stack[sp-1].val.list;
                    stack[sp-1] := stack[sp-1].next;
            end case;
            print_nl();
        end loop;
        if sp == 0 then
            break;
        end if;
        Indent(sp-1);
        print_char(')');
        print_nl();
    end loop;
end sub;

var str := "((data \"quoted data\" 123 4.5)\n (data ([email protected]# (4.5) \"(more\" \"data)\")))";

print("Input:\n");
print(str);
print_nl();

print("Parsed:\n");
prettyprint(ParseSExp(str));
print_nl();