// version 1.1.2

import java.util.Calendar
import java.util.GregorianCalendar

val holidayOffsets = listOf(
    "Easter" to 0,
    "Ascension" to 39,
    "Pentecost" to 49,
    "Trinity" to 56,
    "C/Christi" to 60
)

fun String.padCenter(n: Int): String {
    val len = this.length
    if (n <= len) return this
    return this.padStart((n + len) / 2).padEnd(n)
}

fun calculateEaster(year: Int): GregorianCalendar {
    val a = year % 19
    val b = year / 100
    val c = year % 100
    val d = b / 4
    val e = b % 4
    val f = (b + 8) / 25
    val g = (b - f + 1) / 3
    val h = (19 * a + b - d - g + 15) % 30
    val i = c / 4
    val k = c % 4
    val l = (32 + 2 * e + 2 * i - h - k) % 7
    val m = (a + 11 * h + 22 * l) / 451
    val n = h + l - 7 * m + 114
    val month = n / 31 - 1  // months indexed from 0
    val day = (n % 31) + 1
    return GregorianCalendar(year, month, day)
}

fun outputHolidays(year: Int) {
    val date = calculateEaster(year)
    print("%4d  ".format(year))
    var po = 0
    for ((h, o) in holidayOffsets) {
        date.add(Calendar.DATE, o - po)
        po = o
        print("${"%1\$td %1\$tb".format(date).padCenter(h.length)}  ")
    }
    println()
}

fun main(args: Array<String>) {
    println("Year  Easter  Ascension  Pentecost  Trinity  C/Christi")
    println(" CE   Sunday  Thursday    Sunday    Sunday   Thursday ")
    println("----  ------  ---------  ---------  -------  ---------")
    for (year in 400..2100 step 100) outputHolidays(year)
    println()
    for (year in 2010..2020) outputHolidays(year)
}


program History_variables;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

type
  THistoryVarType = record
    value: variant;
    timestamp: TDateTime;
    function ToString: string;
  end;

  THistoryVar = record
    Fvalue: variant;
    FHistory: TArray<THistoryVarType>;
  private
    procedure SetValue(const Value: Variant);
    function GetTimestamp: TDateTime;
  public
    property History: TArray<THistoryVarType> read FHistory;
    constructor Init(val: variant);
    function Dump: string;
    function Recall(steps: Integer): variant; overload;
    function Recall(timestamp: TDateTime): variant; overload;
    property Timestamp: TDateTime read GetTimestamp;
    property Value: Variant read Fvalue write SetValue;
  end;

{ THistoryVar }

function THistoryVar.Dump: string;
begin
  Result := '';
  for var h in FHistory do
    Result := Result + h.ToString + #10;
end;

function THistoryVar.GetTimestamp: TDateTime;
begin
  if Length(FHistory) = 0 then
    exit(0);
  Result := FHistory[high(FHistory)].timestamp;
end;

constructor THistoryVar.Init(val: variant);
begin
  SetLength(Fhistory, 0);
  SetValue(val);
end;

function THistoryVar.Recall(timestamp: TDateTime): variant;
begin
  for var h in FHistory do
  begin
    if h.timestamp = timestamp then
      exit(h.value);
  end;
  result := Fvalue;
end;

function THistoryVar.Recall(steps: Integer): variant;
begin
  if (steps <= 1) or (steps >= Length(FHistory)) then
    exit(value);

  result := FHistory[Length(FHistory) - steps - 1].value;
end;

procedure THistoryVar.SetValue(const Value: Variant);
begin
  SetLength(FHistory, Length(FHistory) + 1);
  FHistory[High(FHistory)].Value := Value;
  FHistory[High(FHistory)].timestamp := now;
  Fvalue := Value;
end;

{ THistoryVarType }

function THistoryVarType.ToString: string;
var
  dt: string;
begin
  DateTimeToString(dt, 'mm/dd/yyyy hh:nn:ss.zzz', timestamp);
  Result := format('%s -  %s', [dt, Value]);
end;

begin
  var v := THistoryVar.Init(0);
  v.Value := True;

  Sleep(200);
  if v.Value then
    v.Value := 'OK';

  Sleep(100);
  if v.Value = 'OK' then
    v.Value := PI;

  writeln('History of variable values:'#10);
  Writeln(v.Dump);

  Writeln('Recall 2 steps');
  Writeln(v.Recall(2));

  var t := v.History[3].timestamp;
  Writeln(#10'Recall to timestamp ', datetimetostr(t));
  Writeln(v.Recall(t));

  readln;
end.


local Time = require("time")

function div (x, y) return math.floor(x / y) end

function easter (year)
    local G = year % 19
    local C = div(year, 100)
    local H = (C - div(C, 4) - div((8 * C + 13), 25) + 19 * G + 15) % 30
    local I = H - div(H, 28) * (1 - div(29, H + 1)) * (div(21 - G, 11))
    local J = (year + div(year, 4) + I + 2 - C + div(C, 4)) % 7
    local L = I - J
    local month = 3 + div(L + 40, 44)
    return month, L + 28 - 31 * div(month, 4)
end

function holidays (year)
    local dates = {}
    dates.easter = Time.date(year, easter(year))
    dates.ascension = dates.easter + Time.days(39)
    dates.pentecost = dates.easter + Time.days(49)
    dates.trinity   = dates.easter + Time.days(56)
    dates.corpus    = dates.easter + Time.days(60)
    return dates
end

function puts (...)
    for k, v in pairs{...} do io.write(tostring(v):sub(6, 10), "\t") end
end

function show (year, d)
    io.write(year, "\t")
    puts(d.easter, d.ascension, d.pentecost, d.trinity, d.corpus)
    print()
end

print("Year\tEaster\tAscen.\tPent.\tTrinity\tCorpus")
for year = 1600, 2100, 100 do show(year, holidays(year)) end
for year = 2010, 2020 do show(year, holidays(year)) end


(define-syntax-rule (make-h-var name) (define name (stack (gensym))))
(define-syntax-rule (h-get name) (stack-top name))
(define-syntax-rule (h-set name value) (push name value))
(define-syntax-rule (h-undo name)
	(begin
	(pop name)
	(when ( stack-empty? name) (error "no more values" 'name))
	(stack-top name)))

(define-syntax-rule (h-values name) (stack->list name))
;; usage
(make-h-var x)→ x

(h-set x 42) → 42
(h-set x 666)→ 666
(h-set x 'elvis)→ elvis
(h-values x) → (42 666 elvis) ;; historized values

(h-get x) → elvis
(h-undo x)→ 666
(h-undo x) → 42
(h-undo x) → ❌ error: no more values x


import extensions;
import system'collections;
import system'routines;
import extensions'routines;

class HistoryVariable
{
    Stack  previous := new Stack();
    object value;

    Value
    {
        get() = value;

        set(value)
        {
            if ((this value) != nil)
            {
                previous.push(this value)
            };

            this value := value
        }
    }

    undo()
    {
        ifnot (previous.isEmpty())
        {
            value := previous.pop()
        }
        else
        {
            value := nil
        }
    }

    enumerator() => previous;

    string toPrintable() => this value;
}

public program()
{
    var o := new HistoryVariable();
    o.Value := 5;
    o.Value := "foo";
    o.Value := o.Value + "bar";

    console.printLine(o);

    o.forEach:printingLn;

    o.undo().undo().undo();

    console.printLine(o.Value ?? "nil")
}


USING: accessors combinators formatting kernel models.history ;

1 <history> {
    [ add-history ]
    [ value>> "Initial value: %u\n" printf ]
    [ 2 >>value add-history ]
    [ 3 swap value<< ]
    [ value>> "Current value: %u\n" printf ]
    [ go-back ]
    [ go-back ]
    [ value>> "Restored value: %u\n" printf ]
} cleave


Needs["Calendar`"];DateFormat[x_]:=DateString[x,{"DayNameShort"," ","DayShort"," ","MonthName"}]
Map[StringJoin[ToString[#]," Easter: ",DateFormat[EasterSunday[#]],
", Ascension: ",DateFormat[DaysPlus[EasterSunday[#],39]],
", Pentecost: ",DateFormat[DaysPlus[EasterSunday[#],49]],
", Trinity: ",DateFormat[DaysPlus[EasterSunday[#],56]],
", Corpus: ",DateFormat[DaysPlus[EasterSunday[#],60]]]&
,Range[400,2100,100]~Join~Range[2010,2020]]

Output
{400 Easter: Sun 2 April, Ascension: Thu 11 May, Pentecost: Sun 21 May, Trinity: Sun 28 May, Corpus: Thu 1 June,
 500 Easter: Sun 4 April, Ascension: Thu 13 May, Pentecost: Sun 23 May, Trinity: Sun 30 May, Corpus: Thu 3 June,
 600 Easter: Sun 13 April, Ascension: Thu 22 May, Pentecost: Sun 1 June, Trinity: Sun 8 June, Corpus: Thu 12 June,
 700 Easter: Sun 15 April, Ascension: Thu 24 May, Pentecost: Sun 3 June, Trinity: Sun 10 June, Corpus: Thu 14 June,
 800 Easter: Sun 23 April, Ascension: Thu 1 June, Pentecost: Sun 11 June, Trinity: Sun 18 June, Corpus: Thu 22 June,
 900 Easter: Sun 28 March, Ascension: Thu 6 May, Pentecost: Sun 16 May, Trinity: Sun 23 May, Corpus: Thu 27 May,
1000 Easter: Sun 30 March, Ascension: Thu 8 May, Pentecost: Sun 18 May, Trinity: Sun 25 May, Corpus: Thu 29 May,
1100 Easter: Sun 8 April, Ascension: Thu 17 May, Pentecost: Sun 27 May, Trinity: Sun 3 June, Corpus: Thu 7 June,
1200 Easter: Sun 9 April, Ascension: Thu 18 May, Pentecost: Sun 28 May, Trinity: Sun 4 June, Corpus: Thu 8 June,
1300 Easter: Sun 18 April, Ascension: Thu 27 May, Pentecost: Sun 6 June, Trinity: Sun 13 June, Corpus: Thu 17 June,
1400 Easter: Sun 20 April, Ascension: Thu 29 May, Pentecost: Sun 8 June, Trinity: Sun 15 June, Corpus: Thu 19 June,
1500 Easter: Sun 1 April, Ascension: Thu 10 May, Pentecost: Sun 20 May, Trinity: Sun 27 May, Corpus: Thu 31 May,
1600 Easter: Sun 2 April, Ascension: Thu 11 May, Pentecost: Sun 21 May, Trinity: Sun 28 May, Corpus: Thu 1 June,
1700 Easter: Sun 11 April, Ascension: Thu 20 May, Pentecost: Sun 30 May, Trinity: Sun 6 June, Corpus: Thu 10 June,
1800 Easter: Sun 13 April, Ascension: Thu 22 May, Pentecost: Sun 1 June, Trinity: Sun 8 June, Corpus: Thu 12 June,
1900 Easter: Sun 15 April, Ascension: Thu 24 May, Pentecost: Sun 3 June, Trinity: Sun 10 June, Corpus: Thu 14 June,
2000 Easter: Sun 23 April, Ascension: Thu 1 June, Pentecost: Sun 11 June, Trinity: Sun 18 June, Corpus: Thu 22 June,
2100 Easter: Sun 28 March, Ascension: Thu 6 May, Pentecost: Sun 16 May, Trinity: Sun 23 May, Corpus: Thu 27 May,
2010 Easter: Sun 4 April, Ascension: Thu 13 May, Pentecost: Sun 23 May, Trinity: Sun 30 May, Corpus: Thu 3 June,
2011 Easter: Sun 24 April, Ascension: Thu 2 June, Pentecost: Sun 12 June, Trinity: Sun 19 June, Corpus: Thu 23 June,
2012 Easter: Sun 8 April, Ascension: Thu 17 May, Pentecost: Sun 27 May, Trinity: Sun 3 June, Corpus: Thu 7 June,
2013 Easter: Sun 31 March, Ascension: Thu 9 May, Pentecost: Sun 19 May, Trinity: Sun 26 May, Corpus: Thu 30 May,
2014 Easter: Sun 20 April, Ascension: Thu 29 May, Pentecost: Sun 8 June, Trinity: Sun 15 June, Corpus: Thu 19 June,
2015 Easter: Sun 5 April, Ascension: Thu 14 May, Pentecost: Sun 24 May, Trinity: Sun 31 May, Corpus: Thu 4 June,
2016 Easter: Sun 27 March, Ascension: Thu 5 May, Pentecost: Sun 15 May, Trinity: Sun 22 May, Corpus: Thu 26 May,
2017 Easter: Sun 16 April, Ascension: Thu 25 May, Pentecost: Sun 4 June, Trinity: Sun 11 June, Corpus: Thu 15 June,
2018 Easter: Sun 1 April, Ascension: Thu 10 May, Pentecost: Sun 20 May, Trinity: Sun 27 May, Corpus: Thu 31 May,
2019 Easter: Sun 21 April, Ascension: Thu 30 May, Pentecost: Sun 9 June, Trinity: Sun 16 June, Corpus: Thu 20 June,
2020 Easter: Sun 12 April, Ascension: Thu 21 May, Pentecost: Sun 31 May, Trinity: Sun 7 June, Corpus: Thu 11 June}


/* Easter sunday. Result is a list [month, day]

See:
Jean Meeus, "Astronomical Formulae for Calculators",
4th edition, Willmann-Bell, 1988, p.31 */

easter_sunday(year):=block([a,b,c,d,e,f,g,h,i,k,l,m,n,p],
a:remainder(year,19),[b,c]:divide(year,100),[d,e]:divide(b,4),
f:quotient(b+8,25),g:quotient(b-f+1,3),h:remainder(19*a+b-d-g+15,30),
[i,k]:divide(c,4),l:remainder(32+2*e+2*i-h-k,7),m:quotient(a+11*h+22*l,451),
[n,p]:divide(h+l-7*m+114,31),[n,p+1])$


: history create here cell+ , 0 , -1 , ;
: [email protected] @ @ ;
: h! swap here >r , dup @ , r> swap ! ;
: .history @ begin dup cell+ @ -1 <> while dup ? cell+ @ repeat drop ;
: h-- dup @ cell+ @ dup -1 = if abort" End of history" then swap ! ;


package main

import (
    "fmt"
    "sort"
    "sync"
    "time"
)

// data type for history variable (its an int)
type history struct {
    timestamp tsFunc
    hs        []hset
}

// data type for timestamp generator
type tsFunc func() time.Time

// data type for a "set" event
type hset struct {
    int           // new value
    t   time.Time // timestamp
}

// newHistory creates a history variable
func newHistory(ts tsFunc) history {
    return history{ts, []hset{{t: ts()}}}
}

// int returns the current value
func (h history) int() int {
    return h.hs[len(h.hs)-1].int
}

// set does what you expect and returns the timestamp recorded for the event
func (h *history) set(x int) time.Time {
    t := h.timestamp()
    h.hs = append(h.hs, hset{x, t})
    return t
}

// dump displays a complete history
func (h history) dump() {
    for _, hs := range h.hs {
        fmt.Println(hs.t.Format(time.StampNano), hs.int)
    }
}

// recall recalls the value stored in the history variable at time t.
// if the variable had not been created yet, ok is false.
func (h history) recall(t time.Time) (int, /*ok*/ bool) {
    i := sort.Search(len(h.hs), func(i int) bool {
        return h.hs[i].t.After(t)
    })
    if i > 0 {
        return h.hs[i-1].int, true
    }
    return 0, false
}

// newTimestamper returns a function that generates unique timestamps.
// Use a single timestamper for multiple history variables to preserve
// an unambiguous sequence of assignments across the multiple history
// variables within a single goroutine.
func newTimestamper() tsFunc {
    var last time.Time
    return func() time.Time {
        if t := time.Now(); t.After(last) {
            last = t
        } else {
            last.Add(1)
        }
        return last
    }
}

// newProtectedTimestamper generates unique timestamps for concurrent
// goroutines.
func newProtectedTimestamper() tsFunc {
    var last time.Time
    var m sync.Mutex
    return func() (t time.Time) {
        t = time.Now()
        m.Lock() // m protects last
        if t.After(last) {
            last = t
        } else {
            last.Add(1)
            t = last
        }
        m.Unlock()
        return
    }
}

func main() {
    // enable history variable support appropriate for single goroutine.
    ts := newTimestamper()
    // define a history variable
    h := newHistory(ts)
    // assign three values.  (timestamps kept for future reference.)
    ref := []time.Time{h.set(3), h.set(1), h.set(4)}
    // non-destructively display history
    fmt.Println("History of variable h:")
    h.dump()
    // recall the three values.  (this is non-destructive as well, but
    // different than the dump in that values are recalled by time.)
    fmt.Println("Recalling values:")
    for _, t := range ref {
        rv, _ := h.recall(t)
        fmt.Println(rv)
    }
}


import strformat, strutils, times

const HolidayOffsets = {"Easter": 0, "Ascension": 39, "Pentecost": 49,
                        "Trinity": 56, "C/Christi": 60}

proc easterDate(year: int): DateTime =
  let a = year mod 19
  let b = year div 100
  let c = year mod 100
  let d = b div 4
  let e = b mod 4
  let f = (b + 8) div 25
  let g = (b - f + 1) div 3
  let h = (19 * a + b - d - g + 15) mod 30
  let i = c div 4
  let k = c mod 4
  let l = (32 + 2 * e + 2 * i - h - k) mod 7
  let m = (a + 11 * h + 22 * l) div 451
  let n = h + l - 7 * m + 114
  let month = n div 31
  let day = n mod 31 + 1
  result = initDateTime(day, Month(month), year, 0, 0, 0)

proc outputHolidays(year: int) =
  let edate = easterDate(year)
  stdout.write &"{year:4d}  "
  for (holiday, offset) in HolidayOffsets:
    let date = edate + initDuration(days = offset)
    let s = date.format("dd MMM").center(holiday.len)
    stdout.write &"{s}  "
  echo ""

echo "Year  Easter  Ascension  Pentecost  Trinity  C/Christi"
echo " CE   Sunday  Thursday    Sunday    Sunday   Thursday "
echo "----  ------  --------- ----------  -------  ---------"
for year in countup(400, 2100, 100): outputHolidays(year)
echo ""
for year in 2010..2020: outputHolidays(year)


import Data.IORef

newtype HVar a = HVar (IORef [a])

newHVar :: a -> IO (HVar a)
newHVar value = fmap HVar (newIORef [value])

readHVar :: HVar a -> IO a
readHVar (HVar ref) = fmap head (readIORef ref)

writeHVar :: a -> HVar a -> IO ()
writeHVar value (HVar ref) = modifyIORef ref (value:)

undoHVar :: HVar a -> IO ()
undoHVar (HVar ref) = do
    (_ : history) <- readIORef ref
    writeIORef ref history

getHistory :: HVar a -> IO [a]
getHistory (HVar ref) = readIORef ref

-- Testing
main :: IO ()
main = do
    var <- newHVar 0
    writeHVar 1 var
    writeHVar 2 var
    writeHVar 3 var
    getHistory var >>= print
    undoHVar var
    undoHVar var
    undoHVar var


varref_hist_=:'VAR','_hist_',~]
set_hist_=:4 :0
  V=.varref x
  if.0>nc<V do.(<V)=:''end.
  (<V)=.V~,<y
  y
)
getall_hist_=:3 :0
  (varref y)~
)
length_hist_=: #@getall
get_hist_=: _1 {:: getall


import java.util.Collections;
import java.util.LinkedList;
import java.util.List;

/**
 * A class for an "Integer with a history".
 * <p>
 * Note that it is not possible to create an empty Variable (so there is no "null") with this type. This is a design
 * choice, because if "empty" variables were allowed, reading of empty variables must return a value. Null is a
 * bad idea, and Java 8's Optional<T> (which is somewhat like the the official fix for the null-bad-idea) would
 * make things more complicated than an example should be.
 */
public class IntegerWithHistory {

    /**
     * The "storage Backend" is a list of all values that have been ever assigned to this variable. The List is
     * populated front to back, so a new value is inserted at the start (position 0), and older values move toward the end.
     */
    private final List<Integer> history;

    /**
     * Creates this variable and assigns the initial value
     *
     * @param value initial value
     */
    public IntegerWithHistory(Integer value) {
        history = new LinkedList<>();
        history.add(value);
    }

    /**
     * Sets a new value, pushing the older ones back in the history
     *
     * @param value the new value to be assigned
     */
    public void set(Integer value) {
        //History is populated from the front to the back, so the freshest value is stored a position 0
        history.add(0, value);
    }

    /**
     * Gets the current value. Since history is populuated front to back, the current value is the first element
     * of the history.
     *
     * @return the current value
     */
    public Integer get() {
        return history.get(0);
    }

    /**
     * Gets the entire history all values that have been assigned to this variable.
     *
     * @return a List of all values, including the current one, ordered new to old
     */
    public List<Integer> getHistory() {
        return Collections.unmodifiableList(this.history);
    }

    /**
     * Rolls back the history one step, so the current value is removed from the history and replaced by it's predecessor.
     * This is a destructive operation! It is not possible to rollback() beyond the initial value!
     *
     * @return the value that had been the current value until history was rolled back.
     */
    public Integer rollback() {
        if (history.size() > 1) {
            return history.remove(0);
        } else {
            return history.get(0);
        }
    }
}


#!/usr/bin/perl

use strict; use warnings;
use Date::Calc qw(:all);

my @abbr = qw( Not Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );

my %c_hols = (
 	Easter=>     0,
 	Ascension=> 39,
 	Pentecost=> 49,
 	Trinity=>   56,
 	Corpus=>    60
);

sub easter {
	my $year=shift;

	my $ay=$year % 19;
	my $by=int($year / 100);
	my $cy=$year % 100;
	my $dy=int($by/4);
	my $ey=$by % 4;
	my $fy=int(($by+8)/25);
	my $gy=int(($by-$fy+1)/3);
	my $hy=($ay*19+$by-$dy-$gy+15) % 30;
	my $iy=int($cy/4);
	my $ky=$cy % 4;
	my $ly=(32+2*$ey+2*$iy-$hy-$ky) % 7;
	my $m_y=int(($ay+11*$hy+22*$ly)/451);

	my $month=int(($hy+$ly-7*$m_y+114)/31);
	my $day=(($hy+$ly-7*$m_y+114) % 31)+1;

	return ($month, $day, $year);
}

sub cholidays {
	my $year=shift;
	my ($emon, $eday)=easter($year);
	my @fields;
	printf("%4s: ", $year);

	foreach my $hol (sort { $c_hols{$a}<=>$c_hols{$b} } keys %c_hols) {
		my ($ye,$mo,$da)=Add_Delta_Days($year,$emon,$eday,$c_hols{$hol});
		my $month=$abbr[$mo];
		push @fields, sprintf("%s: %02s %s",$hol,$da,$month);
	}
	print join (", ",@fields);
	print "\n";
}

print 	"Christian holidays, related to Easter, for each centennial from ",
		"400 to 2100 CE:\n";
for (my $year=400; $year<=2100; $year+=100) {
	cholidays($year);
}

print	"Christian holidays, related to Easter, ",
		"for years from 2010 to 2020 CE:\n";

cholidays($_) for(2010..2020);


mutable struct Historied
    num::Number
    history::Vector{Number}
    Historied(n) = new(n, Vector{Number}())
end

assign(y::Historied, z) = (push!(y.history, y.num); y.num = z; y)

x = Historied(1)

assign(x, 3)
assign(x, 5)
assign(x, 4)

println("Past history of variable x: $(x.history). Current value is $(x.num)")


// version 1.1.4

class HistoryVariable<T>(initialValue: T) {
    private val history = mutableListOf<T>()

    var currentValue: T
        get() = history[history.size - 1]
        set(value) {
           history.add(value)
        }

    init {
        currentValue = initialValue
    }

    fun showHistory() {
        println("The variable's history, oldest values first, is:")
        for (item in history) println(item)
    }
}

fun main(args: Array<String>) {
    val v = HistoryVariable(1)
    v.currentValue = 2
    v.currentValue = 3
    v.showHistory()
    println("\nCurrentvalue is ${v.currentValue}")
}


-- History variables in Lua 6/12/2020 db
local HistoryVariable = {
  new = function(self)
    return setmetatable({history={}},self)
  end,
  get = function(self)
    return self.history[#self.history]
  end,
  set = function(self, value)
    self.history[#self.history+1] = value
  end,
  undo = function(self)
    self.history[#self.history] = nil
  end,
}
HistoryVariable.__index = HistoryVariable

local hv = HistoryVariable:new()
print("defined:", hv)
print("value is:", hv:get())
--
hv:set(1); print("set() to:", hv:get())
hv:set(2); print("set() to:", hv:get())
hv:set(3); print("set() to:", hv:get())
--
print("history:", table.concat(hv.history,","))
--
hv:undo(); print("undo() to:", hv:get())
hv:undo(); print("undo() to:", hv:get())
hv:undo(); print("undo() to:", hv:get())


-- demo\rosetta\Easter.exw
function easter(integer year)
-- from https://en.wikipedia.org/wiki/Computus#Anonymous_Gregorian_algorithm
    integer a = mod(year,19),
            b = floor(year/100),
            c = mod(year,100),
            d = floor(b/4),
            e = mod(b,4),
            f = floor((b+8)/25),
            g = floor((b-f+1)/3),
            h = mod(19*a+b-d-g+15,30),
            i = floor(c/4),
            k = mod(c,4),
            l = mod(32+2*e+2*i-h-k,7),
            m = floor((a+11*h+22*l)/451),
            n = h+l-7*m+114,
            month = floor(n/31),
            day = mod(n,31)+1
    return {year,month,day,0,0,0,0,0,0}
end function

constant dates = {{"Easter   ",0},
                  {"Ascension",39},
                  {"Pentecost",49},
                  {"Trinity  ",56},
                  {"Corpus   ",60}}

constant fmt = join(repeat(" %12s",length(dates))),
         fmt0 = "   "&fmt&"\n",
         fmtN = "%4d"&fmt&"\n"

include builtins\timedate.e

set_timedate_formats({"Ddd ddth Mmm"})

procedure show(integer year)
    if year=0 then
        printf(1,fmt0, columnize(dates,1)[1])
    else
        timedate e = easter(year)
        sequence args = {year}
        for i=1 to length(dates) do
            string d = format_timedate(adjust_timedate(e,timedelta(days:=dates[i][2])))
            args = append(args,d)
        end for
        printf(1,fmtN, args)
    end if
end procedure
show(0)
for year=400 to 2100 by 100 do
    show(year)
end for
show(0)
for year=2010 to 2020 do
    show(year)
end for


Flush ' empty curtrent stack
\\ a is a pointer to a new stack object
a=stack:=1,[email protected],3%
Print Len(A)=3
For i=1 to Len(a) {
      Print StackType$(a, i)="Number"
}
b=stack
Print len(b)=0
Push 1, 2 \\ to current stack
Stack b {
      \\ make b the current stack
      Data 1, 2, 3
}  ' Data add to bottom
\\ now current stack get the old object
Stack b {Push 1, 2, 3 } ' Push add to top, so 3 is at top
Stack b {
      While not empty {
            Read k  ' Read used to pop value to a variable
            \\ number pop value in an expression
            Print  k, number,  ' 3 2 1 1 2 3
      }
      Print
}
z=[]  ' [] pop all values from current stack to a new stack, and return a pointer
Print z  ' 2 1
z=Stack(a, z,a, z)  ' merge stack objects, to a new one, preserve a and z
Print Len(z)
\\ empty a using a new object
a=stack
b=stack:=1,2,3
\\ z has two stack objects
z=stack:= a, b
Stack b { data 1000}
b=stack ' b point to a new stack
\\ we get pointer back
b=stackitem(z, 2)
Print stackitem(b, 4)=1000


type HistoryVar[T] = object
  hist: seq[T]

ffunc initHistoryVar[T](value: T = T.default): HistoryVar[T] =
  ## Initialize a history variable with given value.
  result.hist.add value

func set(h: var HistoryVar; value: h.T) =
  ## Set the history variable to given value.
  h.hist.add value

func get(h: HistoryVar): h.T =
  ## Return the current value of history variable.
  h.hist[^1]

proc showHistory(h: HistoryVar) =
  ## Show the history starting from oldest values.
  for i, value in h.hist:
    echo i, ": ", value

func pop(h: var HistoryVar): h.T =
  ## Pop the current value and return it.
  if h.hist.len > 1: h.hist.pop() else: h.hist[0]

when isMainModule:

  var h = initHistoryVar[int]()   # Initialized to 0.

  echo "Assigning three values: 1, 2, 3"
  h.set(1)      # 0, 1
  h.set(2)      # 0, 1, 2
  h.set(3)      # 0, 1, 2, 3

  echo "History (oldest values first):"
  h.showHistory()

  echo "Current value is ", h.get()

  echo "Recall the three values:"
  echo h.pop()  # -> 3, last value removed.
  echo h.pop()  # -> 2, last value removed.
  echo h.pop()  # -> 1, last value removed.

  echo "History (note that initial value can never be removed):"
  h.showHistory()


MODULE HVar;
IMPORT Out, Conv;
TYPE
	(* Generic Object *)
	Object* = POINTER TO ObjectDesc;
	ObjectDesc = RECORD
		Show: PROCEDURE(o:Object);
		AsString: PROCEDURE(o: Object; VAR str: ARRAY OF CHAR);
	END;

	(* Integers *)
	Integer = POINTER TO IntegerDesc;
	IntegerDesc = RECORD (ObjectDesc)
		val: INTEGER;
	END;

	(* Chars *)
	Char = POINTER TO CharDesc;
	CharDesc = RECORD (ObjectDesc)
		val: CHAR;
	END;

	Node = POINTER TO NodeDesc;
	NodeDesc = RECORD
		val: Object;
		next: Node;
	END;

	(* History Variable *)
	HVar* = POINTER TO HVarDesc;
	HVarDesc = RECORD
		first, last: Node;
		size-: INTEGER;
	END;

	PROCEDURE CharAsString(o:Object; VAR dst: ARRAY OF CHAR);
	BEGIN
		IF LEN(dst) >= 2 THEN
			dst[1] := 0X;
		END;
		dst[0] := o(Char)^.val
	END CharAsString;

	PROCEDURE IntAsString(o:Object; VAR dst: ARRAY OF CHAR);
	BEGIN
		Conv.ConvInt(o(Integer)^.val,dst);
	END IntAsString;

	PROCEDURE ShowInt(o:Object);
	BEGIN
		Out.Int(o(Integer)^.val,10);
	END ShowInt;

	PROCEDURE ShowChar(o:Object);
	BEGIN
		Out.Char(o(Char)^.val);
	END ShowChar;

	PROCEDURE BoxChar(val: CHAR): Char;
	VAR
		c: Char;
	BEGIN
		NEW(c);
		c^.val := val;
		c^.Show := ShowChar;
		c^.AsString := CharAsString;
		RETURN c;
	END BoxChar;

	PROCEDURE BoxInt(val:INTEGER): Integer;
	VAR
		i: Integer;
	BEGIN
		NEW(i);
		i^.val := val;
		i^.Show := ShowInt;
		i^.AsString := IntAsString;
		RETURN i;
	END BoxInt;

	PROCEDURE InitNode(): Node;
	VAR
		l: Node;
	BEGIN
		NEW(l);
		l.val := NIL;
		l.next := NIL;
		RETURN l;
	END InitNode;

	PROCEDURE InitHVar(): HVar;
	VAR
		hv: HVar;
	BEGIN
		NEW(hv);
		hv.first := NIL;
		hv.last := NIL;
		hv.size := 0;
		RETURN hv;
	END InitHVar;

	PROCEDURE (v: HVar) Value(): Object;
	BEGIN
		RETURN v^.first^.val;
	END Value;

	PROCEDURE (v: HVar) Set(o: Object);
	VAR
		l: Node;
	BEGIN
		l := InitNode();
		l^.val := o;
		IF (v^.first = v^.last) & (v^.first = NIL) THEN
			v^.first := l;
			v^.last := l;
			INC(v^.size);
		ELSIF (v^.first = v^.last) & (v^.first # NIL) THEN
			v^.first^.next := l;
			v^.last := v^.first.next;
			INC(v^.size);
		ELSIF (v^.first # v^.last) THEN
			v^.last^.next := l;
			v^.last := l;
			INC(v^.size);
		END
	END Set;

	PROCEDURE (v: HVar) Undo(): Object;
	VAR
		o: Object;
	BEGIN
		IF (v^.first = v^.last) & (v^.first = NIL) THEN
			o := NIL;
		ELSIF (v^.first = v^.last) & (v^.first # NIL) THEN
			o := v^.first^.val;
			v^.first := NIL;
			v^.last := NIL;
			DEC(v^.size);
		ELSE
			o := v^.first^.val;
			v^.first := v^.first^.next;
			DEC(v^.size);
		END;
		RETURN o;
	END Undo;

	PROCEDURE (v: HVar) Print();
	VAR
		iter : Node;
	BEGIN
		iter := v.first;
		WHILE(iter # NIL) DO
			iter^.val^.Show(iter^.val);
			iter := iter^.next;
		END;
		Out.Ln;
	END Print;

	PROCEDURE ShowVal(val: Object);
	VAR
		s: ARRAY 128 OF CHAR;
	BEGIN
		val^.AsString(val,s);
		Out.String("> ");Out.String(s);Out.Ln;
	END ShowVal;
VAR
	history: HVar;

BEGIN
	history := InitHVar();
	history.Set(BoxChar(64X));
	history.Set(BoxInt(10));
	history.Set(BoxInt(15));
	history.Set(BoxInt(20));
	history.Print();
	ShowVal(history.Undo());
	ShowVal(history.Undo());
	ShowVal(history.Undo());
END HVar.


(load "@lib/cal.l")  # For 'easter' function

(de dayMon (Dat)
   (let D (date Dat)
      (list (day Dat *Day) " " (align 2 (caddr D)) " " (get *Mon (cadr D))) ) )

(for Y (append (range 400 2100 100) (range 2010 2020))
   (let E (easter Y)
      (prinl
         (align 4 Y)
         " Easter: " (dayMon E)
         ", Ascension: " (dayMon (+ E 39))
         ", Pentecost: " (dayMon (+ E 49))
         ", Trinity: " (dayMon (+ E 56))
         ", Corpus: " (dayMon (+ E 60)) ) ) )


(subscriptrange, size, fofl):
Easter: procedure options (main);
   declare months(12) character (9) varying static initial (
           'January', 'February', 'March',     'April',   'May',      'June',
           'July',    'August',   'September', 'October', 'November', 'December');
   declare (year, month, day) fixed binary;

   do year = 2000 to 2020;
      call Easter_Sunday (year, month, day);
      put skip edit ('In ', year, ' Easter occurs on ', day, ' of ', months(month))
         (a, f(4), a, f(2), a, a);
   end;

/* Given the year, this procedure computes the month and day when Easter Sunday falls. */
Easter_Sunday: procedure (year,month,day);
/*
  See:
  Jean Meeus, "Astronomical Formulae for Calculators",
  4th edition, Willmann-Bell, 1988, p.31
*/

   declare (year nonassignable, month, day) fixed binary;
   declare (a, b, c, d, e, f, g, h, i, j, k, l, m, n) fixed binary;

   a = mod(year, 19);
   b = year/100;
   c = mod(year, 100);
   d = b/4;
   e = mod(b,4);
   f = (b+8)/25;
   g = (b-f+1)/3;
   h = mod(19*a+b-d-g+15, 30);
   i = c/4;
   k = mod(c,4);
   l = mod(32+2*e+2*i-h-k, 7);
   m = (a+11*h+22*l)/451;
   n = h+l-7*m+114;
   month = n/31;
   day = mod(n, 31)+1;
end Easter_Sunday;

end Easter;


function Get-Easter
{
    [CmdletBinding()]
    [OutputType([PSCustomObject])]
    Param
    (
        [Parameter(Mandatory=$true,
                   ValueFromPipeline=$true,
                   ValueFromPipelineByPropertyName=$true,
                   Position=0)]
        [int]
        $Year
    )

    Begin
    {
        $holidayOffset = [ordered]@{
            Easter    = 0
            Ascension = 39
            Pentecost = 49
            Trinity   = 56
            Corpus    = 60
        }

        function Get-DateOfEaster ([int]$Year)
        {
            [int]$a = $Year % 19
            [int]$b = [Math]::Truncate($Year / 100)
            [int]$c = $Year % 100
            [int]$d = [Math]::Truncate($b / 4)
            [int]$e = $b % 4
            [int]$f = [Math]::Truncate(($b + 8) / 25)
            [int]$g = [Math]::Truncate(($b - $f + 1) / 3)
            [int]$h = ((19 * $a) + $b - $d - $g + 15) % 30
            [int]$i = [Math]::Truncate($c / 4)
            [int]$j = $c % 4
            [int]$k = (32 + 2 * ($e + $i) - $h - $j) % 7
            [int]$l = [Math]::Truncate(($a + (11 * $h) + (22 * $k)) / 451)
            [int]$m = [Math]::Truncate(($h + $k - (7 * $l) + 114) / 31)
            [int]$d = (($h + $k - (7 * $l) + 114) % 31) + 1

            Get-Date -Year $Year -Month $m -Day $d
        }

        function Get-Holiday ([int]$Year)
        {
            $easter = Get-DateOfEaster -Year $Year

            $holidays = foreach ($key in $holidayOffset.Keys)
            {
                $easter.AddDays($holidayOffset.$key)
            }

            [PSCustomObject]@{
                Year      = $Year
                Easter    = $holidays[0].ToString("ddd dd MMM")
                Ascension = $holidays[1].ToString("ddd dd MMM")
                Pentecost = $holidays[2].ToString("ddd dd MMM")
                Trinity   = $holidays[3].ToString("ddd dd MMM")
                Corpus    = $holidays[4].ToString("ddd dd MMM")
            }
        }
    }
    Process
    {
        foreach ($y in $Year)
        {
            Get-Holiday -Year $y
        }
    }
}


open Stack
(* The following line is only for convenience when typing code *)
module H = Stack

let show_entry e =
    Printf.printf "History entry: %5d\n" e

let () =
  let  hs = H.create() in
  H.push 111 hs ;
  H.push 4 hs ;
  H.push 42 hs ;
  H.iter show_entry hs;
  hs |> H.pop |> Printf.printf "%d\n";
  hs |> H.pop |> Printf.printf "%d\n";
  hs |> H.pop |> Printf.printf "%d\n"


'============
class History
'============

indexbase 0

string buf
sys    ii,ld,pb

method constructor(sys n=1000, l=sizeof sys) {buf=nuls n*l : pb=strptr buf : ld=l : ii=0}
method destructor () {clear}
'
method setup(sys n=1000, l=sizeof sys) {buf=nuls n*l : pb=strptr buf : ld=l : ii=0}
method clear()                {buf="" : pb=0 : ld=0 : ii=0}
method max  (sys i)           {if i>ii{ii=i}}
method count() as sys         {return ii}
method size () as sys         {return ld}
'
method get  (any*p,i)         {copy @p, pb+i*ld,ld }           'out
method add  (any*p)           {copy pb+ii*ld,@p,ld : ii++}     'in
method put  (any*p,sys i)     {copy pb+i*ld,@p,ld : max i}     'in
'
end class

'====
'TEST
'====

'this works for fixed length types

'it will not work for types containing
'volatile pointers. eg: string members

type vector double x,y,z

vector v

new History hv(1000,sizeof v) 'give number of records and variable size

sys i
for i=0 to 9
  v<=i,i*10,i*100 'assign new values to vector
  hv.add v      'add to history
next

string tab=chr(9) : cr=chr(13)+chr(10)
string pr="Data History of v" cr cr
pr+="n" tab "x" tab "y" tab "z" cr
vector sv
'
for i=hv.count()-1 to 0 step -1
  hv.get sv,i
  pr+=i tab sv.x tab sv.y tab sv.z cr
next

print pr 'result '9,90,900 : 8,80,800 ...

del hv


default(histsize, 1000) \\ or some other positive number to suit
1+7
sin(Pi)
2^100
\a1 \\ display history item #1, etc.
% \\ alternate syntax
%1 \\ alternate syntax
\a2
\a3
[%1, %2, %3] \\ or any other command using these values


Turn history on <@ DEFHST>__on</@>
Notify Protium we are interested in the variable mv
<@ DEFHST>mv</@>
Assign a value: <@ LETVARLIT>mv|first value</@><@ SAYVAR>mv</@>
Reassign the value: <@ LETVARLIT>mv|second value</@><@ SAYVAR>mv</@>
Reassign the value: <@ LETVARLIT>mv|third value</@><@ SAYVAR>mv</@>
Dump history <@ SAYDMPHSTVAR>mv</@>
Current value: <@ SAYVAR>mv</@>
Undo once: <@ ACTUNDVAR>mv</@><@ SAYVAR>mv</@>
Undo twice: <@ ACTUNDVAR>mv</@><@ SAYVAR>mv</@>
Turn history off <@ DEFHST>__off</@>


package History;

sub TIESCALAR {
	my $cls = shift;
	my $cur_val = shift;
	return bless [];
}

sub FETCH {
	return shift->[-1]
}

sub STORE {
	my ($var, $val) = @_;
	push @$var, $val;
	return $val;
}

sub get(\$) { @{tied ${+shift}} }
sub on(\$) { tie ${+shift}, __PACKAGE__ }
sub off(\$) { untie ${+shift} }
sub undo(\$) { pop @{tied ${+shift}} }

package main;

my $x = 0;
History::on($x);

for ("a" .. "d") { $x = $_ }

print "History: @{[History::get($x)]}\n";

for (1 .. 3) {
	print "undo $_, ";
	History::undo($x);
	print "current value: $x\n";
}

History::off($x);
print "\$x is: $x\n";


DataSection
  C_DAYS:
  Data.i 0,39,49,56,60
  END_C_DAYS:
  DAYS_MT:
  Data.i 0,31,28,31,30,31,30,31,31,30,31,30,31
  END_DAYS_MT:
EndDataSection

Dim m.s{3}(12)  : PokeS(@m(),"___JanFebMarAprMayJunJulAugSepOctNovDec")
Dim dom.i(12)   : CopyMemory(?DAYS_MT,@dom(),?END_DAYS_MT-?DAYS_MT)
Structure tDate : yyyy.i : mm.i : dd.i : EndStructure
Define.tDate DateTime, BufDateTime

Procedure.b IsLeap(y.i)
  ProcedureReturn Bool( y % 4 = 0 ) & Bool( y % 100 <> 0 ) | Bool( y % 400 = 0 )
EndProcedure

Procedure.i DayOfMt(mm.i,yyyy.i)
  Shared dom()
  If mm=2 And IsLeap(yyyy) : ProcedureReturn 29 : Else : ProcedureReturn dom(mm) : EndIf
EndProcedure

Procedure delta(*pDate.tDate,AddDays.i)
  *pDate\dd+AddDays
  dom.i=DayOfMt(*pDate\mm,*pDate\yyyy)
  While *pDate\dd-dom>0
    *pDate\mm+1
    If *pDate\mm>12 : *pDate\mm=1 : *pDate\yyyy+1 : EndIf
    *pDate\dd-dom
    dom=DayOfMt(*pDate\mm,*pDate\yyyy)
  Wend
EndProcedure

Procedure dt(y.i)
  a.i=y%19
  b.i=y/100
  c.i=y%100
  d.i=b/4
  e.i=b%4
  f.i=(b+8)/25
  g.i=(b-f+1)/3
  h.i=(19*a+b-d-g+15)%30
  i.i=c/4
  k.i=c%4
  l.i=(32+2*e+2*i-h-k)%7
  m.i=(a+11*h+22*l)/451
  num.i=h+l-7*m+114
  mt.i=num/31
  dy.i=(num%31)+1
  Shared DateTime
  DateTime\yyyy=y
  DateTime\mm=mt
  DateTime\dd=dy
EndProcedure

Macro PutTab(i)
  dt(i) : BufDateTime=DateTime : r$=RSet(Str(DateTime\yyyy),4)
  *p_C_Days=?C_DAYS
  While *p_C_Days<?END_C_DAYS
    delta(@DateTime,PeekI(*p_C_Days))
    r$+Space(5)+RSet(Str(DateTime\dd),2,"0")+" "+m(DateTime\mm)
    DateTime=BufDateTime
    *p_C_Days+SizeOf(Integer)
  Wend
EndMacro

OpenConsole()
PrintN("Year"+Space(5)+"Easter  Ascension  Pentecost    Trinity  C/Christi")
PrintN(" CE "+Space(5)+"Sunday  Thursday    Sunday      Sunday   Thursday")
PrintN("----"+Space(5)+"------  --------- ----------    -------  ---------")
For i=400 To 2100 Step 100 : PutTab(i) : PrintN(r$) : Next
PrintN("")
For i=2010 To 2020 : PutTab(i) : PrintN(r$) : Next
Input()


without js -- (desktop/Phix only)
sequence history = {}

type hvt(object o)
    history = append(history,o)
    return true
end type

hvt test = 1
test = 2
test = 3
?{"current",test}
?{"history",history}


(de setH ("Var" Val)
   (when (val "Var")
      (with "Var"
         (=: history (cons @ (: history))) ) )
   (set "Var" Val) )

(de restoreH ("Var")
   (set "Var" (pop (prop "Var" 'history))) )


declare t float controlled;

do i = 1 to 5; /* a loop to read in and save five values. */
allocate t; get (t);
end;

do while (allocation(t) > 0); /* a loop to retrieve the values. */
put (t); free t;
end;


; integer history variable

Structure historyint
    List value.i()
EndStructure

Procedure SetInt (*var.historyint, val.i)
    AddElement(*var\value())

    If (ListSize(*var\value()) = 1)
        *var\value() = 0
        AddElement(*var\value())

    EndIf

    *var\value() = val
EndProcedure

Procedure ShowHistory (*var.historyint)
    ForEach *var\value()
        Debug *var\value()
    Next
EndProcedure

Procedure UndoInt (*var.historyint)
    If (ListSize(*var\value()) = 1)
        ProcedureReturn
    EndIf

    DeleteElement(*var\value())
EndProcedure

;----------------------------------------------

Define x.historyint

For i = 0 To 3
    setint(x, Random(50)+100 )
Next

Debug "x history:"
ShowHistory(x)

Debug ""

For i = 0 To 3
    UndoInt(x)
    Debug "undo, x = "+Str(x\value())
Next


from dateutil.easter import *
import datetime, calendar

class Holiday(object):
    def __init__(self, date, offset=0):
        self.holiday = date + datetime.timedelta(days=offset)

    def __str__(self):
        dayofweek = calendar.day_name[self.holiday.weekday()][0:3]
        month = calendar.month_name[self.holiday.month][0:3]
        return '{0} {1:2d} {2}'.format(dayofweek, self.holiday.day, month)

def get_holiday_values(year):
    holidays = {'year': year}
    easterDate = easter(year)
    holidays['easter'] = Holiday(easterDate)
    holidays['ascension'] = Holiday(easterDate, 39)
    holidays['pentecost'] = Holiday(easterDate, 49)
    holidays['trinity'] = Holiday(easterDate, 56)
    holidays['corpus'] = Holiday(easterDate, 60)
    return holidays

def print_holidays(holidays):
    print '{year:4d} Easter: {easter}, Ascension: {ascension}, Pentecost: {pentecost}, Trinity: {trinity}, Corpus: {corpus}'.format(**holidays)

if __name__ == "__main__":
    print "Christian holidays, related to Easter, for each centennial from 400 to 2100 CE:"
    for year in range(400, 2200, 100):
        print_holidays(get_holiday_values(year))

    print ''
    print "Christian holidays, related to Easter, for years from 2010 to 2020 CE:"
    for year in range(2010, 2021):
        print_holidays(get_holiday_values(year))


import sys

HIST = {}

def trace(frame, event, arg):
    for name,val in frame.f_locals.items():
        if name not in HIST:
            HIST[name] = []
        else:
            if HIST[name][-1] is val:
                continue
        HIST[name].append(val)
    return trace

def undo(name):
    HIST[name].pop(-1)
    return HIST[name][-1]

def main():
    a = 10
    a = 20

    for i in range(5):
        c = i

    print "c:", c, "-> undo x3 ->",
    c = undo('c')
    c = undo('c')
    c = undo('c')
    print c
    print 'HIST:', HIST

sys.settrace(trace)
main()


/O> [ stack ] is x
... 3 x put
... 4 x put
... 5 x put
... x behead drop echo cr
... x take echo cr
... x take echo cr
... x take echo cr
...
[ 3 4 5 ]
5
4
3


#lang racket

(require rackunit)

(struct hvar (current history) #:mutable)

(define (make-hvar v) (hvar v empty))

(define (hvar-set! hv new)
  (match-define (hvar cur hist) hv)
  (set-hvar-history! hv (cons cur hist))
  (set-hvar-current! hv new))

(define (hvar-undo! hv)
  (match-define (hvar cur (cons old hist)) hv)
  (set-hvar-current! hv old)
  (set-hvar-history! hv hist))

;; unit tests
(define hv (make-hvar 0))
(hvar-set! hv 1)
(check-equal? (hvar-current hv) 1)
(hvar-set! hv 2)
(hvar-set! hv 3)
(check-equal? (hvar-history hv) '(2 1 0))
(hvar-undo! hv)
(hvar-undo! hv)
(hvar-undo! hv)
(check-equal? (hvar-current hv) 0)


class HistoryVar {
    has @.history;
    has $!var handles <Str gist FETCH Numeric>;
    method STORE($val) is rw {
        push @.history, [now, $!var];
        $!var = $val;
    }
}

my \foo = HistoryVar.new;

foo = 1;
foo = 2;
foo += 3;
foo = 42;

.say for foo.history;
say "Current value: {foo}";


library(tidyverse)
library(lubridate)
# Make a pretty date function:
pretty_date = stamp_date("Thu, Jun 1, 2000")

# Gregorian calendar:
tibble(year = c(seq(400, 2100, 100), 2010:2020)) %>%
  arrange(year) %>%
  mutate(a = year %% 19,
         b = year %% 4,
         c = year %% 7,
         k = year %/% 100,
         p = (13 + 8 * k) %/% 25,
         q = k %/% 4,
         M = (15 - p + k - q) %% 30,
         N = (4 + k - q) %% 7,
         d = (19 * a + M) %% 30,
         e = (2 * b + 4 * c + 6 * d + N) %% 7,
         easter_mar = 22 + d + e,
         easter_apr = d + e - 9,
         easter_day = if_else(easter_mar <= 31, easter_mar, easter_apr),
         easter_day = case_when(
           d == 29 & e == 6 ~ 19,
           d == 28 & e == 6 & (11 * M + 11) %% 30 < 19 ~ 18,
           TRUE ~ easter_day),
         easter_day = sprintf("%02d", easter_day),
         easter_year = sprintf("%04d", year),
         easter_mon = if_else(easter_mar <= 31, "03", "04")) %>%
  unite("easter", easter_year, easter_mon, easter_day, sep = "-") %>%
  mutate(Easter = parse_date(easter, format = "%Y-%m-%e")) %>%
  select(Easter) %>%
  mutate(Ascension = Easter + 39,
         Pentecost = Ascension + 10,
         Trinity = Pentecost + 7,
         `Corpus Christi` = Trinity + 4,
         across(.fns = pretty_date))


my @abbr = < Nil Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec >;

my @holidays =
    Easter    => 0,
    Ascension => 39,
    Pentecost => 49,
    Trinity   => 56,
    Corpus    => 60;

sub easter($year) {
    my \ay = $year % 19;
    my \by = $year div 100;
    my \cy = $year % 100;
    my \dy = by div 4;
    my \ey = by % 4;
    my \fy = (by + 8) div 25;
    my \gy = (by - fy + 1) div 3;
    my \hy = (ay * 19 + by - dy - gy + 15) % 30;
    my \iy = cy div 4;
    my \ky = cy % 4;
    my \ly = (32 + 2 * ey + 2 * iy - hy - ky) % 7;
    my \md = hy + ly - 7 * ((ay + 11 * hy + 22 * ly) div 451) + 114;
    my \month = md div 31;
    my \day = md % 31 + 1;

    return month, day;
}

sub cholidays($year) {
    my ($emon, $eday) = easter($year);
    printf "%4s: ", $year;
    say join ', ', gather for @holidays -> $holiday {
	my $d = Date.new($year,$emon,$eday) + $holiday.value;
	take "{$holiday.key}: $d.day-of-month.fmt('%02s') @abbr[$d.month]";
    }
}

for flat (400,500 ... 2000), (2010 ... 2020), 2100 -> $year {
    cholidays($year);
}


/*REXX program demonstrates a method to track history of assignments to a REXX variable.*/
varSet!.=0                                       /*initialize the all of the VARSET!'s. */
call varSet 'fluid',min(0,-5/2,-1)     ;    say 'fluid=' fluid
call varSet 'fluid',3.14159            ;    say 'fluid=' fluid
call varSet 'fluid',' Santa  Claus'    ;    say 'fluid=' fluid
call varSet 'fluid',,999
say 'There were' result "assignments (sets) for the FLUID variable."
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
varSet: arg ?x;  parse arg ?z, ?v, ?L            /*obtain varName, value, optional─List.*/
if ?L=='' then do                                /*not la ist,  so set the  X  variable.*/
               ?_=varSet!.0.?x+1                 /*bump the history count  (# of SETs). */
               varSet!.0.?x=?_                   /*   ... and store it in the "database"*/
               varSet!.?_.?x=?v                  /*   ... and store the  SET  value.    */
               call value(?x),?v                 /*now,  set the real  X  variable.     */
               return ?v                         /*also, return the value for function. */
               end
say                                              /*show a blank line for readability.   */
            do ?j=1 to ?L while ?j<=varSet!.0.?x /*display the list of  "set"  history. */
            say 'history entry' ?j "for var" ?z":" varSet!.?J.?x
            end   /*?j*/
return ?j-1                                      /*return the number of assignments.    */


foo_hist = []
trace_var(:$foo){|v| foo_hist.unshift(v)}

$foo = "apple"
$foo = "pear"
$foo = "banana"

p foo_hist # => ["banana", "pear", "apple"]


#[derive(Clone, Debug)]
struct HVar<T> {
    history: Vec<T>,
    current: T,
}

impl<T> HVar<T> {
    fn new(val: T) -> Self {
        HVar {
            history: Vec::new(),
            current: val,
        }
    }

    fn get(&self) -> &T {
        &self.current
    }

    fn set(&mut self, val: T) {
        self.history.push(std::mem::replace(&mut self.current, val));
    }

    fn history(&self) -> (&[T], &T) {
        (&self.history, &self.current)
    }

    fn revert(&mut self) -> Option<T> {
        self.history
            .pop()
            .map(|val| std::mem::replace(&mut self.current, val))
    }
}

fn main() {
    let mut var = HVar::new(0);
    var.set(1);
    var.set(2);
    println!("{:?}", var.history());
    println!("{:?}", var.revert());
    println!("{:?}", var.revert());
    println!("{:?}", var.revert());
    println!("{:?}", var.get());
}


class HVar[A](initialValue: A) extends Proxy {
  override def self = !this
  override def toString = "HVar(" + !this + ")"

  def history = _history

  private var _history = List(initialValue)
  def unary_! = _history.head
  def :=(newValue: A): Unit = {
    _history = newValue :: _history
  }
  def modify(f: A => A): Unit = {
    _history = f(!this) :: _history
  }
  def undo: A = {
    val v = !this
    _history = _history.tail
    v
  }
}


// HistoryVariable.script
properties
	history: [], -- a list of all historical values
	asTextFormat:"[[the last item of my history]]" -- always display the last value
end properties

to set newValue
	push newValue nested into my history
end set

to rollback
	pop my history
	return it
end rollback


class HistoryVar(v) {

    has history = []
    has variable = v

    method ≔(value) {
        history << variable
        variable = value
    }

    method to_s {
        "#{variable}"
    }

    method AUTOLOAD(_, name, *args) {
        variable.(name)(args...)
    }
}

var foo = HistoryVar(0)

foo ≔ 1
foo ≔ 2
foo ≔ foo+3
foo ≔ 42

say "History: #{foo.history}"
say "Current value: #{foo}"


Object subclass:'HVar'
    instanceVariableNames:'values'
    classVariableNames:''
    poolDictionaries:''
    category:'example'.
!

!HVar methodsFor:'accessing'!

<-- value
    (values ifNil:[values := OrderedCollection new]) add:value.
    ^  value
!

value
    ^ values last
!

undo
    values removeLast.
!

history
    ^ history
! !

|x|

x := HVar new.
x <-- 1.
x value.
x <-- 2.
x <-- (x value + 1).
x value.
x history.


var historyOfHistory = [Int]()
var history:Int = 0 {
    willSet {
        historyOfHistory.append(history)
    }
}

history = 2
history = 3
history = 4
println(historyOfHistory)


# Define the history machinery
proc histvar {varName operation} {
    upvar 1 $varName v ___history($varName) history
    switch -- $operation {
	start {
	    set history {}
	    if {[info exist v]} {
		lappend history $v
	    }
	    trace add variable v write [list histvar.write $varName]
	    trace add variable v read [list histvar.read $varName]
	}
	list {
	    return $history
	}
	undo {
	    set history [lrange $history 0 end-1]
	}
	stop {
	    unset history
	    trace remove variable v write [list histvar.write $varName]
	    trace remove variable v read [list histvar.read $varName]
	}
    }
}
proc histvar.write {key varName args} {
    upvar 1 $varName v ___history($key) history
    lappend history $v
}
proc histvar.read {key varName args} {
    upvar 1 $varName v ___history($key) history
    set v [lindex $history end]
}


/* REXX **********************************************************************************
* Test frame for computing Christian (Roman Catholic) holidays, related to Easter
* 16.04.2013 Walter Pachl
* 08.03.2021 -"- extended range of years and indicate Roman Catholic use
*****************************************************************************************/
oid='ee.txt'; 'erase' oid

month.3='Mar'; days.3=31
month.4='Apr'; days.4=30
month.5='May'; days.5=31
month.6='Jun'; days.6=30
Call o 'Christian holidays, related to Easter, for each centennial',
                                                'from 400 to 2200 CE:'
Do y=400 To 2200 By 100
  Call line y
  End
Call o ' '
Call o 'Christian holidays, related to Easter, for years',
                                                'from 2010 to 2030 CE:'
Do y=2010 To 2030
  Call line y
  End
Exit

line: Parse Arg y
Parse Value easter(y) With y m d
Parse Value add(d,m,39) With ad am
Parse Value add(ad,am,10) With pd pm
Parse Value add(pd,pm,7) With td tm
Parse Value add(td,tm,4) With cd cm
ol=right(y,4) 'Easter:' right(d,2) month.m
ol=ol'  Ascension:' right(ad,2) month.am ' Pentecost:' right(pd,2) month.pm
ol=ol'  Trinity:' right(td,2) month.tm'  Corpus:' right(cd,2) month.cm
Call o ol
Return

o: Return lineout(oid,arg(1))

add: Procedure Expose days.
Parse Arg d,m,dd
res=d+dd
Do While res>days.m
  res=res-days.m
  m=m+1
  End
Return res m

easter: Procedure
/***********************************************************
* translated from FORTRAN (mod -> //; / -> %)
* Input  year
* Output year month day of Easter Sunday
* 16.04.2013 Walter Pachl
c See:
c Jean Meeus, "Astronomical Formulae for Calculators",
c 4th edition, Willmann-Bell, 1988, p.31
*********************************************************/
Parse Arg year
a=year//19
b=year%100
c=year//100
d=b%4
e=b//4
f=(b+8)%25
g=(b-f+1)%3
h=(19*a+b-d-g+15)//30
i=c%4
k=c//4
l=(32+2*e+2*i-h-k)//7
m=(a+11*h+22*l)%451
n=h+l-7*m+114
month=n%31
day=n//31+1
Return year month day


class HistoryVariable {
    construct new(initValue) {
        _history = [initValue]
    }

    currentValue { _history[-1] }
    currentValue=(newValue) { _history.add(newValue) }

    showHistory() {
        System.print("The variable's history, oldest values first, is:")
        for (item in _history) System.print(item)
    }
}

var v = HistoryVariable.new(1)
v.currentValue = 2
v.currentValue = 3
v.showHistory()
System.print("\nCurrent value is %(v.currentValue)")


class HistoryVar{
   var [private] _v, _history=List(), maxSz;
   fcn init(v,maxEntries=3){ maxSz=maxEntries; set(v) }
   fcn set(v){
      _v=v; _history.append(T(Time.Clock.time,v));
      if(_history.len()>maxSz) _history.del(0);
      self
   }
   fcn get(n=0){  // look back into history
      z:=_history.len();
      n=(if(n>=z) 0 else z-n-1);
      _history[n][1]
   }
   var [proxy] v=fcn{ _v };
   var [proxy] history=
      fcn{ _history.pump(List,fcn([(t,v)]){ T(Time.Date.ctime(t),v) }) };
   fcn __opAdd(x){ set(_v + x); self }
}


require 'date'

def easter_date(year)
  # Anonymous Gregorian algorithm
  # http://en.wikipedia.org/wiki/Computus#Algorithms

  a    = year % 19
  b, c = year.divmod(100)
  d, e = b.divmod(4)
  f    = (b + 8) / 25
  g    = (b - f + 1) / 3
  h    = (19*a + b - d - g + 15) % 30
  i, k = c.divmod(4)
  l    = (32 + 2*e + 2*i - h - k) % 7
  m    = (a + 11*h + 22*l) / 451
  numerator = h + l - 7*m + 114
  month = numerator / 31
  day = (numerator % 31) + 1
  Date.new(year, month, day)
end

OFFSETS = [
  [:easter,     0],
  [:ascension, 39],
  [:pentecost, 49],
  [:trinity,   56],
  [:corpus,    60],
]

def emit_dates(year)
  e = easter_date year
  dates = OFFSETS.collect {|item, offset| (e + offset).strftime("  %e %b")}
  puts "%4s: %s" % [year, dates.join(',  ')]
end

puts "year:" + OFFSETS.collect{|item, offset| "%9s" % item}.join(', ')
400.step(2100, 100).each {|year| emit_dates year}
puts
(2010 .. 2020).each {|year| emit_dates year}


use std::ops::Add;

use chrono::{prelude::*, Duration};

#[allow(clippy::cast_possible_truncation)]
#[allow(clippy::cast_sign_loss)]
#[allow(clippy::cast_possible_wrap)]
fn get_easter_day(year: u32) -> chrono::NaiveDate {
    let k = (f64::from(year) / 100.).floor();
    let d = (19 * (year % 19)
        + ((15 - ((13. + 8. * k) / 25.).floor() as u32 + k as u32 - (k / 4.).floor() as u32) % 30))
        % 30;
    let e =
        (2 * (year % 4) + 4 * (year % 7) + 6 * d + ((4 + k as u32 - (k / 4.).floor() as u32) % 7))
            % 7;

    let (month, day) = match d {
        29 if e == 6 => (4, 19),
        28 if e == 6 => (4, 18),
        _ if d + e < 10 => (3, 22 + d + e),
        _ => (4, d + e - 9),
    };

    NaiveDate::from_ymd(year as i32, month, day)
}
fn main() {
    let holidays = vec![
        ("Easter", Duration::days(0)),
        ("Ascension", Duration::days(39)),
        ("Pentecost", Duration::days(49)),
        ("Trinity", Duration::days(56)),
        ("Corpus Christi", Duration::days(60)),
    ];
    for year in (400..=2100).step_by(100).chain(2010..=2020) {
        print!("{}: ", year);
        for (name, offset) in &holidays {
            print!(
                "{}: {}, ",
                name,
                get_easter_day(year).add(*offset).format("%a %d %h")
            );
        }
        println!();
    }
}


import java.util._
import scala.swing._

def easter(year: Int) = {
  // Start at March 21.
  val cal = new GregorianCalendar(year, 2, 21);

  /*
   * Calculate e = day of Easter, following the 1886 paper,
   * Kalender-Formeln (Calendar Formulae) by Chr. Zeller.
   *   http://www.merlyn.demon.co.uk/zel-1886.htm
   *
   * With Scala, p % 7 gives the wrong result when p < 0. To give the
   * correct result, this code uses "+ 6 * j" where one might have used
   * "- j". This works because because 6 == -1 (mod 7).
   */
  var b = 0
  var d = 0
  if (cal.getTime().before(cal.getGregorianChange())) {
    // Julian calendar
    b = (19 * (year % 19) + 15) % 30
    d = (b + year + year / 4) % 7
  } else {
    // Gregorian calendar
    val j = year / 100
    val a = year % 19
    b = (19 * a + 15 + j - (8 * j + 13) / 25 - j / 4) % 30
    d = (b + year + year / 4 + 6 * j + j / 4 + 2) % 7
    if (d == 0 && (b == 29 || (b == 28 && a > 10))) d = 7
  }
  val e = b + 7 - d  // This counts days after 21 March.

  val df = new java.text.SimpleDateFormat("EEE dd MMM");
  def advance(days: Int) = {
    cal.add(Calendar.DAY_OF_MONTH, days)
    df.format(cal.getTime())
  }

  val ary = new Array[Any](6)
  ary(0) = year
  ary(1) = advance(e)   // Easter
  ary(2) = advance(39)  // Ascension Thursday
  ary(3) = advance(10)  // Pentecost
  ary(4) = advance(7)   // Trinity Sunday
  ary(5) = advance(4)   // Corpus Christi
  ary
}

val columns = Array("AD", "Easter", "Ascension Thursday", "Pentecost",
  "Trinity Sunday", "Corpus Christi")
val rows = (400.to(2000, 100) ++ 2010.to(2020) ++ Array(2100))
  .map(easter(_)).toArray

new MainFrame {
  title = "Holidays related to Easter"
  contents = new ScrollPane {
    contents = new Table(rows, columns)
  }
  size = new java.awt.Dimension(600, 400)
  visible = true
}


; Easter sunday. Result is a list '(month day)
;
; See:
; Jean Meeus, "Astronomical Formulae for Calculators",
; 4th edition, Willmann-Bell, 1988, p.31

(define (easter year)
        (let* ((a (remainder year 19))
               (b (quotient year 100))
               (c (remainder year 100))
               (d (quotient b 4))
               (e (remainder b 4))
               (f (quotient (+ b 8) 25))
               (g (quotient (+ 1 (- b f)) 3))
               (h (remainder (+ (* 19 a) (- b d g) 15) 30))
               (i (quotient c 4))
               (k (remainder c 4))
               (l (remainder (+ e e i i (- 32 h k)) 7))
               (m (quotient (+ a (* 11 h) (* 22 l)) 451))
               (n (+ h l (- 114 (* 7 m)))))
              (list (quotient n 31) (+ 1 (remainder n 31)))))


$ include "seed7_05.s7i";
  include "time.s7i";
  include "duration.s7i";

const func time: easterDate (in integer: year) is func
  result
    var time: result is time.value;
  local
    var integer: H1 is 0;
    var integer: H2 is 0;
    var integer: M is 0;
    var integer: N is 0;
    var integer: a is 0;
    var integer: b is 0;
    var integer: c is 0;
    var integer: d is 0;
    var integer: e is 0;
    var integer: f is 0;
  begin
    H1 := year mdiv 100;
    H2 := year mdiv 400;
     M := 15 + H1 - H2 - (8 * H1 + 13) mdiv 25;
     N := 4 + H1 - H2;

    # Gauss formula:
     a := year mod 19;
     b := year mod 4;
     c := year mod 7;
     d := (19 * a + M) mod 30;
     e := (2 * b + 4 * c + 6 * d + N) mod 7;
     f := 22 + d + e;

    if f = 57 then
      f := 50;
    end if;
    if d = 28 and e = 6 and a > 10 then
      f := 49;
    end if;

    result.year := year;
    if f <= 31 then
      result.month := 3;
    else
      result.month := 4;
      f -:= 31;
    end if;
    result.day := f;
  end func;

const array string: weekday is [] ("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun");
const array string: month is [] ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
const array string: holiday is [] ("Easter", "Ascension", "Pentecost", "Trinity", "Corpus");
const array integer: delta is [] (0, 39, 49, 56, 60);

const func string: usDate (in time: aTime) is
  return weekday[dayOfWeek(aTime)] <& aTime.day lpad 3 <& " " <& month[aTime.month];

const func string: holiday (in integer: index, in time: easter) is
  return holiday[index] <& ": " <& usDate(easter + delta[index] . DAYS);

const proc: writeHolidays (in integer: year) is func
  local
	var time: easter is time.value;
  begin
    easter := easterDate(year);
    writeln(year lpad 4 <& " " <&
        holiday(1, easter) <& ", " <&
        holiday(2, easter) <& ", " <&
        holiday(3, easter) <& ", " <&
        holiday(4, easter) <& ", " <&
        holiday(5, easter));
  end func;

const proc: main is func
  local
    var integer: year is 0;
  begin
    writeln("Christian holidays, related to Easter, for each centennial from 400 to 2100 CE:");
    for year range 400 to 2100 step 100 do
	  writeHolidays(year);
    end for;
    writeln;
	writeln("Christian holidays, related to Easter, for years from 2010 to 2020 CE:");
    for year range 2010 to 2020 do
	  writeHolidays(year);
    end for;
  end func;


require('Date::Calc')

var abbr = < Nil Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec >

var holidays = [
    [Easter    => 0],
    [Ascension => 39],
    [Pentecost => 49],
    [Trinity   => 56],
    [Corpus    => 60],
]

func easter(year) {
    var ay = (year % 19)
    var by = (year // 100)
    var cy = (year % 100)
    var dy = (by // 4)
    var ey = (by % 4)
    var fy = ((by + 8) // 25)
    var gy = ((by - fy + 1) // 3)
    var hy = ((19*ay + by - dy - gy + 15) % 30)
    var iy = (cy // 4)
    var ky = (cy % 4)
    var ly = ((32 + 2*ey + 2*iy - hy - ky) % 7)
    var md = (hy + ly - 7*((ay + 11*hy + 22*ly) // 451) + 114)
    var month = (md // 31)
    var day = (md % 31 + 1)
    return(month, day)
}

func cholidays(year) {
    var (emon, eday) = easter(year)
    printf("%4s: ", year)
    say gather {
        holidays.each { |holiday|
            var (_, mo, da) = %S<Date::Calc>.Add_Delta_Days(year, emon, eday, holiday[1])
            take("#{holiday[0]}: #{'%02d' % da} #{abbr[mo]}")
        }
    }.join(', ')
}

for year in (400..2100 `by` 100, 2010..2020) {
    cholidays(year)
}


package require Tcl 8.5; # Advanced date handling engine

# Easter computation code from http://www.assa.org.au/edm.html
proc EasterDate year {
    set FirstDig [expr {$year / 100}]
    set Remain19 [expr {$year % 19}]

    # calculate Paschal Full Moon date
    set temp [expr {($FirstDig - 15)/2 + 202 - 11*$Remain19}]
    if {$FirstDig in {21 24 25 27 28 29 30 31 32 34 35 38}} {
	incr temp -1
    } elseif {$FirstDig in {33 36 37 39 40}} {
	incr temp -2
    }
    set temp [expr {$temp % 30}]

    set tA [expr {$temp + 21}]
    if {$temp == 29} {incr tA -1}
    if {$temp == 28 && $Remain19 > 10} {incr tA -1}

    # find the next Sunday
    set tB [expr {($tA - 19) % 7}]

    set tC [expr {(40 - $FirstDig) % 4}]
    if {$tC == 3} {incr tC}
    if {$tC > 1} {incr tC}

    set temp [expr {$year % 100}]
    set tD [expr {($temp + $temp/4) % 7}]

    set tE [expr {((20 - $tB - $tC - $tD) % 7) + 1}]
    set d [expr {$tA + $tE}]

    # return the date
    if {$d > 31} {
	return [format "%02d April %04d" [expr {$d - 31}] $year]
    } else {
	return [format "%02d March %04d" $d $year]
    }
}

# Use the Easter calculator to work out the data for the feasts
proc DateInfo year {
    set fields [format %4d: $year]\t
    set easter [clock scan [EasterDate $year] -format "%d %B %Y"]
    foreach {name delta} {
	Easter     0
	Ascension 39
	Pentecost 49
	Trinity   56
	Corpus    60
    } {
	set when [clock add $easter $delta days]
	append fields [clock format $when -format "${name}: %d %b,  "]
    }
    return [string trimright $fields " ,"]
}

# Print the required info
puts "Christian holidays, related to Easter, for each centennial from 400 to 2100 CE:"
for {set year 400} {$year <= 2100} {incr year 100} {
    puts [DateInfo $year]
}
puts ""
puts "Christian holidays, related to Easter, for years from 2010 to 2020 CE:"
for {set year 2010} {$year <= 2020} {incr year} {
    puts [DateInfo $year]
}


$$ MODE TUSCRIPT
SET years=*
LOOP period1=400,2100,100
SET years=APPEND(years,period1)
ENDLOOP
LOOP period2=2010,2020
SET years=APPEND(years,period2)
ENDLOOP
SET years=DIGIT SORT (years)
LOOP year=years
SET dayofweek=DATE (EASTER,day,month,year,nreaster)
PRINT "   Easter: ",year," ",month," ",day
 LOOP nr="39'49'56'60",feast="Ascension'Pentecost'  Trinity'   Corpus"
 SET number=nreaster+nr
 SET dayofweek= DATE (DATE,day,month,year,number)
 PRINT feast,": ",year," ",month," ",day
 ENDLOOP
ENDLOOP


Public dates As Variant
Private Function easter(year_ As Integer) As Date
'-- from https://en.wikipedia.org/wiki/Computus#Anonymous_Gregorian_algorithm
    Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer
    Dim f As Integer, g As Integer, h As Integer, i As Integer, k As Integer
    Dim l As Integer, m As Integer, n As Integer
    a = year_ Mod 19
    b = year_ \ 100
    c = year_ Mod 100
    d = b \ 4
    e = b Mod 4
    f = (b + 8) \ 25
    g = (b - f + 1) \ 3
    h = (19 * a + b - d - g + 15) Mod 30
    i = c \ 4
    k = c Mod 4
    l = (32 + 2 * e + 2 * i - h - k) Mod 7
    m = (a + 11 * h + 22 * l) \ 451
    n = h + l - 7 * m + 114
    month_ = n \ 31
    day_ = n Mod 31 + 1
    easter = DateSerial(year_, month_, day_)
End Function

Private Sub show(year_ As Integer)
    If year_ = 0 Then
        Debug.Print , "Easter", "Ascension", "Pentecost", "Trinity", "Corpus"
    Else
        Dim e As Date
        e = easter(year_)
        Debug.Print Format(year_, "@@@@"),
        For i = 1 To UBound(dates)
            Debug.Print Format(e + dates(i, 2), "ddd dd mmm"),
        Next i
        Debug.Print
    End If
End Sub

Public Sub main()
    Dim year_ As Integer
    dates = [{"Easter   ",0; "Ascension",39; "Pentecost",49; "Trinity  ",56; "Corpus   ",60}]
    show 0
    For year_ = 400 To 2000 Step 100
        show year_
    Next year_
    Debug.Print
    show 0
    For year_ = 2010 To 2020
        show year_
    Next year_
End Sub


import "/date" for Date
import "/fmt" for Fmt
import "/trait" for Stepped

var holidayOffsets = [
    ["Easter", 0],
    ["Ascension", 39],
    ["Pentecost", 49],
    ["Trinity", 56],
    ["C/Christi", 60]
]

var calculateEaster = Fn.new { |year|
    var a = year % 19
    var b = (year / 100).floor
    var c = year % 100
    var d = (b / 4).floor
    var e = b % 4
    var f = ((b + 8) / 25).floor
    var g = ((b - f + 1) / 3).floor
    var h = (19 * a + b - d - g + 15) % 30
    var i = (c / 4).floor
    var k = c % 4
    var l = (32 + 2 * e + 2 * i - h - k) % 7
    var m = ((a + 11 * h + 22 * l) / 451).floor
    var n = h + l - 7 * m + 114
    var month = (n / 31).floor // months indexed from 1
    var day = (n % 31) + 1
    return Date.new(year, month, day)
}

var outputHolidays = Fn.new { |year|
    var date = calculateEaster.call(year)
    Fmt.write("$4d  ", year)
    var po = 0
    for (ho in holidayOffsets) {
        var h = ho[0]
        var o = ho[1]
        date = date.addDays(o - po)
        po = o
        var ds = date.format("dd| |mmm|")
        Fmt.write("$*m  ", h.count, ds)
    }
    System.print()
}

System.print("Year  Easter  Ascension  Pentecost  Trinity  C/Christi")
System.print(" CE   Sunday  Thursday    Sunday    Sunday   Thursday ")
System.print("----  ------  ---------  ---------  -------  ---------")
for (year in Stepped.new(400..2100, 100)) outputHolidays.call(year)
System.print()
for (year in 2010..2020) outputHolidays.call(year)


F first(function)
   R function()

F second()
   R ‘second’

V result = first(second)
print(result)


macro PrintOutput,input,addr
; input: desired function's input
; addr:  function you wish to call
LDA #<\addr          ;#< represents this number's low byte
STA z_L
LDA #>\addr          ;#> represents this number's high byte
STA z_H
LDA \input
JSR doPrintOutput
endm


LEA foo,A0
JSR bar

JMP *              ;HALT

bar:
MOVE.L A0,-(SP)
RTS                ;JMP foo

foo:
RTS                ;do nothing and return. This rts retuns execution just after "JSR bar" but before "JMP *".


: pass-me
  "I was passed\n" . ;
: passer
  w:exec ;
\ pass 'pass-me' to 'passer'
' pass-me passer


package {
    public class MyClass {

        public function first(func:Function):String {
            return func.call();
        }

        public function second():String {
            return "second";
        }

        public static function main():void {
            var result:String = first(second);
            trace(result);
            result = first(function() { return "third"; });
            trace(result);
        }
    }
}


with Ada.Text_Io; use Ada.Text_Io;

procedure Subprogram_As_Argument is
   type Proc_Access is access procedure;

   procedure Second is
   begin
      Put_Line("Second Procedure");
   end Second;

   procedure First(Proc : Proc_Access) is
   begin
      Proc.all;
   end First;
begin
   First(Second'Access);
end Subprogram_As_Argument;


integer
average(integer p, integer q)
{
    return (p + q) / 2;
}

void
out(integer p, integer q, integer (*f) (integer, integer))
{
    o_integer(f(p, q));
    o_byte('\n');
}

integer
main(void)
{
    # display the minimum, the maximum and the average of 117 and 319
    out(117, 319, min);
    out(117, 319, max);
    out(117, 319, average);

    return 0;
}


PROC first = (PROC(LONG REAL)LONG REAL f) LONG REAL:
(
  f(1) + 2
);

PROC second = (LONG REAL x)LONG REAL:
(
  x/2
);

main: (
  printf(($xg(5,2)l$,first(second)))
)


with Ada.Text_IO;
with Ada.Numerics.Generic_Elementary_Functions;

procedure Almost_Integers is

   type Real is new Long_Long_Float;

   package Real_IO is
      new Ada.Text_IO.Float_IO (Real);
   package Integer_IO is
      new Ada.Text_IO.Integer_IO (Integer);

   function Faculty (N : in Long_Long_Integer) return Long_Long_Integer is
      (if N < 2 then N else N * Faculty (N - 1));

   function Hickerson (N : in Integer) return Real
   is
      package Math is
         new Ada.Numerics.Generic_Elementary_Functions (Real);
      LN2         : constant Real := Math.Log (2.0, Base => Ada.Numerics.E);
      Numerator   : constant Real := Real (Faculty (Long_Long_Integer (N)));
      Denominator : constant Real := 2.0 * LN2 ** (N + 1);
   begin
      return Numerator / Denominator;
   end Hickerson;

   function Is_Almost_Integer (N : Real) return Boolean is
      Image : String (1 .. 100);
   begin
      Real_IO.Put (Image, N, Exp => 0, Aft => 2);

      pragma Assert (Image (Image'Last - 2) = '.');
      case Image (Image'Last - 1) is
         when '0' | '9' =>  return True;
         when others    =>  return False;
      end case;
   end Is_Almost_Integer;

   use Ada.Text_IO;
   Placeholder : String := " n                         h(n)  almost";
   Image_N : String renames Placeholder ( 1 ..  2);
   Image_H : String renames Placeholder ( 4 .. 31);
   Image_A : String renames Placeholder (34 .. 39);
begin
   Put_Line (Placeholder);
   Image_N := (others => '-');
   Image_H := (others => '-');
   Image_A := (others => '-');
   Put_Line (Placeholder);

   for N in 1 .. 17 loop
      declare
         H : constant Real    := Hickerson (N);
         I : constant Boolean := Is_Almost_Integer (H);
      begin
         Integer_IO.Put (Image_N, N);
         Real_IO.Put (Image_H, H, Exp => 0, Aft => 4);
         Image_A := (if I then "TRUE " else "FALSE");
         Put_Line (Placeholder);
      end;
   end loop;
end Almost_Integers;


PROC compute(func, val)
  DEF s[10] : STRING
  WriteF('\s\n', RealF(s,func(val),4))
ENDPROC

PROC sin_wrap(val) IS Fsin(val)
PROC cos_wrap(val) IS Fcos(val)

PROC main()
  compute({sin_wrap}, 0.0)
  compute({cos_wrap}, 3.1415)
ENDPROC


-- This handler takes a script object (singer)
-- with another handler (call).
on sing about topic by singer
    call of singer for "Of " & topic & " I sing"
end sing

-- Define a handler in a script object,
-- then pass the script object.
script cellos
    on call for what
        say what using "Cellos"
    end call
end script
sing about "functional programming" by cellos

-- Pass a different handler. This one is a closure
-- that uses a variable (voice) from its context.
on hire for voice
    script
        on call for what
            say what using voice
        end call
    end script
end hire
sing about "closures" by (hire for "Pipe Organ")


# determine whether the first few Hickerson numbers really are "near integers" #
# The Hickerson number n is defined by: h(n) = n! / ( 2 * ( (ln 2)^(n+1) ) )   #
#                                   so: h(1) = 1 / ( 2 * ( ( ln 2 ) ^ 2 )      #
#                                  and: h(n) = ( n / ln 2 ) * h(n-1)           #

# set the precision of LONG LONG numbers                                       #
PR precision 100 PR

# calculate the Hickerson numbers                                              #
LONG LONG REAL ln2 = long long ln( 2 );
[ 1 : 18 ]LONG LONG REAL h;

h[ 1 ] := 0.5 / ( ln2 * ln2 );
FOR n FROM 2 TO UPB h
DO
    h[ n ] := ( n * h[ n - 1 ] ) / ln2
OD;

# determine the first digit after the point in each h(n) - if it is 0 or 9     #
# the number is a "near integer"                                               #

FOR n TO UPB h
DO
    INT first decimal = SHORTEN SHORTEN ( ( ENTIER ( h[ n ] * 10 ) ) MOD 10 );
    print( ( whole( n, -4 )
           , " "
           , fixed( h[ n ], 40, 4 )
           , IF first decimal = 0 OR first decimal = 9
             THEN
                 "     a near integer"
             ELSE
                 " NOT a near integer"
             FI
           , newline
           )
        )
OD


# syntax: GAWK -M -f HICKERSON_SERIES_OF_ALMOST_INTEGERS.AWK
# using GNU Awk 4.1.0, API: 1.0 (GNU MPFR 3.1.2, GNU MP 5.1.2)
BEGIN {
    PREC = 100
    for (i=1; i<=17; i++) {
      h = sprintf("%25.5f",factorial(i) / (2 * log(2) ^ (i + 1)))
      msg = (h ~ /\.[09]/) ? "true" : "false"
      printf("%2d %s almost integer: %s\n",i,h,msg)
    }
    exit(0)
}
function factorial(n,  i,out) {
    out = 1
    for (i=2; i<=n; i++) {
      out *= i
    }
    return(out)
}


doSthWith: function [x y f][
	f x y
]

print [ "add:" doSthWith 2 3 $[x y][x+y] ]
print [ "multiply:" doSthWith 2 3 $[x y][x*y] ]


#include
"share/atspre_staload.hats"

fun app_to_0 (f: (int) -> int): int = f (0)

implement
main0 () =
{
//
val () = assertloc (app_to_0(lam(x) => x+1) = 1)
val () = assertloc (app_to_0(lam(x) => 10*(x+1)) = 10)
//
} (* end of [main0] *)


f(x) {
    return "This " . x
}

g(x) {
    return "That " . x
}

show(fun) {
    msgbox % %fun%("works")
}

show(Func("f")) ; either create a Func object
show("g")       ; or just name the function
return


#include <stdio.h>
#include <mpfr.h>

void h(int n)
{
	MPFR_DECL_INIT(a, 200);
	MPFR_DECL_INIT(b, 200);

	mpfr_fac_ui(a, n, MPFR_RNDD);		// a = n!

	mpfr_set_ui(b, 2, MPFR_RNDD);		// b = 2
	mpfr_log(b, b, MPFR_RNDD);		// b = log(b)
	mpfr_pow_ui(b, b, n + 1, MPFR_RNDD);	// b = b^(n+1)

	mpfr_div(a, a, b, MPFR_RNDD);		// a = a / b
	mpfr_div_ui(a, a, 2, MPFR_RNDD);	// a = a / 2

	mpfr_frac(b, a, MPFR_RNDD);		// b = a - [a]
	mpfr_printf("%2d: %23.4Rf  %c\n", n, a,
		mpfr_cmp_d(b, .1) * mpfr_cmp_d(b, .9) > 0 ? 'Y' : 'N');
}

int main(void)
{
	int n;
	for (n = 1; n <= 17; n++) h(n);

	return 0;
}


#include <iostream>
#include <iomanip>
#include <boost/multiprecision/cpp_dec_float.hpp>
#include <boost/math/constants/constants.hpp>
typedef boost::multiprecision::cpp_dec_float_50 decfloat;

int main()
{
    const decfloat ln_two = boost::math::constants::ln_two<decfloat>();
    decfloat numerator = 1, denominator = ln_two;

    for(int n = 1; n <= 17; n++) {
        decfloat h = (numerator *= n) / (denominator *= ln_two) / 2;
        decfloat tenths_dig = floor((h - floor(h)) * 10);
        std::cout << "h(" << std::setw(2) << n << ") = " << std::setw(25) << std::fixed << h <<
            (tenths_dig == 0 || tenths_dig == 9 ? " is " : " is NOT ") << "an almost-integer.\n";
    }
}


      REM Test passing a function to a function:
      PRINT FNtwo(FNone(), 10, 11)
      END

      REM Function to be passed:
      DEF FNone(x, y) = (x + y) ^ 2

      REM Function taking a function as an argument:
      DEF FNtwo(RETURN f%, x, y) = FN(^f%)(x, y)


add = { a, b | a + b }

doit = { f, a, b | f a, b }

p doit ->add 1 2 #prints 3


(defn hickerson
  "Hickerson number, calculated with BigDecimals and manually-entered high-precision value for ln(2)."
  [n]
  (let [n! (apply *' (range 1M (inc n)))]
    (.divide n! (*' 2 (.pow 0.693147180559945309417232121458M (inc n)))
                30 BigDecimal/ROUND_HALF_UP)))

(defn almost-integer?
  "Tests whether the first digit after the decimal is 0 or 9."
  [x]
  (let [first-digit (int (mod (.divide (*' x 10) 1.0M 0 BigDecimal/ROUND_DOWN)
                              10))]
    (or (= 0 first-digit) (= 9 first-digit))))

; Execute for side effects
(doseq [n (range 1 18) :let [h (hickerson n)]]
  (println (format "%2d %24.5f" n h)
           (if (almost-integer? h)
             "almost integer"
             "NOT almost integer")))


       >>SOURCE FREE
IDENTIFICATION DIVISION.
PROGRAM-ID. hickerson-series.

ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
REPOSITORY.
    FUNCTION ALL INTRINSIC
    .
DATA DIVISION.
WORKING-STORAGE SECTION.
01  n                                   PIC 99 COMP.

01  h                                   PIC Z(19)9.9(10).

01  First-Decimal-Digit-Pos             CONSTANT 22.

PROCEDURE DIVISION.
    PERFORM VARYING n FROM 0 BY 1 UNTIL n > 17
        COMPUTE h = FACTORIAL(n) / (2 * LOG(2) ** (n + 1))
        DISPLAY "h(" n ") = " h " which is " NO ADVANCING
        IF h (First-Decimal-Digit-Pos:1) = "0" OR "9"
            DISPLAY "an almost integer."
        ELSE
            DISPLAY "not an almost integer."
        END-IF
    END-PERFORM
    .
END PROGRAM hickerson-series.


void myFuncSimple( void (*funcParameter)(void) )
{
    /* ... */

    (*funcParameter)();  /* Call the passed function. */
    funcParameter();     /* Same as above with slight different syntax. */

    /* ... */
}


// Use <functional> for C++11
#include <tr1/functional>
#include <iostream>

using namespace std;
using namespace std::tr1;

void first(function<void()> f)
{
  f();
}

void second()
{
  cout << "second\n";
}

int main()
{
  first(second);
}


require "big"

LN2 = Math.log(2).to_big_f

FACTORIALS = Hash(Int32, Float64).new{|h,k| h[k] = k * h[k-1]}
FACTORIALS[0] = 1

def hickerson(n)
  FACTORIALS[n] / (2 * LN2 ** (n+1))
end

def nearly_int?(n)
  int = n.round
  (int - 0.1..int + 0.1).includes? n
end

1.upto(17) do |n|
  h = hickerson(n)
  str = nearly_int?(h) ? "nearly integer" : "NOT nearly integer"
  puts "n:%3i h: %s\t%s" % [n, h, str]
end


void main() {
    import std.stdio, std.algorithm, std.mathspecial;

    foreach (immutable n; 1 .. 18) {
        immutable x = gamma(n + 1) / (2 * LN2 ^^ (n + 1)),
                  tenths = cast(int)floor((x - x.floor) * 10);
        writefln("H(%2d)=%22.2f is %snearly integer.", n, x,
                  tenths.among!(0, 9) ? "" : "NOT ");
    }
}


USING: formatting kernel math math.factorials math.functions
math.ranges sequences ;
IN: rosetta-code.hickerson

: ln2 ( -- x )
    99 [1,b] [ [ 2 swap ^ ] [ * ] bi recip ] map-sum ;

: hickerson ( n -- x ) [ n! ] [ 1 + ln2 swap ^ 2 * ] bi / ;

: almost-int? ( x -- ? ) 10 * truncate 10 mod { 0 9 } member? ;

: hickerson-demo ( -- )
    18 [1,b] [
        dup hickerson dup almost-int?
        "h(%02d) = %23.3f   almost integer? %u\n" printf
    ] each ;

MAIN: hickerson-demo


[UNDEFINED] ANS [IF]
include lib/fp1.4th                    \ Zen float version
include lib/zenfprox.4th               \ for F~
include lib/zenround.4th               \ for FROUND
include lib/zenfln.4th                 \ for FLN
include lib/zenfpow.4th                \ for FPOW
[ELSE]
include lib/fp3.4th                    \ ANS float version
include lib/flnflog.4th                \ for FLN
include lib/fpow.4th                   \ for FPOW
[THEN]

include lib/fast-fac.4th               \ for FACTORIAL

fclear                                 \ initialize floating point
float array ln2 2 s>f fln latest f!    \ precalculate ln(2)
                                       \ integer exponentiation
: hickerson dup >r factorial s>f ln2 [email protected] r> 1+ fpow fdup f+ f/ ;
: integer? if ." TRUE " else ." FALSE" then space ;
                                       \ is it an integer?
: first17
  18 1 do                              \ test hickerson 1-17
    i hickerson i 2 .r space fdup fdup fround
    s" 1e-1" s>float f~ integer? f. cr
  loop                                 \ within 0.1 absolute error
;

first17


map f [x:xs] = [f x:map f xs]
map f []     = []


(defn append-hello [s]
  (str "Hello " s))

(defn modify-string [f s]
  (f s))

(println (modify-string append-hello "World!"))


% Functions can be passed to other functions using the 'proctype'
% type generator. The same works for iterators, using 'itertype'

% Here are two functions
square = proc (n: int) returns (int) return (n*n) end square
cube = proc (n: int) returns (int) return (n*n*n) end cube

% Here is a function that takes another function
do_calcs = proc (from, to: int, title: string,
                 fn: proctype (int) returns (int))
    po: stream := stream$primary_output()

    stream$putleft(po, title, 8)
    stream$puts(po, " -> ")
    for i: int in int$from_to(from,to) do
        stream$putright(po, int$unparse(fn(i)), 5)
    end
    stream$putc(po, '\n')
end do_calcs

start_up = proc ()
    do_calcs(1, 10, "Squares", square)
    do_calcs(1, 10, "Cubes", cube)
end start_up


program hickerson
    implicit none
    integer, parameter :: q = selected_real_kind(30)
    integer, parameter :: l = selected_int_kind(15)
    real(q) :: s, l2
    integer :: i, n, k

    l2 = log(2.0_q)
    do n = 1, 17
        s = 0.5_q / l2
        do i = 1, n
            s = (s * i) / l2
        end do

        k = floor((s - floor(s, l)) * 10)
        if (k == 0 .or. k == 9) then
            print 1, n, s, ""
        else
            print 1, n, s, " NOT"
        endif
    end do
  1 format('h(',I2,') = ',F23.3,' is',A,' an almost-integer')
end program


' version 08-10-2016
' compile with: fbc -s gui

#Include Once "gmp.bi"

#Macro init_float_size (big_float ,size)
  Dim As Mpf_ptr big_float = Allocate( Len( __mpf_struct))
  Mpf_init2( big_float,size)
#EndMacro

#Macro mpf_remove(big_float)
  Mpf_clear(big_float)
  DeAllocate (big_float)
#EndMacro

Screen 20

init_float_size(tmp,1024)
init_float_size(ln2,1024)
init_float_size(pow_ln2,2048)
init_float_size(answer,2048)

Dim As UInteger n, num
Dim As String st
Dim As ZString Ptr text
text = Allocate (1500) ' size 1500 char.

' need to calculate ln(2)

'     x    1     1         1           1
' ln --- = - + ------ + ------ ... + ------
'    x-1   x    2x^2     3x^3         nx^n

Mpf_set_ui(answer, 1)
Mpf_div_ui(answer, answer, 2)   ' answer = 1/2

For n = 2 To 1024
  Mpf_set_ui(tmp, 2)            ' tmp = x = 2
  Mpf_pow_ui(tmp, tmp, n)       ' tmp = x ^ n
  Mpf_mul_ui(tmp, tmp, n)       ' tmp = n * (x ^ n)
  Mpf_ui_div(tmp, 1, tmp)       ' tmp = 1 / (n * (x ^ n))
  Mpf_add(answer, answer, tmp)  ' answer += tmp
Next

/'  remove this line if you want to print ln(2)
Gmp_sprintf(text,!"ln(2) =\t %2.100Ff ", answer)
Print *text
Print
'/

Mpf_set_ui(tmp, 1)
Mpf_set(ln2, answer )
Mpf_set(pow_ln2, ln2)

Print
For n = 1 To 40
  Mpf_mul_ui(tmp, tmp, n)                           ' n!
  Mpf_mul(pow_ln2, pow_ln2, ln2)                    ' ln(2)^(n+1)
  Mpf_div_ui(answer, tmp , 2)                       ' / 2
  Mpf_div(answer, answer, pow_ln2)                  ' / ln(2)^(n+1)
  Gmp_sprintf(text,!"h(%i) =\t %65.5Ff ",n, answer)
  st = *text
  num = st[InStr(st,".")]  ' get the first character after the "."
  If num = Asc("0") Or num = Asc("9") Then
    Color 10
    Print st;" is a almost integer"
    Color 15
  Else
    Color 12
    Print st;" not close enough"
    Color 15
  End If
Next

mpf_remove(answer)  'cleanup
mpf_remove(pow_ln2)
mpf_remove(ln2)
mpf_remove(tmp)
DeAllocate (text)

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


CL-USER> (defun add (a b) (+ a b))
ADD
CL-USER> (add 1 2)
3
CL-USER> (defun call-it (fn x y)
            (funcall fn x y))
CALL-IT
CL-USER> (call-it #'add 1 2)
3


include "cowgol.coh";

# In order to pass functions around, you must first define an interface.
# This is similar to a delegate in C#; it becomes a function pointer type.
# This interface takes two integers and returns one.
interface Dyadic(x: int32, y: int32): (r: int32);

# For a function to be able to be passed around, it must explicitly implement
# an interface. Then it has the same type as that interface.
# The interface replaces the method's parameter list entirely.
sub Add implements Dyadic is
    r := x + y;
end sub;

# Here are the other basic operators.
sub Sub implements Dyadic is r := x - y; end sub;
sub Mul implements Dyadic is r := x * y; end sub;
sub Div implements Dyadic is r := x / y; end sub;

# An interface is just like any other type, and the functions that implement
# it are first-class values. For example, this code maps the operator
# characters to their functions.
record Operator is
    char: uint8;
    func: Dyadic;
end record;

var operators: Operator[] := {
    {'+', Add}, {'-', Sub}, {'*', Mul}, {'/', Div},
    {0, Dyadic}
};

# This is a function that applies such a function to two values
sub apply(f: Dyadic, x: int32, y: int32): (r: int32) is
    r := f(x,y); # the function can be called as normal
end sub;

# And this is a function that applies all the above operators to two values
sub showAll(ops: [Operator], x: int32, y: int32) is
    while ops.char != 0 loop
        print_i32(x as uint32);
        print_char(' ');
        print_char(ops.char);
        print_char(' ');
        print_i32(y as uint32);
        print(" = ");
        print_i32(apply(ops.func, x, y) as uint32);
        print_nl();
        ops := @next ops;
    end loop;
end sub;

showAll(&operators[0], 84, 42); # example


package main

import (
    "fmt"
    "math/big"
)

func main() {
    ln2, _ := new(big.Rat).SetString("0.6931471805599453094172")
    h := big.NewRat(1, 2)
    h.Quo(h, ln2)
    var f big.Rat
    var w big.Int
    for i := int64(1); i <= 17; i++ {
        h.Quo(h.Mul(h, f.SetInt64(i)), ln2)
        w.Quo(h.Num(), h.Denom())
        f.Sub(h, f.SetInt(&w))
        y, _ := f.Float64()
        d := fmt.Sprintf("%.3f", y)
        fmt.Printf("n: %2d  h: %18d%s  Nearly integer: %t\n",
            i, &w, d[1:], d[2] == '0' || d[2] == '9')
    }
}


int hof(int a, int b, int delegate(int, int) f) {
    return f(a, b);
}

void main() {
    import std.stdio;
    writeln("Add: ", hof(2, 3, (a, b) => a + b));
    writeln("Multiply: ", hof(2, 3, (a, b) => a * b));
}


type TFnType = function(x : Float) : Float;

function First(f : TFnType) : Float;
begin
   Result := f(1) + 2;
end;

function Second(f : Float) : Float;
begin
   Result := f/2;
end;

PrintLn(First(Second));


import Data.Number.CReal -- from numbers

import qualified Data.Number.CReal as C

hickerson :: Int -> C.CReal
hickerson n = (fromIntegral $ product [1..n]) / (2 * (log 2 ^ (n + 1)))

charAfter :: Char -> String -> Char
charAfter ch string = ( dropWhile (/= ch) string ) !! 1

isAlmostInteger :: C.CReal -> Bool
isAlmostInteger = (`elem` ['0', '9']) . charAfter '.' . show

checkHickerson :: Int -> String
checkHickerson n  = show $ (n, hickerson n, isAlmostInteger $ hickerson n)

main :: IO ()
main = mapM_ putStrLn $ map checkHickerson [1..18]


import java.math.*;

public class Hickerson {

    final static String LN2 = "0.693147180559945309417232121458";

    public static void main(String[] args) {
        for (int n = 1; n <= 17; n++)
            System.out.printf("%2s is almost integer: %s%n", n, almostInteger(n));
    }

    static boolean almostInteger(int n) {
        BigDecimal a = new BigDecimal(LN2);
        a = a.pow(n + 1).multiply(BigDecimal.valueOf(2));

        long f = n;
        while (--n > 1)
            f *= n;

        BigDecimal b = new BigDecimal(f);
        b = b.divide(a, MathContext.DECIMAL128);

        BigInteger c = b.movePointRight(1).toBigInteger().mod(BigInteger.TEN);

        return c.toString().matches("0|9");
    }
}


map f lst:
    ]
    for item in lst:
        f item
    [

twice:
    * 2

!. map @twice [ 1 2 5 ]


/* Example functions - there are no anonymous functions */
proc nonrec square(word n) word: n*n corp
proc nonrec cube(word n) word: n*n*n corp

/* A function that takes another function.
 * Note how a function is defined as:
 *      proc name(arguments) returntype:  [code here]  corp
 * But a function variable is instead defined as:
 *      proc(arguments) returntype name
 */
proc nonrec do_func(word start, stop; proc(word n) word fn) void:
    word n;
    for n from start upto stop do
        write(fn(n):8)
    od;
    writeln()
corp

/* We can then just pass the name of a function as an argument */
proc main() void:
    do_func(1, 10, square);
    do_func(1, 10, cube)
corp


def map(f, list) {
  var out := []
  for x in list {
    out with= f(x)
  }
  return out
}

? map(fn x { x + x }, [1, "two"])
# value: [2, "twotwo"]

? map(1.add, [5, 10, 20])
# value: [6, 11, 21]

? def foo(x) { return -(x.size()) }
> map(foo, ["", "a", "bc"])
# value: [0, -1, -2]


def hickerson:
  . as $n
  | (2|log) as $log2
  | reduce range(1;$n+1) as $i ( 0.5/$log2; . * $i / $log2) ;

def precise:
   (. - 0.05) as $x | . != ($x + 0.1) ;

def almost_an_integer:
  tostring
  | index(".") as $ix
  | if $ix == null then true
    else .[$ix+1:$ix+2] | (. == "9" or . == "0")
    end ;

range(1;18)
  | . as $i
  | hickerson
  | if precise then
      if almost_an_integer
        then "hickerson(\($i)) is \(.) -- almost an integer"
      else "hickerson(\($i)) is \(.)"
      end
    else "insufficient precision for hickerson(\($i))"
    end


function makehickerson{T<:Real}(x::T)
    n = 0
    h = one(T)/2x
    function hickerson()
        n += 1
        h *= n/x
    end
end

function reporthickerson{T<:Real,U<:Integer}(a::T, nmax::U)
    h = makehickerson(a)
    hgm = makehickerson(prevfloat(a))
    hgp = makehickerson(nextfloat(a))

    println()
    print("Performing calculations using ", typeof(a))
    println(", which has ", precision(a), "-bit precision.")
    for i in 1:nmax
        x = h()
        xm = hgm()
        xp = hgp()
        y = ifloor(10x)
        ym = ifloor(10xm)
        yp = ifloor(10xp)
        println()
        println("Hickerson series result for n = ", i)
        println(@sprintf("    ->  %25.4f ", xm))
        println(@sprintf("    0>  %25.4f ", x))
        println(@sprintf("    +>  %25.4f ", xp))
        isprecok =
        isint =
        if ym == y == yp
            print("The precision is adequate, ")
            if  digits(y)[1] in [0, 9]
                println("and the result is an almost integer.")
            else
                println("but the result is not an almost integer.")
            end
        else
            println("The precision is inadequate for a definite result.")
        end
    end
end

a = log(big(2.0))
reporthickerson(a, 17)

a = log(2.0)
reporthickerson(a, 17)


// version 1.1.4

import java.math.BigDecimal
import java.math.BigInteger
import java.math.MathContext

object Hickerson {
    private const val LN2 = "0.693147180559945309417232121458"

    fun almostInteger(n: Int): Boolean {
        val a = BigDecimal(LN2).pow(n + 1) * BigDecimal(2)
        var nn = n
        var f = n.toLong()
        while (--nn > 1) f *= nn
        val b = BigDecimal(f).divide(a, MathContext.DECIMAL128)
        val c = b.movePointRight(1).toBigInteger() % BigInteger.TEN
        return c.toString().matches(Regex("[09]"))
    }
}

fun main(args: Array<String>) {
    for (n in 1..17) println("${"%2d".format(n)} is almost integer: ${Hickerson.almostInteger(n)}")
}


h[n_] = n!/(2 (Log[2])^(n + 1));
firstdecimal[x_] := Floor[10 x] - 10 Floor[x];
almostIntegerQ[x_] := firstdecimal[x] == 0 || firstdecimal[x] == 9;
Table[{i, AccountingForm[N[h[i], 50], {Infinity, 5}], almostIntegerQ[N[h[i], 50]]}, {i, 1, 17}] // TableForm


local
  fun log (n, k, last = sum, sum) = sum
        | (n, k, last, sum) = log (n, k + 1, sum, sum + ( 1 / (k * n ^ k)))
        | n = log (n, 1, 1, 0);
  val ln2 = log 2
in
  fun hickerson n = (fold (opt *,1) ` iota n) / (2 * ln2 ^ (n+1));
  fun almost_int ([]) = false
               | (h :: h' :: t) where (h <> #".") = almost_int (h' :: t)
               | (h :: h' :: t) = h' = #"0" or h' = #"9"
               | s = almost_int (explode s)
  and show (n, h) = println (n, ntos h, almost_int ` ntos ` h)
         | n = show (n, hickerson n)
end
;
foreach show ` iota 17;


//a Function prototype:
INTEGER actionPrototype(INTEGER v1, INTEGER v2) := 0;

INTEGER aveValues(INTEGER v1, INTEGER v2) := (v1 + v2) DIV 2;
INTEGER addValues(INTEGER v1, INTEGER v2) := v1 + v2;
INTEGER multiValues(INTEGER v1, INTEGER v2) := v1 * v2;

//a Function prototype using a function prototype:
INTEGER applyPrototype(INTEGER v1, actionPrototype actionFunc) := 0;

//using the Function prototype and a default value:
INTEGER applyValue2(INTEGER v1,
                    actionPrototype actionFunc = aveValues) :=
                    actionFunc(v1, v1+1)*2;

//Defining the Function parameter inline, witha default value:
INTEGER applyValue4(INTEGER v1,
                    INTEGER actionFunc(INTEGER v1,INTEGER v2) = aveValues)
               := actionFunc(v1, v1+1)*4;
INTEGER doApplyValue(INTEGER v1,
                     INTEGER actionFunc(INTEGER v1, INTEGER v2))
        := applyValue2(v1+1, actionFunc);

//producing simple results:
OUTPUT(applyValue2(1));                           // 2
OUTPUT(applyValue2(2));                           // 4
OUTPUT(applyValue2(1, addValues));                // 6
OUTPUT(applyValue2(2, addValues));                // 10
OUTPUT(applyValue2(1, multiValues));              // 4
OUTPUT(applyValue2(2, multiValues));              // 12
OUTPUT(doApplyValue(1, multiValues));             // 12
OUTPUT(doApplyValue(2, multiValues));             // 24

//A definition taking function parameters which themselves
//have parameters that are functions...

STRING doMany(INTEGER v1,
              INTEGER firstAction(INTEGER v1,
                                  INTEGER actionFunc(INTEGER v1,INTEGER v2)),
              INTEGER secondAction(INTEGER v1,
                                   INTEGER actionFunc(INTEGER v1,INTEGER v2)),
              INTEGER actionFunc(INTEGER v1,INTEGER v2))
       := (STRING)firstAction(v1, actionFunc) + ':' + (STRING)secondaction(v1, actionFunc);

OUTPUT(doMany(1, applyValue2, applyValue4, addValues));
     // produces "6:12"

OUTPUT(doMany(2, applyValue4, applyValue2,multiValues));
     // produces "24:12"


first = fn (F) {
  F()
}

second = fn () {
  io.format("hello~n")
}

@public
run = fn () {
    # passing the function specifying the name and arity
    # arity: the number of arguments it accepts
    first(fn second:0)

    first(fn () { io.format("hello~n") })

    # holding a reference to the function in a variable
    F1 = fn second:0
    F2 = fn () { io.format("hello~n") }

    first(F1)
    first(F2)
}


import extensions;

public program()
{
    var first := (f => f());
    var second := {"second"};
    console.printLine(first(second))
}


import strformat
import bignum

let ln2 = newInt("693147180559945309417232121458") / newInt("1000000000000000000000000000000")

iterator hickerson(): tuple[n: int; val: Rat] =
  ## Yield the hickerson series values as rational numbers.
  var
    n = 1
    num = 1
    denom = 2 * ln2 * ln2
  while true:
    yield (n, num / denom)
    inc n
    num *= n
    denom *= ln2

func fract(r: Rat): float =
  ## Return the fractional part of rational "r".
  ((r.num mod r.denom) / r.denom).toFloat

for i, val in hickerson():
  let f = val.fract
  let s = if int(10 * f) in {0, 9}: "" else: "not "
  echo &"Fractional part of h({i}) is {f:.5f}..., so h({i}) is {s}nearly an integer."
  if i == 17: break


use strict;
use warnings;
use Math::BigFloat;

my $iln2 = 1 / Math::BigFloat->new(2)->blog;
my $h = $iln2 / 2;

for my $n ( 1 .. 17 ) {
	$h *= $iln2;
	$h *= $n;
	my $s = $h->copy->bfround(-3)->bstr;
	printf "h(%2d) = %22s is%s almost an integer.\n",
		$n, $s, ($s =~ /\.[09]/ ? "" : " NOT");
}


without javascript_semantics -- (no mpfr_log() for pwa/p2js)
requires("1.0.0") -- (mpfr_set_default_prec[ision] renamed)
include mpfr.e
mpfr_set_default_precision(-23) -- (found by trial/error)
mpfr ln2 = mpfr_init(2),
     hn = mpfr_init(0.5)
mpfr_log(ln2,ln2)
mpfr_div(hn,hn,ln2)
for n=1 to 17 do
    mpfr_mul_si(hn,hn,n)
    mpfr_div(hn,hn,ln2)
    string n10 = mpfr_sprintf("%24.4Rf ",hn)
    n10 &= iff(find(n10[21],"09")?"Y":"N")
    printf(1,"%2d:%s\n",{n,n10})
end for


-module(test).
-export([first/1, second/0]).

first(F) -> F().
second() -> hello.


PROGRAM FUNC_PASS

  FUNCTION ONE(X,Y)
     ONE=(X+Y)^2
  END FUNCTION

  FUNCTION TWO(X,Y)
     TWO=ONE(X,Y)+1
  END FUNCTION

BEGIN
  PRINT(TWO(10,11))
END PROGRAM


procedure use(integer fi, integer a, integer b)
    print(1,call_func(fi,{a,b}))
end procedure

function add(integer a, integer b)
    return a + b
end function

use(routine_id("add"),23,45)


(load "@lib/misc.l")

(scl 25)

(setq LN2 0.69314718055994530941723212)

(de almost-int? (N)
   (bool (member (% (/ N 0.1) 10) (0 9))))

(de fmt4 (N)
   (format (/ N 0.0001) 4))

(de h (N)
   (*/ (factorial N) `(* 1.0 1.0) (* 2 (s** LN2 (inc N)))))

(de s** (A N)  # scaled integer exponentiation
   (let R 1.0
      (for Bit (chop (bin N))
         (setq R (*/ R R 1.0))
         (when (= Bit "1")
            (setq R (*/ A R 1.0))))
      R))

(de factorial (N)
   (cond
      ((lt0 N)   NIL)
      ((=0 N)    1)
      (T         (apply * (range 1 N)))))

(for I 18
   (let H (h I)
      (if (almost-int? H)
         (prin "yes: ")
         (prin " no: "))
      (prinl "h(" (align 2 I) ") = " (fmt4 H))))
(bye)


Hickerson: procedure options (main); /* 12 January 2014 */
   declare s float (18), (i, n) fixed binary;
   declare is fixed decimal (30);
   declare f fixed decimal (4,3);

   do n = 1 to 16; /* 17 exceeds hardware precision */
      s = 0.5Q0 / 0.693147180559945309417232121458;
      do i = 1 to n;
         s = (s * i) / 0.693147180559945309417232121458;
      end;

      is = s;
      f = s-is;
      is = 10*f;
      put skip edit (n, s) (f(2), f(30,3));
      if is = 0 | is = 9 then
         put edit (' is a near integer') (A);
      else
         put edit (' is not a near integer') (A);
   end;

end Hickerson;


from decimal import Decimal
import math

def h(n):
    'Simple, reduced precision calculation'
    return math.factorial(n) / (2 * math.log(2) ** (n + 1))

def h2(n):
    'Extended precision Hickerson function'
    return Decimal(math.factorial(n)) / (2 * Decimal(2).ln() ** (n + 1))

for n in range(18):
    x = h2(n)
    norm = str(x.normalize())
    almostinteger = (' Nearly integer'
                     if 'E' not in norm and ('.0' in norm or '.9' in norm)
                     else ' NOT nearly integer!')
    print('n:%2i h:%s%s' % (n, norm, almostinteger))


V qseq = [0] * 100001
qseq[1] = 1
qseq[2] = 1

L(i) 3 .< qseq.len
   qseq[i] = qseq[i - qseq[i-1]] + qseq[i - qseq[i-2]]

print(‘The first 10 terms are: ’qseq[1..10].map(q -> String(q)).join(‘, ’))
print(‘The 1000'th term is ’qseq[1000])

V less_than_preceding = 0
L(i) 2 .< qseq.len
   I qseq[i] < qseq[i-1]
      less_than_preceding++
print(‘Times a member of the sequence is less than its preceding term: ’less_than_preceding)


> let twice f x = f (f x);;

val twice : ('a -> 'a) -> 'a -> 'a

> twice System.Math.Sqrt 81.0;;
val it : float = 3.0


USING: io ;
IN: rosetacode
: argument-function1 ( -- ) "Hello World!" print ;
: argument-function2 ( -- ) "Goodbye World!" print ;

! normal words have to know the stack effect of the input parameters they execute
: calling-function1 ( another-function -- ) execute( -- ) ;

! unlike normal words, inline words do not have to know the stack effect.
: calling-function2 ( another-function -- ) execute ; inline

! Stack effect has to be written for runtime computed values :
: calling-function3 ( bool -- ) \ argument-function1 \ argument-function2 ? execute( -- ) ;


class Main
{
  // apply given function to two arguments
  static Int performOp (Int arg1, Int arg2, |Int, Int -> Int| fn)
  {
    fn (arg1, arg2)
  }

  public static Void main ()
  {
    echo (performOp (2, 5, |Int a, Int b -> Int| { a + b }))
    echo (performOp (2, 5, |Int a, Int b -> Int| { a * b }))
  }
}