######################################################################
#
# The Rosetta Code scanner in Ratfor 77.
#
#
# How to deal with FORTRAN 77 input is a problem. I use formatted
# input, treating each line as an array of type CHARACTER--regrettably
# of no more than some predetermined, finite length. It is a very
# simple method and presents no significant difficulties, aside from
# the restriction on line length of the input.
#
#
# On a POSIX platform, the program can be compiled with f2c and run
# somewhat as follows:
#
#    ratfor77 lex-in-ratfor.r > lex-in-ratfor.f
#    f2c -C -Nc40 lex-in-ratfor.f
#    cc -O lex-in-ratfor.c -lf2c
#    ./a.out < compiler-tests/primes.t
#
# With gfortran, a little differently:
#
#    ratfor77 lex-in-ratfor.r > lex-in-ratfor.f
#    gfortran -O2 -fcheck=all -std=legacy lex-in-ratfor.f
#    ./a.out < compiler-tests/primes.t
#
#
# I/O is strictly from default input and to default output, which, on
# POSIX systems, usually correspond respectively to standard input and
# standard output. (I did not wish to have to deal with unit numbers;
# these are now standardized in ISO_FORTRAN_ENV, but that is not
# available in FORTRAN 77.)
#
#---------------------------------------------------------------------

# Some parameters you may with to modify.

define(LINESZ, 256)           # Size of an input line.
define(OUTLSZ, 512)           # Size of an output line.
define(PSHBSZ, 10)            # Size of the character pushback buffer.
define(STRNSZ, 4096)          # Size of the string pool.

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

define(EOF, -1)
define(NEWLIN, 10)          # Unix newline (the LF control character).
define(BACKSL, 92)          # ASCII backslash.

define(ILINNO, 1)               # Line number's index.
define(ICOLNO, 2)               # Column number's index.

define(CHRSZ,  3)               # See ILINNO and ICOLNO above.
define(ICHRCD, 3)               # Character code's index.

define(TOKSZ,  5)               # See ILINNO and ICOLNO above.
define(ITOKNO, 3)               # Token number's index.
define(IARGIX, 4)               # Index of the string pool index.
define(IARGLN, 5)               # Index of the string length.

define(TKELSE,  0)
define(TKIF,    1)
define(TKPRNT,  2)
define(TKPUTC,  3)
define(TKWHIL,  4)
define(TKMUL,   5)
define(TKDIV,   6)
define(TKMOD,   7)
define(TKADD,   8)
define(TKSUB,   9)
define(TKNEG,  10)
define(TKLT,   11)
define(TKLE,   12)
define(TKGT,   13)
define(TKGE,   14)
define(TKEQ,   15)
define(TKNE,   16)
define(TKNOT,  17)
define(TKASGN, 18)
define(TKAND,  19)
define(TKOR,   20)
define(TKLPAR, 21)
define(TKRPAR, 22)
define(TKLBRC, 23)
define(TKRBRC, 24)
define(TKSEMI, 25)
define(TKCMMA, 26)
define(TKID,   27)
define(TKINT,  28)
define(TKSTR,  29)
define(TKEOI,  30)

define(LOC10, 1)                # Location of "10" in the string pool.
define(LOC92, 3)                # Location of "92" in the string pool.

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

subroutine addstr (strngs, istrng, src, i0, n0, i, n)

  # Add a string to the string pool.

  implicit none

  character strngs(STRNSZ)      # String pool.
  integer istrng                # String pool's next slot.
  character src(*)              # Source string.
  integer i0, n0                # Index and length in source string.
  integer i, n                  # Index and length in string pool.

  integer j

  if (STRNSZ < istrng + (n0 - 1))
    {
      write (*, '(''string pool exhausted'')')
      stop
    }
  for (j = 0; j < n0; j = j + 1)
    strngs(istrng + j) = src(i0 + j)
  i = istrng
  n = n0
  istrng = istrng + n0
end

subroutine cpystr (strngs, i, n, dst, i0)

  # Copy a string from the string pool to an output string.

  implicit none

  character strngs(STRNSZ)      # String pool.
  integer i, n                  # Index and length in string pool.
  character dst(OUTLSZ)         # Destination string.
  integer i0                    # Index within destination string.

  integer j

  if (i0 < 1 || OUTLSZ < i0 + (n - 1))
    {
      write (*, '(''string boundary exceeded'')')
      stop
    }
  for (j = 0; j < n; j = j + 1)
    dst(i0 + j) = strngs(i + j)
end

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

subroutine getchr (line, linno, colno, pushbk, npshbk, chr)

  # Get a character, with its line number and column number.

  implicit none

  character line(LINESZ)        # Input buffer.
  integer linno, colno          # Current line and column numbers.
  integer pushbk(CHRSZ, PSHBSZ) # Pushback buffer.
  integer npshbk                # Number of characters pushed back.
  integer chr(CHRSZ)

  # End of file is indicated (as in C) by a negative "char code"
  # called "EOF".

  character*20 fmt
  integer stat
  integer chr1(CHRSZ)

  if (0 < npshbk)
    {
      chr(ICHRCD) = pushbk(ICHRCD, npshbk)
      chr(ILINNO) = pushbk(ILINNO, npshbk)
      chr(ICOLNO) = pushbk(ICOLNO, npshbk)
      npshbk =  npshbk - 1
    }
  else if (colno <= LINESZ)
    {
      chr(ICHRCD) = ichar (line(colno))
      chr(ILINNO) = linno
      chr(ICOLNO) = colno
      colno = colno + 1
    }
  else
    {
      # Return a newline character.
      chr(ICHRCD) = NEWLIN
      chr(ILINNO) = linno
      chr(ICOLNO) = colno

      # Fetch a new line.
      linno = linno + 1
      colno = 1

      # Read a line of text as an array of characters.
      write (fmt, '(''('', I10, ''A1)'')') LINESZ
      read (*, fmt, iostat = stat) line

      if (stat != 0)
        {
          # If end of file has been reached, push an EOF.
          chr1(ICHRCD) = EOF
          chr1(ILINNO) = linno
          chr1(ICOLNO) = colno
          call pshchr (pushbk, npshbk, chr1)
        }
    }
end

subroutine pshchr (pushbk, npshbk, chr)

  # Push back a character.

  implicit none

  integer pushbk(CHRSZ, PSHBSZ) # Pushback buffer.
  integer npshbk                # Number of characters pushed back.
  integer chr(CHRSZ)

  if (PSHBSZ <= npshbk)
    {
      write (*, '(''pushback buffer overfull'')')
      stop
    }
  npshbk = npshbk + 1
  pushbk(ICHRCD, npshbk) = chr(ICHRCD)
  pushbk(ILINNO, npshbk) = chr(ILINNO)
  pushbk(ICOLNO, npshbk) = chr(ICOLNO)
end

subroutine getpos (line, linno, colno, pushbk, npshbk, ln, cn)

  # Get the position of the next character.

  implicit none

  character line(LINESZ)        # Input buffer.
  integer linno, colno          # Current line and column numbers.
  integer pushbk(CHRSZ, PSHBSZ) # Pushback buffer.
  integer npshbk                # Number of characters pushed back.
  integer ln, cn                # The line and column nos. returned.

  integer chr(CHRSZ)

  call getchr (line, linno, colno, pushbk, npshbk, chr)
  ln = chr(ILINNO)
  cn = chr(ICOLNO)
  call pshchr (pushbk, npshbk, chr)
end

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

function isspc (c)

  # Is c character code for a space?

  implicit none

  integer c
  logical isspc

  #
  # The following is correct for ASCII: 32 is the SPACE character, and
  # 9 to 13 are control characters commonly regarded as spaces.
  #
  # In Unicode these are all code points for spaces, but so are others
  # besides.
  #
  isspc = (c == 32 || (9 <= c && c <= 13))
end

function isdgt (c)

  # Is c character code for a digit?

  implicit none

  integer c
  logical isdgt

  isdgt = (ichar ('0') <= c && c <= ichar ('9'))
end

function isalph (c)

  # Is c character code for a letter?

  implicit none

  integer c
  logical isalph

  #
  # The following is correct for ASCII and Unicode, but not for
  # EBCDIC.
  #
  isalph = (ichar ('a') <= c && c <= ichar ('z')) _
             || (ichar ('A') <= c && c <= ichar ('Z'))
end

function isid0 (c)

  # Is c character code for the start of an identifier?

  implicit none

  integer c
  logical isid0

  logical isalph

  isid0 = isalph (c) || c == ichar ('_')
end

function isid1 (c)

  # Is c character code for the continuation of an identifier?

  implicit none

  integer c
  logical isid1

  logical isalph
  logical isdgt

  isid1 = isalph (c) || isdgt (c) || c == ichar ('_')
end

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

function trimlf (str, n)

  # "Trim left" leading spaces.

  implicit none

  character str(*)             # The string to "trim".
  integer n                    # The length.
  integer trimlf               # The index of the first non-space
                               # character, or n + 1.

  logical isspc

  integer j
  logical done

  j = 1
  done = .false.
  while (!done)
    {
      if (j == n + 1)
        done = .true.
      else if (!isspc (ichar (str(j))))
        done = .true.
      else
        j = j + 1
    }
  trimlf = j
end

function trimrt (str, n)

  # "Trim right" trailing spaces.

  implicit none

  character str(*)             # The string to "trim".
  integer n                    # The length including trailing spaces.
  integer trimrt               # The length without trailing spaces.

  logical isspc

  integer j
  logical done

  j = n
  done = .false.
  while (!done)
    {
      if (j == 0)
        done = .true.
      else if (!isspc (ichar (str(j))))
        done = .true.
      else
        j = j - 1
    }
  trimrt = j
end

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

subroutine toknam (tokno, str, i)

  # Copy a token name to the character array str, starting at i.

  implicit none

  integer tokno
  character str(*)
  integer i
  integer j

  character*16 names(0:30)
  character*16 nm

  data names / "Keyword_else    ", _
               "Keyword_if      ", _
               "Keyword_print   ", _
               "Keyword_putc    ", _
               "Keyword_while   ", _
               "Op_multiply     ", _
               "Op_divide       ", _
               "Op_mod          ", _
               "Op_add          ", _
               "Op_subtract     ", _
               "Op_negate       ", _
               "Op_less         ", _
               "Op_lessequal    ", _
               "Op_greater      ", _
               "Op_greaterequal ", _
               "Op_equal        ", _
               "Op_notequal     ", _
               "Op_not          ", _
               "Op_assign       ", _
               "Op_and          ", _
               "Op_or           ", _
               "LeftParen       ", _
               "RightParen      ", _
               "LeftBrace       ", _
               "RightBrace      ", _
               "Semicolon       ", _
               "Comma           ", _
               "Identifier      ", _
               "Integer         ", _
               "String          ", _
               "End_of_input    " /

  nm = names(tokno)
  for (j = 0; j < 16; j = j + 1)
    str(i + j) = nm(1 + j : 1 + j)
end

subroutine intstr (str, i, n, x)

  # Convert a positive integer to a substring.

  implicit none

  character str(*)              # Destination string.
  integer i, n                  # Index and length of the field.
  integer x                     # The positive integer to represent.

  integer j
  integer y

  if (x == 0)
    {
      for (j = 0; j < n - 1; j = j + 1)
        str(i + j) = ' '
      str(i + j) = '0'
    }
  else
    {
      y = x
      for (j = n - 1; 0 <= j; j = j - 1)
        {
          if (y == 0)
            str(i + j) = ' '
          else
            {
              str(i + j) = char (mod (y, 10) + ichar ('0'))
              y = y / 10
            }
        }
    }
end

subroutine prttok (strngs, tok)

  # Print a token.

  implicit none

  character strngs(STRNSZ)      # String pool.
  integer tok(TOKSZ)            # The token.

  integer trimrt

  character line(OUTLSZ)
  character*20 fmt
  integer i, n
  integer tokno

  for (i = 1; i <= OUTLSZ; i = i + 1)
    line(i) = ' '

  call intstr (line, 1, 10, tok(ILINNO))
  call intstr (line, 12, 10, tok(ICOLNO))

  tokno = tok(ITOKNO)
  call toknam (tokno, line, 25)
  if (tokno == TKID || tokno == TKINT || tokno == TKSTR)
    {
      i = tok(IARGIX)
      n = tok(IARGLN)
      call cpystr (strngs, i, n, line, 45)
    }

  n = trimrt (line, OUTLSZ)
  write (fmt, '(''('', I10, ''A)'')') n
  write (*, fmt) (line(i), i = 1, n)
end

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

subroutine wrtpos (ln, cn)

  implicit none

  integer ln, cn

  write (*, 1000) ln, cn
1000 format ('At line ', I5, ', column ' I5)
end

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

subroutine utcmnt (ln, cn)

  implicit none

  integer ln, cn

  call wrtpos (ln, cn)
  write (*, '(''Unterminated comment'')')
  stop
end

subroutine skpcmt (line, linno, colno, pushbk, npshbk, ln, cn)

  # Skip to the end of a comment.

  implicit none

  character line(LINESZ)        # Input buffer.
  integer linno, colno          # Current line and column numbers.
  integer pushbk(CHRSZ, PSHBSZ) # Pushback buffer.
  integer npshbk                # Number of characters pushed back.
  integer ln, cn                # Line and column of start of comment.

  integer chr(CHRSZ)
  logical done

  done = .false.
  while (!done)
    {
      call getchr (line, linno, colno, pushbk, npshbk, chr)
      if (chr(ICHRCD) == ichar ('*'))
        {
          call getchr (line, linno, colno, pushbk, npshbk, chr)
          if (chr(ICHRCD) == ichar ('/'))
            done = .true.
          else if (chr(ICHRCD) == EOF)
            call utcmnt (ln, cn)
        }
      else if (chr(ICHRCD) == EOF)
        call utcmnt (ln, cn)
    }
end

subroutine skpspc (line, linno, colno, pushbk, npshbk)

  # Skip spaces and comments.

  implicit none

  character line(LINESZ)        # Input buffer.
  integer linno, colno          # Current line and column numbers.
  integer pushbk(CHRSZ, PSHBSZ) # Pushback buffer.
  integer npshbk                # Number of characters pushed back.

  logical isspc

  integer chr(CHRSZ)
  integer chr1(CHRSZ)
  integer ln, cn
  logical done

  done = .false.
  while (!done)
    {
      call getchr (line, linno, colno, pushbk, npshbk, chr)
      if (!isspc (chr(ICHRCD)))
        {
          if (chr(ICHRCD) != ichar ('/'))
            {
              call pshchr (pushbk, npshbk, chr)
              done = .true.
            }
          else
            {
              call getchr (line, linno, colno, pushbk, npshbk, chr1)
              if (chr1(ICHRCD) != ichar ('*'))
                {
                  call pshchr (pushbk, npshbk, chr1)
                  call pshchr (pushbk, npshbk, chr)
                  done = .true.
                }
              else
                {
                  ln = chr(ILINNO)
                  cn = chr(ICOLNO)
                  call skpcmt (line, linno, colno, pushbk, npshbk, _
                               ln, cn)
                }
            }
        }
    }
end

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

subroutine rwdlkp (strngs, istrng, src, i0, n0, ln, cn, tok)

  # Reserved word lookup

  implicit none

  character strngs(STRNSZ)      # String pool.
  integer istrng                # String pool's next slot.
  character src(*)              # The source string.
  integer i0, n0                # Index and length of the substring.
  integer ln, cn                # Line and column number
                                #   to associate with the token.
  integer tok(TOKSZ)            # The output token.

  integer tokno
  integer i, n

  tokno = TKID

  if (n0 == 2)
    {
      if (src(i0) == 'i' && src(i0 + 1) == 'f')
        tokno = TKIF
    }
  else if (n0 == 4)
    {
      if (src(i0) == 'e' && src(i0 + 1) == 'l' _
            && src(i0 + 2) == 's' && src(i0 + 3) == 'e')
        tokno = TKELSE
      else if (src(i0) == 'p' && src(i0 + 1) == 'u' _
                 && src(i0 + 2) == 't' && src(i0 + 3) == 'c')
        tokno = TKPUTC
    }
  else if (n0 == 5)
    {
      if (src(i0) == 'p' && src(i0 + 1) == 'r' _
            && src(i0 + 2) == 'i' && src(i0 + 3) == 'n' _
            && src(i0 + 4) == 't')
        tokno = TKPRNT
      else if (src(i0) == 'w' && src(i0 + 1) == 'h' _
                 && src(i0 + 2) == 'i' && src(i0 + 3) == 'l' _
                 && src(i0 + 4) == 'e')
        tokno = TKWHIL
    }

  i = 0
  n = 0
  if (tokno == TKID)
    call addstr (strngs, istrng, src, i0, n0, i, n)

  tok(ITOKNO) = tokno
  tok(IARGIX) = i
  tok(IARGLN) = n
  tok(ILINNO) = ln
  tok(ICOLNO) = cn
end

subroutine scnwrd (line, linno, colno, pushbk, npshbk, ln, cn, buf, n)

  # Scan characters that may represent an identifier, reserved word,
  # or integer literal.

  implicit none

  character line(LINESZ)        # Input buffer.
  integer linno, colno          # Current line and column numbers.
  integer pushbk(CHRSZ, PSHBSZ) # Pushback buffer.
  integer npshbk                # Number of characters pushed back.
  integer ln, cn                # Line and column number of the start.
  character buf(LINESZ)         # The output buffer.
  integer n                     # The length of the string collected.

  logical isid1

  integer chr(CHRSZ)

  n = 0
  call getchr (line, linno, colno, pushbk, npshbk, chr)
  ln = chr(ILINNO)
  cn = chr(ICOLNO)
  while (isid1 (chr(ICHRCD)))
    {
      n = n + 1
      buf(n) = char (chr(ICHRCD))
      call getchr (line, linno, colno, pushbk, npshbk, chr)
    }
  call pshchr (pushbk, npshbk, chr)
end

subroutine scnidr (strngs, istrng, _
                   line, linno, colno, pushbk, npshbk, _
                   tok)

  # Scan an identifier or reserved word.

  implicit none

  character strngs(STRNSZ)      # String pool.
  integer istrng                # String pool's next slot.
  character line(LINESZ)        # Input buffer.
  integer linno, colno          # Current line and column numbers.
  integer pushbk(CHRSZ, PSHBSZ) # Pushback buffer.
  integer npshbk                # Number of characters pushed back.
  integer ln, cn                # Line and column number of the start.
  integer tok(TOKSZ)            # The output token.

  character buf(LINESZ)
  integer n

  call scnwrd (line, linno, colno, pushbk, npshbk, ln, cn, buf, n)
  call rwdlkp (strngs, istrng, buf, 1, n, ln, cn, tok)
end

subroutine scnint (strngs, istrng, _
                   line, linno, colno, pushbk, npshbk, _
                   tok)

  # Scan a positive integer literal.

  implicit none

  character strngs(STRNSZ)      # String pool.
  integer istrng                # String pool's next slot.
  character line(LINESZ)        # Input buffer.
  integer linno, colno          # Current line and column numbers.
  integer pushbk(CHRSZ, PSHBSZ) # Pushback buffer.
  integer npshbk                # Number of characters pushed back.
  integer ln, cn                # Line and column number of the start.
  integer tok(TOKSZ)            # The output token.

  logical isdgt

  character buf(LINESZ)
  integer n0, n
  integer i, j, k
  character*80 fmt

  call scnwrd (line, linno, colno, pushbk, npshbk, ln, cn, buf, n0)
  for (j = 1; j <= n0; j = j + 1)
    if (!isdgt (ichar (buf(j))))
      {
        call wrtpos (ln, cn)
        write (fmt, 1000) n0
1000    format ('(''Not a legal word: "''', I10, 'A, ''"'')')
        write (*, fmt) (buf(k), k = 1, n0)
        stop
      }

  call addstr (strngs, istrng, buf, 1, n0, i, n)

  tok(ITOKNO) = TKINT
  tok(IARGIX) = i
  tok(IARGLN) = n
  tok(ILINNO) = ln
  tok(ICOLNO) = cn
end

subroutine utclit (ln, cn)

  implicit none

  integer ln, cn

  call wrtpos (ln, cn)
  write (*, '(''Unterminated character literal'')')
  stop
end

subroutine scnch1 (strngs, istrng, _
                   line, linno, colno, pushbk, npshbk, _
                   tok)

  # Scan a character literal, without yet checking that the literal
  # ends correctly.

  implicit none

  character strngs(STRNSZ)      # String pool.
  integer istrng                # String pool's next slot.
  character line(LINESZ)        # Input buffer.
  integer linno, colno          # Current line and column numbers.
  integer pushbk(CHRSZ, PSHBSZ) # Pushback buffer.
  integer npshbk                # Number of characters pushed back.
  integer tok(TOKSZ)            # The output token.

  integer trimlf

  integer bufsz
  parameter (bufsz = 40)

  integer chr(CHRSZ)
  integer chr1(CHRSZ)
  integer chr2(CHRSZ)
  integer ln, cn
  character buf(bufsz)
  integer i, j, n

  # Refetch the opening quote.
  call getchr (line, linno, colno, pushbk, npshbk, chr)
  ln = chr(ILINNO)
  cn = chr(ICOLNO)

  tok(ITOKNO) = TKINT
  tok(ILINNO) = ln
  tok(ICOLNO) = cn

  call getchr (line, linno, colno, pushbk, npshbk, chr1)
  if (chr1(ICHRCD) == EOF)
    call utclit (ln, cn)
  if (chr1(ICHRCD) == BACKSL)
    {
      call getchr (line, linno, colno, pushbk, npshbk, chr2)
      if (chr2(ICHRCD) == EOF)
        call utclit (ln, cn)
      else if (chr2(ICHRCD) == ichar ('n'))
        {
          tok(IARGIX) = LOC10   # "10" = code for Unix newline
          tok(IARGLN) = 2
        }
      else if (chr2(ICHRCD) == BACKSL)
        {
          tok(IARGIX) = LOC92   # "92" = code for backslash
          tok(IARGLN) = 2
        }
      else
        {
          call wrtpos (ln, cn)
          write (*, '(''Unsupported escape: '', 1A)') _
                char (chr2(ICHRCD))
          stop
        }
    }
  else
    {
      # Character codes are non-negative, so we can use intstr.
      call intstr (buf, 1, bufsz, chr1(ICHRCD))

      j = trimlf (buf, bufsz)
      call addstr (strngs, istrng, buf, j, bufsz - (j - 1), i, n)
      tok(IARGIX) = i
      tok(IARGLN) = n
    }
end

subroutine scnch (strngs, istrng, _
                  line, linno, colno, pushbk, npshbk, _
                  tok)

  # Scan a character literal.

  implicit none

  character strngs(STRNSZ)      # String pool.
  integer istrng                # String pool's next slot.
  character line(LINESZ)        # Input buffer.
  integer linno, colno          # Current line and column numbers.
  integer pushbk(CHRSZ, PSHBSZ) # Pushback buffer.
  integer npshbk                # Number of characters pushed back.
  integer tok(TOKSZ)            # The output token.

  integer ln, cn
  integer chr(CHRSZ)

  call getpos (line, linno, colno, pushbk, npshbk, ln, cn)
  call scnch1 (strngs, istrng, _
               line, linno, colno, pushbk, npshbk, _
               tok)
  call getchr (line, linno, colno, pushbk, npshbk, chr)
  if (chr(ICHRCD) != ichar (''''))
    {
      while (.true.)
        {
          if (chr(ICHRCD) == EOF)
            {
              call utclit (ln, cn)
              stop
            }
          else if (chr(ICHRCD) == ichar (''''))
            {
              call wrtpos (ln, cn)
              write (*, '(''Unsupported multicharacter literal'')')
              stop
            }
          call getchr (line, linno, colno, pushbk, npshbk, chr)
        }
    }
end

subroutine scnstr (strngs, istrng, _
                   line, linno, colno, pushbk, npshbk, _
                   tok)

  # Scan a string literal.

  implicit none

  character strngs(STRNSZ)      # String pool.
  integer istrng                # String pool's next slot.
  character line(LINESZ)        # Input buffer.
  integer linno, colno          # Current line and column numbers.
  integer pushbk(CHRSZ, PSHBSZ) # Pushback buffer.
  integer npshbk                # Number of characters pushed back.
  integer tok(TOKSZ)            # The output token.

  integer ln, cn
  integer chr1(CHRSZ)
  integer chr2(CHRSZ)
  character buf(LINESZ + 10)  # Enough space, with some room to spare.
  integer n0
  integer i, n

  call getchr (line, linno, colno, pushbk, npshbk, chr1)
  ln = chr1(ILINNO)
  cn = chr1(ICOLNO)

  tok(ITOKNO) = TKSTR
  tok(ILINNO) = ln
  tok(ICOLNO) = cn

  n0 = 1
  buf(n0) = '"'

  call getchr (line, linno, colno, pushbk, npshbk, chr1)
  while (chr1(ICHRCD) != ichar ('"'))
    {
      # Our input method always puts a NEWLIN before EOF, and so this
      # test is redundant, unless someone changes the input method.
      if (chr1(ICHRCD) == EOF || chr1(ICHRCD) == NEWLIN)
        {
          call wrtpos (ln, cn)
          write (*, '(''Unterminated string literal'')')
          stop
        }
      if (chr1(ICHRCD) == BACKSL)
        {
          call getchr (line, linno, colno, pushbk, npshbk, chr2)
          if (chr2(ICHRCD) == ichar ('n'))
            {
              n0 = n0 + 1
              buf(n0) = char (BACKSL)
              n0 = n0 + 1
              buf(n0) = 'n'
            }
          else if (chr2(ICHRCD) == BACKSL)
            {
              n0 = n0 + 1
              buf(n0) = char (BACKSL)
              n0 = n0 + 1
              buf(n0) = char (BACKSL)
            }
          else
            {
              call wrtpos (chr1(ILINNO), chr1(ICOLNO))
              write (*, '(''Unsupported escape sequence'')')
              stop
            }
        }
      else
        {
          n0 = n0 + 1
          buf(n0) = char (chr1(ICHRCD))
        }
      call getchr (line, linno, colno, pushbk, npshbk, chr1)
    }
  n0 = n0 + 1
  buf(n0) = '"'

  call addstr (strngs, istrng, buf, 1, n0, i, n)
  tok(IARGIX) = i
  tok(IARGLN) = n
end

subroutine unxchr (chr)

  implicit none

  integer chr(CHRSZ)

  call wrtpos (chr(ILINNO), chr(ICOLNO))
  write (*, 1000) char (chr(ICHRCD))
1000 format ('Unexpected character ''', A1, '''')
  stop
end

subroutine scntok (strngs, istrng, _
                   line, linno, colno, pushbk, npshbk, _
                   tok)

  # Scan a token.

  implicit none

  character strngs(STRNSZ)      # String pool.
  integer istrng                # String pool's next slot.
  character line(LINESZ)        # Input buffer.
  integer linno, colno          # Current line and column numbers.
  integer pushbk(CHRSZ, PSHBSZ) # Pushback buffer.
  integer npshbk                # Number of characters pushed back.
  integer tok(TOKSZ)            # The output token.

  logical isdgt
  logical isid0

  integer chr(CHRSZ)
  integer chr1(CHRSZ)
  integer ln, cn

  call getchr (line, linno, colno, pushbk, npshbk, chr)
  ln = chr(ILINNO)
  cn = chr(ICOLNO)
  tok(ILINNO) = ln
  tok(ICOLNO) = cn
  tok(IARGIX) = 0
  tok(IARGLN) = 0
  if (chr(ICHRCD) == ichar (','))
    tok(ITOKNO) = TKCMMA
  else if (chr(ICHRCD) == ichar (';'))
    tok(ITOKNO) = TKSEMI
  else if (chr(ICHRCD) == ichar ('('))
    tok(ITOKNO) = TKLPAR
  else if (chr(ICHRCD) == ichar (')'))
    tok(ITOKNO) = TKRPAR
  else if (chr(ICHRCD) == ichar ('{'))
    tok(ITOKNO) = TKLBRC
  else if (chr(ICHRCD) == ichar ('}'))
    tok(ITOKNO) = TKRBRC
  else if (chr(ICHRCD) == ichar ('*'))
    tok(ITOKNO) = TKMUL
  else if (chr(ICHRCD) == ichar ('/'))
    tok(ITOKNO) = TKDIV
  else if (chr(ICHRCD) == ichar ('%'))
    tok(ITOKNO) = TKMOD
  else if (chr(ICHRCD) == ichar ('+'))
    tok(ITOKNO) = TKADD
  else if (chr(ICHRCD) == ichar ('-'))
    tok(ITOKNO) = TKSUB
  else if (chr(ICHRCD) == ichar ('<'))
    {
      call getchr (line, linno, colno, pushbk, npshbk, chr1)
      if (chr1(ICHRCD) == ichar ('='))
        tok(ITOKNO) = TKLE
      else
        {
          call pshchr (pushbk, npshbk, chr1)
          tok(ITOKNO) = TKLT
        }
    }
  else if (chr(ICHRCD) == ichar ('>'))
    {
      call getchr (line, linno, colno, pushbk, npshbk, chr1)
      if (chr1(ICHRCD) == ichar ('='))
        tok(ITOKNO) = TKGE
      else
        {
          call pshchr (pushbk, npshbk, chr1)
          tok(ITOKNO) = TKGT
        }
    }
  else if (chr(ICHRCD) == ichar ('='))
    {
      call getchr (line, linno, colno, pushbk, npshbk, chr1)
      if (chr1(ICHRCD) == ichar ('='))
        tok(ITOKNO) = TKEQ
      else
        {
          call pshchr (pushbk, npshbk, chr1)
          tok(ITOKNO) = TKASGN
        }
    }
  else if (chr(ICHRCD) == ichar ('!'))
    {
      call getchr (line, linno, colno, pushbk, npshbk, chr1)
      if (chr1(ICHRCD) == ichar ('='))
        tok(ITOKNO) = TKNE
      else
        {
          call pshchr (pushbk, npshbk, chr1)
          tok(ITOKNO) = TKNOT
        }
    }
  else if (chr(ICHRCD) == ichar ('&'))
    {
      call getchr (line, linno, colno, pushbk, npshbk, chr1)
      if (chr1(ICHRCD) == ichar ('&'))
        tok(ITOKNO) = TKAND
      else
        call unxchr (chr)
    }
  else if (chr(ICHRCD) == ichar ('|'))
    {
      call getchr (line, linno, colno, pushbk, npshbk, chr1)
      if (chr1(ICHRCD) == ichar ('|'))
        tok(ITOKNO) = TKOR
      else
        call unxchr (chr)
    }
  else if (chr(ICHRCD) == ichar ('"'))
    {
      call pshchr (pushbk, npshbk, chr)
      call scnstr (strngs, istrng, _
                   line, linno, colno, pushbk, npshbk, _
                   tok)
    }
  else if (chr(ICHRCD) == ichar (''''))
    {
      call pshchr (pushbk, npshbk, chr)
      call scnch (strngs, istrng, _
                  line, linno, colno, pushbk, npshbk, _
                  tok)
    }
  else if (isdgt (chr(ICHRCD)))
    {
      call pshchr (pushbk, npshbk, chr)
      call scnint (strngs, istrng, _
                   line, linno, colno, pushbk, npshbk, _
                   tok)
    }
  else if (isid0 (chr(ICHRCD)))
    {
      call pshchr (pushbk, npshbk, chr)
      call scnidr (strngs, istrng, _
                   line, linno, colno, pushbk, npshbk, _
                   tok)
    }
  else
    call unxchr (chr)
end

subroutine scntxt (strngs, istrng, _
                   line, linno, colno, pushbk, npshbk)

  # Scan the text and print the token stream.

  implicit none

  character strngs(STRNSZ)      # String pool.
  integer istrng                # String pool's next slot.
  character line(LINESZ)        # Input buffer.
  integer linno, colno          # Current line and column numbers.
  integer pushbk(CHRSZ, PSHBSZ) # Pushback buffer.
  integer npshbk                # Number of characters pushed back.

  integer chr(CHRSZ)
  integer tok(TOKSZ)

  chr(ICHRCD) = ichar ('x')
  while (chr(ICHRCD) != EOF)
    {
      call skpspc (line, linno, colno, pushbk, npshbk)
      call getchr (line, linno, colno, pushbk, npshbk, chr)
      if (chr(ICHRCD) != EOF)
        {
          call pshchr (pushbk, npshbk, chr)
          call scntok (strngs, istrng, _
                       line, linno, colno, pushbk, npshbk, _
                       tok)
          call prttok (strngs, tok)
        }
    }
  tok(ITOKNO) = TKEOI
  tok(ILINNO) = chr(ILINNO)
  tok(ICOLNO) = chr(ICOLNO)
  tok(IARGIX) = 0
  tok(IARGLN) = 0
  call prttok (strngs, tok)
end

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

program lex

  implicit none

  character strngs(STRNSZ)      # String pool.
  integer istrng                # String pool's next slot.
  character line(LINESZ)        # Input buffer.
  integer linno, colno          # Current line and column numbers.
  integer pushbk(CHRSZ, PSHBSZ) # Pushback buffer.
  integer npshbk                # Number of characters pushed back.

  integer i, n

  istrng = 1

  # Locate "10" (newline) at 1 in the string pool.
  line(1) = '1'
  line(2) = '0'
  call addstr (strngs, istrng, line, 1, 2, i, n)
  if (i != 1 && n != 2)
    {
      write (*, '(''internal error'')')
      stop
    }

  # Locate "92" (backslash) at 3 in the string pool.
  line(1) = '9'
  line(2) = '2'
  call addstr (strngs, istrng, line, 1, 2, i, n)
  if (i != 3 && n != 2)
    {
      write (*, '(''internal error'')')
      stop
    }

  linno = 0
  colno = LINESZ + 1            # This will trigger a READ.
  npshbk = 0

  call scntxt (strngs, istrng, line, linno, colno, pushbk, npshbk)
end

######################################################################


package xyz.hyperreal.rosettacodeCompiler

import scala.io.Source
import scala.util.matching.Regex

object LexicalAnalyzer {
  private val EOT = '\u0004'

  val symbols =
    Map(
      "*"  -> "Op_multiply",
      "/"  -> "Op_divide",
      "%"  -> "Op_mod",
      "+"  -> "Op_add",
      "-"  -> "Op_minus",
      "<"  -> "Op_less",
      "<=" -> "Op_lessequal",
      ">"  -> "Op_greater",
      ">=" -> "Op_greaterequal",
      "==" -> "Op_equal",
      "!=" -> "Op_notequal",
      "!"  -> "Op_not",
      "="  -> "Op_assign",
      "&&" -> "Op_and",
      "¦¦" -> "Op_or",
      "("  -> "LeftParen",
      ")"  -> "RightParen",
      "{"  -> "LeftBrace",
      "}"  -> "RightBrace",
      ";"  -> "Semicolon",
      ","  -> "Comma"
    )

  val keywords =
    Map(
      "if"    -> "Keyword_if",
      "else"  -> "Keyword_else",
      "while" -> "Keyword_while",
      "print" -> "Keyword_print",
      "putc"  -> "Keyword_putc"
    )
  val alpha        = ('a' to 'z' toSet) ++ ('A' to 'Z')
  val numeric      = '0' to '9' toSet
  val alphanumeric = alpha ++ numeric
  val identifiers  = StartRestToken("Identifier", alpha + '_', alphanumeric + '_')
  val integers     = SimpleToken("Integer", numeric, alpha, "alpha characters may not follow right after a number")

  val characters =
    DelimitedToken("Integer",
                   '\'',
                   "[^'\\n]|\\\\n|\\\\\\\\" r,
                   "invalid character literal",
                   "unclosed character literal")

  val strings =
    DelimitedToken("String", '"', "[^\"\\n]*" r, "invalid string literal", "unclosed string literal")

  def apply =
    new LexicalAnalyzer(4, symbols, keywords, "End_of_input", identifiers, integers, characters, strings)

  abstract class Token
  case class StartRestToken(name: String, start: Set[Char], rest: Set[Char])                       extends Token
  case class SimpleToken(name: String, chars: Set[Char], exclude: Set[Char], excludeError: String) extends Token
  case class DelimitedToken(name: String, delimiter: Char, pattern: Regex, patternError: String, unclosedError: String)
      extends Token
}

class LexicalAnalyzer(tabs: Int,
                      symbols: Map[String, String],
                      keywords: Map[String, String],
                      endOfInput: String,
                      identifier: LexicalAnalyzer.Token,
                      tokens: LexicalAnalyzer.Token*) {

  import LexicalAnalyzer._

  private val symbolStartChars = symbols.keys map (_.head) toSet
  private val symbolChars      = symbols.keys flatMap (_.toList) toSet
  private var curline: Int     = _
  private var curcol: Int      = _

  def fromStdin = fromSource(Source.stdin)

  def fromString(src: String) = fromSource(Source.fromString(src))

  def fromSource(ast: Source) = {
    curline = 1
    curcol = 1

    var s = (ast ++ Iterator(EOT)) map (new Chr(_)) toStream

    tokenize

    def token(name: String, first: Chr) = println(f"${first.line}%5d ${first.col}%6d $name")

    def value(name: String, v: String, first: Chr) = println(f"${first.line}%5d ${first.col}%6d $name%-14s $v")

    def until(c: Char) = {
      val buf = new StringBuilder

      def until: String =
        if (s.head.c == EOT || s.head.c == c)
          buf.toString
        else {
          buf += getch
          until
        }

      until
    }

    def next = s = s.tail

    def getch = {
      val c = s.head.c

      next
      c
    }

    def consume(first: Char, cs: Set[Char]) = {
      val buf = new StringBuilder

      def consume: String =
        if (s.head.c == EOT || !cs(s.head.c))
          buf.toString
        else {
          buf += getch
          consume
        }

      buf += first
      consume
    }

    def comment(start: Chr): Unit = {
      until('*')

      if (s.head.c == EOT || s.tail.head.c == EOT)
        sys.error(s"unclosed comment ${start.at}")
      else if (s.tail.head.c != '/') {
        next
        comment(start)
      } else {
        next
        next
      }
    }

    def recognize(t: Token): Option[(String, String)] = {
      val first = s

      next

      t match {
        case StartRestToken(name, start, rest) =>
          if (start(first.head.c))
            Some((name, consume(first.head.c, rest)))
          else {
            s = first
            None
          }
        case SimpleToken(name, chars, exclude, excludeError) =>
          if (chars(first.head.c)) {
            val m = consume(first.head.c, chars)

            if (exclude(s.head.c))
              sys.error(s"$excludeError ${s.head.at}")
            else
              Some((name, m))
          } else {
            s = first
            None
          }
        case DelimitedToken(name, delimiter, pattern, patternError, unclosedError) =>
          if (first.head.c == delimiter) {
            val m = until(delimiter)

            if (s.head.c != delimiter)
              sys.error(s"$unclosedError ${first.head.at}")
            else if (pattern.pattern.matcher(m).matches) {
              next
              Some((name, s"$delimiter$m$delimiter"))
            } else
              sys.error(s"$patternError ${s.head.at}")
          } else {
            s = first
            None
          }
      }
    }

    def tokenize: Unit =
      if (s.head.c == EOT)
        token(endOfInput, s.head)
      else {
        if (s.head.c.isWhitespace)
          next
        else if (s.head.c == '/' && s.tail.head.c == '*')
          comment(s.head)
        else if (symbolStartChars(s.head.c)) {
          val first = s.head
          val buf   = new StringBuilder

          while (!symbols.contains(buf.toString) && s.head.c != EOT && symbolChars(s.head.c)) buf += getch

          while (symbols.contains(buf.toString :+ s.head.c) && s.head.c != EOT && symbolChars(s.head.c)) buf += getch

          symbols get buf.toString match {
            case Some(name) => token(name, first)
            case None       => sys.error(s"unrecognized symbol: '${buf.toString}' ${first.at}")
          }
        } else {
          val first = s.head

          recognize(identifier) match {
            case None =>
              find(0)

              @scala.annotation.tailrec
              def find(t: Int): Unit =
                if (t == tokens.length)
                  sys.error(s"unrecognized character ${first.at}")
                else
                  recognize(tokens(t)) match {
                    case None            => find(t + 1)
                    case Some((name, v)) => value(name, v, first)
                  }
            case Some((name, ident)) =>
              keywords get ident match {
                case None          => value(name, ident, first)
                case Some(keyword) => token(keyword, first)
              }
          }
        }

        tokenize
      }
  }

  private class Chr(val c: Char) {
    val line = curline
    val col  = curcol

    if (c == '\n') {
      curline += 1
      curcol = 1
    } else if (c == '\r')
      curcol = 1
    else if (c == '\t')
      curcol += tabs - (curcol - 1) % tabs
    else
      curcol += 1

    def at = s"[${line}, ${col}]"

    override def toString: String = s"<$c, $line, $col>"
  }

}


[(() -> Int)] funcs
L(i) 10
   funcs.append(() -> @=i * @=i)
print(funcs[3]())


(import (scheme base)
        (scheme char)
        (scheme file)
        (scheme process-context)
        (scheme write))

(define *symbols* (list (cons #\( 'LeftParen)
                        (cons #\) 'RightParen)
                        (cons #\{ 'LeftBrace)
                        (cons #\} 'RightBrace)
                        (cons #\; 'Semicolon)
                        (cons #\, 'Comma)
                        (cons #\* 'Op_multiply)
                        (cons #\/ 'Op_divide)
                        (cons #\% 'Op_mod)
                        (cons #\+ 'Op_add)
                        (cons #\- 'Op_subtract)))

(define *keywords* (list (cons 'if 'Keyword_if)
                         (cons 'else 'Keyword_else)
                         (cons 'while 'Keyword_while)
                         (cons 'print 'Keyword_print)
                         (cons 'putc 'Keyword_putc)))

;; return list of tokens from current port
(define (read-tokens)
  ; information on position in input
  (define line 1)
  (define col 0)
  (define next-char #f)
  ; get char, updating line/col posn
  (define (get-next-char)
    (if (char? next-char) ; check for returned character
      (let ((c next-char))
        (set! next-char #f)
        c)
      (let ((c (read-char)))
        (cond ((and (not (eof-object? c))
                    (char=? c #\newline))
               (set! col 0)
               (set! line (+ 1 line))
               (get-next-char))
              (else
                (set! col (+ 1 col))
                c)))))
  (define (push-char c)
    (set! next-char c))
  ; step over any whitespace or comments
  (define (skip-whitespace+comment)
    (let loop ()
      (let ((c (get-next-char)))
        (cond ((eof-object? c)
               '())
              ((char-whitespace? c) ; ignore whitespace
               (loop))
              ((char=? c #\/) ; check for comments
               (if (char=? (peek-char) #\*) ; found start of comment
                 (begin ; eat comment
                   (get-next-char)
                   (let m ((c (get-next-char)))
                     (cond ((eof-object? c)
                            (error "End of file in comment"))
                           ((and (char=? c #\*)
                                 (char=? (peek-char) #\/))
                            (get-next-char)) ; eat / and end
                           (else
                             (m (get-next-char)))))
                   (loop)) ; continue looking for whitespace / more comments
                 (push-char #\/))) ; not comment, so put / back and return
              (else ; return to stream, as not a comment or space char
                (push-char c))))))
  ; read next token from input
  (define (next-token)
    (define (read-string) ; returns string value along with " "  marks
      (let loop ((chars '(#\"))) ; " (needed to appease Rosetta code's highlighter)
        (cond ((eof-object? (peek-char))
               (error "End of file while scanning string literal."))
              ((char=? (peek-char) #\newline)
               (error "End of line while scanning string literal."))
              ((char=? (peek-char) #\") ; "
               (get-next-char) ; consume the final quote
               (list->string (reverse (cons #\" chars)))) ; "  highlighter)
              (else
                (loop (cons (get-next-char) chars))))))
    (define (read-identifier initial-c) ; returns identifier as a Scheme symbol
      (do ((chars (list initial-c) (cons c chars))
           (c (get-next-char) (get-next-char)))
        ((or (eof-object? c) ; finish when hit end of file
             (not (or (char-numeric? c) ; or a character not permitted in an identifier
                      (char-alphabetic? c)
                      (char=? c #\_))))
         (push-char c) ; return last character to stream
         (string->symbol (list->string (reverse chars))))))
    (define (read-number initial-c) ; returns integer read as a Scheme integer
      (let loop ((res (digit-value initial-c))
                 (c (get-next-char)))
        (cond ((char-alphabetic? c)
               (error "Invalid number - ends in alphabetic chars"))
              ((char-numeric? c)
               (loop (+ (* res 10) (digit-value c))
                     (get-next-char)))
              (else
                (push-char c) ; return non-number to stream
                res))))
    ; select op symbol based on if there is a following = sign
    (define (check-eq-extend start-line start-col opeq op)
      (if (char=? (peek-char) #\=)
        (begin (get-next-char) ; consume it
               (list start-line start-col opeq))
        (list start-line start-col op)))
    ;
    (let* ((start-line line)   ; save start position of tokens
           (start-col col)
           (c (get-next-char)))
      (cond ((eof-object? c)
             (list start-line start-col 'End_of_input))
            ((char-alphabetic? c) ; read an identifier
             (let ((id (read-identifier c)))
               (if (assq id *keywords*) ; check if identifier is a keyword
                 (list start-line start-col (cdr (assq id *keywords*)))
                 (list start-line start-col 'Identifier id))))
            ((char-numeric? c) ; read a number
             (list start-line start-col 'Integer (read-number c)))
            (else
              (case c
                ((#\( #\) #\{ #\} #\; #\, #\* #\/ #\% #\+ #\-)
                 (list start-line start-col (cdr (assq c *symbols*))))
                ((#\<)
                 (check-eq-extend start-line start-col 'Op_lessequal 'Op_less))
                ((#\>)
                 (check-eq-extend start-line start-col 'Op_greaterequal 'Op_greater))
                ((#\=)
                 (check-eq-extend start-line start-col 'Op_equal 'Op_assign))
                ((#\!)
                 (check-eq-extend start-line start-col 'Op_notequal 'Op_not))
                ((#\& #\|)
                 (if (char=? (peek-char) c) ; looks for && or ||
                   (begin (get-next-char) ; consume second character if valid
                          (list start-line start-col
                                (if (char=? c #\&) 'Op_and 'Op_or)))
                   (push-char c)))
                ((#\") ; "
                 (list start-line start-col 'String (read-string)))
                ((#\')
                 (let* ((c1 (get-next-char))
                        (c2 (get-next-char)))
                   (cond ((or (eof-object? c1)
                              (eof-object? c2))
                          (error "Incomplete character constant"))
                         ((char=? c1 #\')
                          (error "Empty character constant"))
                         ((and (char=? c2 #\') ; case of single character
                               (not (char=? c1 #\\)))
                          (list start-line start-col 'Integer (char->integer c1)))
                         ((and (char=? c1 #\\) ; case of escaped character
                               (char=? (peek-char) #\'))
                          (get-next-char) ; consume the ending '
                          (cond ((char=? c2 #\n)
                                 (list start-line start-col 'Integer 10))
                                ((char=? c2 #\\)
                                 (list start-line start-col 'Integer (char->integer c2)))
                                (else
                                  (error "Unknown escape sequence"))))
                         (else
                           (error "Multi-character constant")))))
                (else
                  (error "Unrecognised character")))))))
  ;
  (let loop ((tokens '())) ; loop, ignoring space/comments, while reading tokens
    (skip-whitespace+comment)
    (let ((tok (next-token)))
      (if (eof-object? (peek-char)) ; check if at end of input
        (reverse (cons tok tokens))
        (loop (cons tok tokens))))))

(define (lexer filename)
  (with-input-from-file filename
                        (lambda () (read-tokens))))

;; output tokens to stdout, tab separated
;; line number, column number, token type, optional value
(define (display-tokens tokens)
  (for-each
    (lambda (token)
      (display (list-ref token 0))
      (display #\tab) (display (list-ref token 1))
      (display #\tab) (display (list-ref token 2))
      (when (= 4 (length token))
        (display #\tab) (display (list-ref token 3)))
      (newline))
    tokens))

;; read from filename passed on command line
(if (= 2 (length (command-line)))
  (display-tokens (lexer (cadr (command-line))))
  (display "Error: provide program filename\n"))


with Ada.Text_IO;

procedure Value_Capture is

   protected type Fun is -- declaration of the type of a protected object
      entry Init(Index: Natural);
      function Result return Natural;
   private
      N: Natural := 0;
   end Fun;

   protected body Fun is -- the implementation of a protected object
      entry Init(Index: Natural) when N=0 is
      begin -- after N has been set to a nonzero value, it cannot be changed any more
         N := Index;
      end Init;
      function Result return Natural is (N*N);
   end Fun;

   A: array (1 .. 10) of Fun; -- an array holding 10 protected objects

begin
   for I in A'Range loop -- initialize the protected objects
      A(I).Init(I);
   end loop;

   for I in A'First .. A'Last-1 loop -- evaluate the functions, except for the last
      Ada.Text_IO.Put(Integer'Image(A(I).Result));
   end loop;
end Value_Capture;


[1:10]PROC(BOOL)INT squares;

FOR i FROM 1 TO 10 DO
        HEAP INT captured i := i;
        squares[i] := ((REF INT by ref i, INT by val i,BOOL b)INT:(INT i = by ref i; (b|by ref i := 0); by val i*i))
                (captured i, captured i,)
OD;

FOR i FROM 1 TO 8 DO print(squares[i](i MOD 2 = 0)) OD;
print(new line);
FOR i FROM 1 TO 10 DO print(squares[i](FALSE)) OD


(*------------------------------------------------------------------*)
(* The Rosetta Code lexical analyzer, in Standard ML. Based on the ATS
   and the OCaml. The intended compiler is Mlton or Poly/ML; there is
   a tiny difference near the end of the file, depending on which
   compiler is used. *)

(*------------------------------------------------------------------*)
(* The following functions are compatible with ASCII. *)

fun
is_digit ichar =
48 <= ichar andalso ichar <= 57

fun
is_lower ichar =
97 <= ichar andalso ichar <= 122

fun
is_upper ichar =
65 <= ichar andalso ichar <= 90

fun
is_alpha ichar =
is_lower ichar orelse is_upper ichar

fun
is_alnum ichar =
is_digit ichar orelse is_alpha ichar

fun
is_ident_start ichar =
is_alpha ichar orelse ichar = 95

fun
is_ident_continuation ichar =
is_alnum ichar orelse ichar = 95

fun
is_space ichar =
ichar = 32 orelse (9 <= ichar andalso ichar <= 13)

(*------------------------------------------------------------------*)
(* Character input more like that of C. There are various advantages
   and disadvantages to this method, but key points in its favor are:
   (a) it is how character input is done in the original ATS code, (b)
   Unicode code points are 21-bit positive integers. *)

val eof = ~1

fun
input_ichar inpf =
case TextIO.input1 inpf of
    NONE => eof
  | SOME c => Char.ord c

(*------------------------------------------------------------------*)

(* The type of an input character. *)

structure Ch =
struct

type t = {
  ichar : int,
  line_no : int,
  column_no : int
}

end

(*------------------------------------------------------------------*)
(* Inputting with unlimited pushback, and with counting of lines and
   columns. *)

structure Inp =
struct

type t = {
  inpf : TextIO.instream,
  pushback : Ch.t list,
  line_no : int,
  column_no : int
}

fun
of_instream inpf =
{
  inpf = inpf,
  pushback = [],
  line_no = 1,
  column_no = 1
} : t

fun
get_ch ({ inpf = inpf,
          pushback = pushback,
          line_no = line_no,
          column_no = column_no } : t) =
case pushback of
    ch :: tail =>
    let
      val inp = { inpf = inpf,
                  pushback = tail,
                  line_no = line_no,
                  column_no = column_no }
    in
      (ch, inp)
    end
  | [] =>
    let
      val ichar = input_ichar inpf
      val ch = { ichar = ichar,
                 line_no = line_no,
                 column_no = column_no }
    in
      if ichar = Char.ord #"\n" then
        let
          val inp = { inpf = inpf,
                      pushback = [],
                      line_no = line_no + 1,
                      column_no = 1 }
        in
          (ch, inp)
        end
      else
        let
          val inp = { inpf = inpf,
                      pushback = [],
                      line_no = line_no,
                      column_no = column_no + 1 }
        in
          (ch, inp)
        end
    end

fun
push_back_ch (ch, inp : t) =
{
  inpf = #inpf inp,
  pushback = ch :: #pushback inp,
  line_no = #line_no inp,
  column_no = #column_no inp
}

end

(*------------------------------------------------------------------*)
(* Tokens, appearing in tuples with arguments, and with line and
   column numbers. The tokens are integers, so they can be used as
   array indices. *)

val token_ELSE         =  0
val token_IF           =  1
val token_PRINT        =  2
val token_PUTC         =  3
val token_WHILE        =  4
val token_MULTIPLY     =  5
val token_DIVIDE       =  6
val token_MOD          =  7
val token_ADD          =  8
val token_SUBTRACT     =  9
val token_NEGATE       = 10
val token_LESS         = 11
val token_LESSEQUAL    = 12
val token_GREATER      = 13
val token_GREATEREQUAL = 14
val token_EQUAL        = 15
val token_NOTEQUAL     = 16
val token_NOT          = 17
val token_ASSIGN       = 18
val token_AND          = 19
val token_OR           = 20
val token_LEFTPAREN    = 21
val token_RIGHTPAREN   = 22
val token_LEFTBRACE    = 23
val token_RIGHTBRACE   = 24
val token_SEMICOLON    = 25
val token_COMMA        = 26
val token_IDENTIFIER   = 27
val token_INTEGER      = 28
val token_STRING       = 29
val token_END_OF_INPUT = 30

(* A *very* simple perfect hash for the reserved words. (Yes, this is
   overkill, except for demonstration of the principle.) *)

val reserved_words =
    Vector.fromList ["if", "print", "else",
                     "", "putc", "",
                     "", "while", ""]
val reserved_word_tokens =
    Vector.fromList [token_IF, token_PRINT, token_ELSE,
                     token_IDENTIFIER, token_PUTC, token_IDENTIFIER,
                     token_IDENTIFIER, token_WHILE, token_IDENTIFIER]

fun
reserved_word_lookup (s, line_no, column_no) =
if (String.size s) < 2 then
  (token_IDENTIFIER, s, line_no, column_no)
else
  let
    val hashval =
        (Char.ord (String.sub (s, 0)) +
         Char.ord (String.sub (s, 1)))
        mod 9
    val token = Vector.sub (reserved_word_tokens, hashval)
  in
    if token = token_IDENTIFIER orelse
       s <> Vector.sub (reserved_words, hashval) then
      (token_IDENTIFIER, s, line_no, column_no)
    else
      (token, s, line_no, column_no)
  end

(* Token to string lookup. *)

val token_names =
    Vector.fromList
      ["Keyword_else",
       "Keyword_if",
       "Keyword_print",
       "Keyword_putc",
       "Keyword_while",
       "Op_multiply",
       "Op_divide",
       "Op_mod",
       "Op_add",
       "Op_subtract",
       "Op_negate",
       "Op_less",
       "Op_lessequal",
       "Op_greater",
       "Op_greaterequal",
       "Op_equal",
       "Op_notequal",
       "Op_not",
       "Op_assign",
       "Op_and",
       "Op_or",
       "LeftParen",
       "RightParen",
       "LeftBrace",
       "RightBrace",
       "Semicolon",
       "Comma",
       "Identifier",
       "Integer",
       "String",
       "End_of_input"]

fun
token_name token =
  Vector.sub (token_names, token)

(*------------------------------------------------------------------*)

exception Unterminated_comment of int * int
exception Unterminated_character_literal of int * int
exception Multicharacter_literal of int * int
exception End_of_input_in_string_literal of int * int
exception End_of_line_in_string_literal of int * int
exception Unsupported_escape of int * int * char
exception Invalid_integer_literal of int * int * string
exception Unexpected_character of int * int * char

(*------------------------------------------------------------------*)
(* Skipping past spaces and comments. (In the Rosetta Code tiny
   language, a comment, if you think about it, is a kind of space.) *)

fun
scan_comment (inp, line_no, column_no) =
let
  fun
  loop inp =
  let
    val (ch, inp) = Inp.get_ch inp
  in
    if #ichar ch = eof then
      raise Unterminated_comment (line_no, column_no)
    else if #ichar ch = Char.ord #"*" then
      let
        val (ch1, inp) = Inp.get_ch inp
      in
        if #ichar ch1 = eof then
          raise Unterminated_comment (line_no, column_no)
        else if #ichar ch1 = Char.ord #"/" then
          inp
        else
          loop inp
      end
    else
      loop inp
  end
in
  loop inp
end

fun
skip_spaces_and_comments inp =
let
  fun
  loop inp =
  let
    val (ch, inp) = Inp.get_ch inp
  in
    if is_space (#ichar ch) then
      loop inp
    else if #ichar ch = Char.ord #"/" then
      let
        val (ch1, inp) = Inp.get_ch inp
      in
        if #ichar ch1 = Char.ord #"*" then
          loop (scan_comment (inp, #line_no ch, #column_no ch))
        else
          let
            val inp = Inp.push_back_ch (ch1, inp)
            val inp = Inp.push_back_ch (ch, inp)
          in
            inp
          end
      end
    else
      Inp.push_back_ch (ch, inp)
  end
in
  loop inp
end

(*------------------------------------------------------------------*)
(* Integer literals, identifiers, and reserved words. *)

fun
scan_word (lst, inp) =
let
  val (ch, inp) = Inp.get_ch inp
in
  if is_ident_continuation (#ichar ch) then
    scan_word (Char.chr (#ichar ch) :: lst, inp)
  else
    (lst, Inp.push_back_ch (ch, inp))
end

fun
scan_integer_literal inp =
let
  val (ch, inp) = Inp.get_ch inp
  val (lst, inp) = scan_word ([Char.chr (#ichar ch)], inp)
  val s = String.implode (List.rev lst)
in
  if List.all (fn c => is_digit (Char.ord c)) lst then
    ((token_INTEGER, s, #line_no ch, #column_no ch), inp)
  else
    raise Invalid_integer_literal (#line_no ch, #column_no ch, s)
end

fun
scan_identifier_or_reserved_word inp =
let
  val (ch, inp) = Inp.get_ch inp
  val (lst, inp) = scan_word ([Char.chr (#ichar ch)], inp)
  val s = String.implode (List.rev lst)
  val toktup = reserved_word_lookup (s, #line_no ch, #column_no ch)
in
  (toktup, inp)
end

(*------------------------------------------------------------------*)
(* String literals. *)

fun
scan_string_literal inp =
let
  val (ch, inp) = Inp.get_ch inp

  fun
  scan (lst, inp) =
  let
    val (ch1, inp) = Inp.get_ch inp
  in
    if #ichar ch1 = eof then
      raise End_of_input_in_string_literal
            (#line_no ch, #column_no ch)
    else if #ichar ch1 = Char.ord #"\n" then
      raise End_of_line_in_string_literal
            (#line_no ch, #column_no ch)
    else if #ichar ch1 = Char.ord #"\"" then
      (lst, inp)
    else if #ichar ch1 <> Char.ord #"\\" then
      scan (Char.chr (#ichar ch1) :: lst, inp)
    else
      let
        val (ch2, inp) = Inp.get_ch inp
      in
        if #ichar ch2 = Char.ord #"n" then
          scan (#"n" :: #"\\" :: lst, inp)
        else if #ichar ch2 = Char.ord #"\\" then
          scan (#"\\" :: #"\\" :: lst, inp)
        else if #ichar ch2 = eof then
          raise End_of_input_in_string_literal
                (#line_no ch, #column_no ch)
        else if #ichar ch2 = Char.ord #"\n" then
          raise End_of_line_in_string_literal
                (#line_no ch, #column_no ch)
        else
          raise Unsupported_escape (#line_no ch1, #column_no ch1,
                                    Char.chr (#ichar ch2))
      end
  end

  val lst = #"\"" :: []
  val (lst, inp) = scan (lst, inp)
  val lst = #"\"" :: lst
  val s = String.implode (List.rev lst)
in
  ((token_STRING, s, #line_no ch, #column_no ch), inp)
end

(*------------------------------------------------------------------*)
(* Character literals. *)

fun
scan_character_literal_without_checking_end inp =
let
  val (ch, inp) = Inp.get_ch inp
  val (ch1, inp) = Inp.get_ch inp
in
  if #ichar ch1 = eof then
    raise Unterminated_character_literal
          (#line_no ch, #column_no ch)
  else if #ichar ch1 = Char.ord #"\\" then
    let
      val (ch2, inp) = Inp.get_ch inp
    in
      if #ichar ch2 = eof then
        raise Unterminated_character_literal
              (#line_no ch, #column_no ch)
      else if #ichar ch2 = Char.ord #"n" then
        let
          val s = Int.toString (Char.ord #"\n")
        in
          ((token_INTEGER, s, #line_no ch, #column_no ch), inp)
        end
      else if #ichar ch2 = Char.ord #"\\" then
        let
          val s = Int.toString (Char.ord #"\\")
        in
          ((token_INTEGER, s, #line_no ch, #column_no ch), inp)
        end
      else
        raise Unsupported_escape (#line_no ch1, #column_no ch1,
                                  Char.chr (#ichar ch2))
    end
  else
    let
      val s = Int.toString (#ichar ch1)
    in
      ((token_INTEGER, s, #line_no ch, #column_no ch), inp)
    end
end

fun
scan_character_literal inp =
let
  val (toktup, inp) =
      scan_character_literal_without_checking_end inp
  val (_, _, line_no, column_no) = toktup

  fun
  check_end inp =
  let
    val (ch, inp) = Inp.get_ch inp
  in
    if #ichar ch = Char.ord #"'" then
      inp
    else
      let
        fun
        loop_to_end (ch1 : Ch.t, inp) =
        if #ichar ch1 = eof then
          raise Unterminated_character_literal (line_no, column_no)
        else if #ichar ch1 = Char.ord #"'" then
          raise Multicharacter_literal (line_no, column_no)
        else
          let
            val (ch1, inp) = Inp.get_ch inp
          in
            loop_to_end (ch1, inp)
          end
      in
        loop_to_end (ch, inp)
      end
  end

  val inp = check_end inp
in
  (toktup, inp)
end

(*------------------------------------------------------------------*)

fun
get_next_token inp =
let
  val inp = skip_spaces_and_comments inp
  val (ch, inp) = Inp.get_ch inp
  val ln = #line_no ch
  val cn = #column_no ch
in
  if #ichar ch = eof then
    ((token_END_OF_INPUT, "", ln, cn), inp)
  else
    case Char.chr (#ichar ch) of
        #"," => ((token_COMMA, ",", ln, cn), inp)
      | #";" => ((token_SEMICOLON, ";", ln, cn), inp)
      | #"(" => ((token_LEFTPAREN, "(", ln, cn), inp)
      | #")" => ((token_RIGHTPAREN, ")", ln, cn), inp)
      | #"{" => ((token_LEFTBRACE, "{", ln, cn), inp)
      | #"}" => ((token_RIGHTBRACE, "}", ln, cn), inp)
      | #"*" => ((token_MULTIPLY, "*", ln, cn), inp)
      | #"/" => ((token_DIVIDE, "/", ln, cn), inp)
      | #"%" => ((token_MOD, "%", ln, cn), inp)
      | #"+" => ((token_ADD, "+", ln, cn), inp)
      | #"-" => ((token_SUBTRACT, "-", ln, cn), inp)
      | #"<" =>
        let
          val (ch1, inp) = Inp.get_ch inp
        in
          if #ichar ch1 = Char.ord #"=" then
            ((token_LESSEQUAL, "<=", ln, cn), inp)
          else
            let
              val inp = Inp.push_back_ch (ch1, inp)
            in
              ((token_LESS, "<", ln, cn), inp)
            end
        end
      | #">" =>
        let
          val (ch1, inp) = Inp.get_ch inp
        in
          if #ichar ch1 = Char.ord #"=" then
            ((token_GREATEREQUAL, ">=", ln, cn), inp)
          else
            let
              val inp = Inp.push_back_ch (ch1, inp)
            in
              ((token_GREATER, ">", ln, cn), inp)
            end
        end
      | #"=" =>
        let
          val (ch1, inp) = Inp.get_ch inp
        in
          if #ichar ch1 = Char.ord #"=" then
            ((token_EQUAL, "==", ln, cn), inp)
          else
            let
              val inp = Inp.push_back_ch (ch1, inp)
            in
              ((token_ASSIGN, "=", ln, cn), inp)
            end
        end
      | #"!" =>
        let
          val (ch1, inp) = Inp.get_ch inp
        in
          if #ichar ch1 = Char.ord #"=" then
            ((token_NOTEQUAL, "!=", ln, cn), inp)
          else
            let
              val inp = Inp.push_back_ch (ch1, inp)
            in
              ((token_NOT, "!", ln, cn), inp)
            end
        end
      | #"&" =>
        let
          val (ch1, inp) = Inp.get_ch inp
        in
          if #ichar ch1 = Char.ord #"&" then
            ((token_AND, "&&", ln, cn), inp)
          else
            raise Unexpected_character (#line_no ch, #column_no ch,
                                        Char.chr (#ichar ch))
        end
      | #"|" =>
        let
          val (ch1, inp) = Inp.get_ch inp
        in
          if #ichar ch1 = Char.ord #"|" then
            ((token_OR, "||", ln, cn), inp)
          else
            raise Unexpected_character (#line_no ch, #column_no ch,
                                        Char.chr (#ichar ch))
        end
      | #"\"" =>
        let
          val inp = Inp.push_back_ch (ch, inp)
        in
          scan_string_literal inp
        end
      | #"'" =>
        let
          val inp = Inp.push_back_ch (ch, inp)
        in
          scan_character_literal inp
        end
      | _ =>
        if is_digit (#ichar ch) then
          let
            val inp = Inp.push_back_ch (ch, inp)
          in
            scan_integer_literal inp
          end
        else if is_ident_start (#ichar ch) then
          let
            val inp = Inp.push_back_ch (ch, inp)
          in
            scan_identifier_or_reserved_word inp
          end
        else
          raise Unexpected_character (#line_no ch, #column_no ch,
                                      Char.chr (#ichar ch))
end

fun
output_integer_rightjust (outf, num) =
(if num < 10 then
   TextIO.output (outf, "    ")
 else if num < 100 then
   TextIO.output (outf, "   ")
 else if num < 1000 then
   TextIO.output (outf, "  ")
 else if num < 10000 then
   TextIO.output (outf, " ")
 else
   ();
 TextIO.output (outf, Int.toString num))

fun
print_token (outf, toktup) =
let
  val (token, arg, line_no, column_no) = toktup
  val name = token_name token
  val (padding, str) =
      if token = token_IDENTIFIER then
        ("     ", arg)
      else if token = token_INTEGER then
        ("        ", arg)
      else if token = token_STRING then
        ("         ", arg)
      else("", "")
in
  output_integer_rightjust (outf, line_no);
  TextIO.output (outf, " ");
  output_integer_rightjust (outf, column_no);
  TextIO.output (outf, "  ");
  TextIO.output (outf, name);
  TextIO.output (outf, padding);
  TextIO.output (outf, str);
  TextIO.output (outf, "\n")
end

fun
scan_text (outf, inp) =
let
  fun
  loop inp =
  let
    val (toktup, inp) = get_next_token inp
  in
    (print_token (outf, toktup);
     let
       val (token, _, _, _) = toktup
     in
       if token <> token_END_OF_INPUT then
         loop inp
       else
         ()
     end)
  end
in
  loop inp
end

(*------------------------------------------------------------------*)

fun
main () =
let
  val args = CommandLine.arguments ()
  val (inpf_filename, outf_filename) =
      case args of
          [] => ("-", "-")
        | name :: [] => (name, "-")
        | name1 :: name2 :: _ => (name1, name2)
  val inpf =
      if inpf_filename = "-" then
        TextIO.stdIn
      else
        TextIO.openIn inpf_filename
        handle
        (IO.Io _) =>
        (TextIO.output (TextIO.stdErr, "Failure opening \"");
         TextIO.output (TextIO.stdErr, inpf_filename);
         TextIO.output (TextIO.stdErr, "\" for input\n");
         OS.Process.exit OS.Process.failure)
  val outf =
      if outf_filename = "-" then
        TextIO.stdOut
      else
        TextIO.openOut outf_filename
        handle
        (IO.Io _) =>
        (TextIO.output (TextIO.stdErr, "Failure opening \"");
         TextIO.output (TextIO.stdErr, outf_filename);
         TextIO.output (TextIO.stdErr, "\" for output\n");
         OS.Process.exit OS.Process.failure)
  val inp = Inp.of_instream inpf
in
  scan_text (outf, inp)
end
handle Unterminated_comment (line_no, column_no) =>
       (TextIO.output (TextIO.stdErr, ": unterminated comment ");
        TextIO.output (TextIO.stdErr, "starting at ");
        TextIO.output (TextIO.stdErr, Int.toString line_no);
        TextIO.output (TextIO.stdErr, ":");
        TextIO.output (TextIO.stdErr, Int.toString column_no);
        TextIO.output (TextIO.stdErr, "\n");
        OS.Process.exit OS.Process.failure)
     | Unterminated_character_literal (line_no, column_no) =>
       (TextIO.output (TextIO.stdErr, ": unterminated character ");
        TextIO.output (TextIO.stdErr, "literal starting at ");
        TextIO.output (TextIO.stdErr, Int.toString line_no);
        TextIO.output (TextIO.stdErr, ":");
        TextIO.output (TextIO.stdErr, Int.toString column_no);
        TextIO.output (TextIO.stdErr, "\n");
        OS.Process.exit OS.Process.failure)
     | Multicharacter_literal (line_no, column_no) =>
       (TextIO.output (TextIO.stdErr, ": unsupported multicharacter");
        TextIO.output (TextIO.stdErr, " literal starting at ");
        TextIO.output (TextIO.stdErr, Int.toString line_no);
        TextIO.output (TextIO.stdErr, ":");
        TextIO.output (TextIO.stdErr, Int.toString column_no);
        TextIO.output (TextIO.stdErr, "\n");
        OS.Process.exit OS.Process.failure)
     | End_of_input_in_string_literal (line_no, column_no) =>
       (TextIO.output (TextIO.stdErr, ": end of input in string");
        TextIO.output (TextIO.stdErr, " literal starting at ");
        TextIO.output (TextIO.stdErr, Int.toString line_no);
        TextIO.output (TextIO.stdErr, ":");
        TextIO.output (TextIO.stdErr, Int.toString column_no);
        TextIO.output (TextIO.stdErr, "\n");
        OS.Process.exit OS.Process.failure)
     | End_of_line_in_string_literal (line_no, column_no) =>
       (TextIO.output (TextIO.stdErr, ": end of line in string");
        TextIO.output (TextIO.stdErr, " literal starting at ");
        TextIO.output (TextIO.stdErr, Int.toString line_no);
        TextIO.output (TextIO.stdErr, ":");
        TextIO.output (TextIO.stdErr, Int.toString column_no);
        TextIO.output (TextIO.stdErr, "\n");
        OS.Process.exit OS.Process.failure)
     | Unsupported_escape (line_no, column_no, c) =>
       (TextIO.output (TextIO.stdErr, CommandLine.name ());
        TextIO.output (TextIO.stdErr, ": unsupported escape \\");
        TextIO.output (TextIO.stdErr, Char.toString c);
        TextIO.output (TextIO.stdErr, " at ");
        TextIO.output (TextIO.stdErr, Int.toString line_no);
        TextIO.output (TextIO.stdErr, ":");
        TextIO.output (TextIO.stdErr, Int.toString column_no);
        TextIO.output (TextIO.stdErr, "\n");
        OS.Process.exit OS.Process.failure)
     | Invalid_integer_literal (line_no, column_no, str) =>
       (TextIO.output (TextIO.stdErr, CommandLine.name ());
        TextIO.output (TextIO.stdErr, ": invalid integer literal ");
        TextIO.output (TextIO.stdErr, str);
        TextIO.output (TextIO.stdErr, " at ");
        TextIO.output (TextIO.stdErr, Int.toString line_no);
        TextIO.output (TextIO.stdErr, ":");
        TextIO.output (TextIO.stdErr, Int.toString column_no);
        TextIO.output (TextIO.stdErr, "\n");
        OS.Process.exit OS.Process.failure)
     | Unexpected_character (line_no, column_no, c) =>
       (TextIO.output (TextIO.stdErr, CommandLine.name ());
        TextIO.output (TextIO.stdErr, ": unexpected character '");
        TextIO.output (TextIO.stdErr, Char.toString c);
        TextIO.output (TextIO.stdErr, "' at ");
        TextIO.output (TextIO.stdErr, Int.toString line_no);
        TextIO.output (TextIO.stdErr, ":");
        TextIO.output (TextIO.stdErr, Int.toString column_no);
        TextIO.output (TextIO.stdErr, "\n");
        OS.Process.exit OS.Process.failure);

(*------------------------------------------------------------------*)
(* For the Mlton compiler, include the following. For Poly/ML, comment
   it out.  *)
main ();

(*------------------------------------------------------------------*)
(* Instructions for GNU Emacs. *)

(* local variables: *)
(* mode: sml *)
(* sml-indent-level: 2 *)
(* sml-indent-args: 2 *)
(* end: *)
(*------------------------------------------------------------------*)


fns: {n: x; {n expt 2}} map range[10]
(8 elem fns)[]


on run
    set fns to {}

    repeat with i from 1 to 10
        set end of fns to closure(i)
    end repeat

    |λ|() of item 3 of fns
end run

on closure(x)
    script
        on |λ|()
            x * x
        end |λ|
    end script
end closure


)abbrev package TESTP TestPackage
TestPackage() : with
     test: () -> List((()->Integer))
   == add
     test() == [(() +-> i^2) for i in 1..10]


((main {
    { iter
        1 take bons 1 take
        dup cp
        {*} cp
        3 take
        append }
    10 times
    collect !
    {eval %d nl <<} each }))


import "/dynamic" for Enum, Struct, Tuple
import "/str" for Char
import "/fmt" for Fmt
import "/ioutil" for FileUtil
import "os" for Process

var tokens = [
    "EOI",
    "Mul",
    "Div",
    "Mod",
    "Add",
    "Sub",
    "Negate",
    "Not",
    "Lss",
    "Leq",
    "Gtr",
    "Geq",
    "Eq",
    "Neq",
    "Assign",
    "And",
    "Or",
    "If",
    "Else",
    "While",
    "Print",
    "Putc",
    "Lparen",
    "Rparen",
    "Lbrace",
    "Rbrace",
    "Semi",
    "Comma",
    "Ident",
    "Integer",
    "String"
]

var Token = Enum.create("Token", tokens)

var TokData = Struct.create("TokData", ["eline", "ecol", "tok", "v"])

var Symbol = Tuple.create("Symbol", ["name", "tok"])

// symbol table
var symtab = []

var curLine = ""
var curCh = ""
var lineNum = 0
var colNum = 0
var etx = 4  // used to signify EOI

var lines = []
var lineCount = 0

var errorMsg = Fn.new { |eline, ecol, msg| Fiber.abort("(%(eline):%(ecol)) %(msg)") }

// add an identifier to the symbpl table
var install = Fn.new { |name, tok|
    var sym = Symbol.new(name, tok)
    symtab.add(sym)
}

// search for an identifier in the symbol table
var lookup = Fn.new { |name|
    for (i in 0...symtab.count) {
        if (symtab[i].name == name) return i
    }
    return -1
}

// read the next line of input from the source file
var nextLine  // recursive function
nextLine = Fn.new {
    if (lineNum == lineCount) {
        curCh = etx
        curLine = ""
        colNum = 1
        return
    }
    curLine = lines[lineNum]
    lineNum = lineNum + 1
    colNum = 0
    if (curLine == "") nextLine.call()  // skip blank lines
}

// get the next char
var nextChar = Fn.new {
    if (colNum >= curLine.count) nextLine.call()
    if (colNum < curLine.count) {
        curCh = curLine[colNum]
        colNum = colNum + 1
    }
}

var follow = Fn.new { |eline, ecol, expect, ifyes, ifno|
    if (curCh == expect) {
        nextChar.call()
        return ifyes
    }
    if (ifno == Token.EOI) {
        errorMsg.call(eline, ecol, "follow unrecognized character: " + curCh)
    }
    return ifno
}

var getTok  // recursive function
getTok = Fn.new {
    // skip whitespace
    while (curCh == " " || curCh == "\t" || curCh == "\n") nextChar.call()
    var td = TokData.new(lineNum, colNum, 0, "")
    if (curCh == etx) {
        td.tok = Token.EOI
        return td
    }
    if (curCh == "{") {
        td.tok = Token.Lbrace
        nextChar.call()
        return td
    }
    if (curCh == "}") {
        td.tok = Token.Rbrace
        nextChar.call()
        return td
    }
    if (curCh == "(") {
        td.tok = Token.Lparen
        nextChar.call()
        return td
    }
    if (curCh == ")") {
        td.tok = Token.Rparen
        nextChar.call()
        return td
    }
    if (curCh == "+") {
        td.tok = Token.Add
        nextChar.call()
        return td
    }
    if (curCh == "-") {
        td.tok = Token.Sub
        nextChar.call()
        return td
    }
    if (curCh == "*") {
        td.tok = Token.Mul
        nextChar.call()
        return td
    }
    if (curCh == "\%") {
        td.tok = Token.Mod
        nextChar.call()
        return td
    }
    if (curCh == ";") {
        td.tok = Token.Semi
        nextChar.call()
        return td
    }
    if (curCh == ",") {
        td.tok = Token.Comma
        nextChar.call()
        return td
    }
    if (curCh == "'") { // single char literals
        nextChar.call()
        td.v = curCh.bytes[0].toString
        if (curCh == "'") {
            errorMsg.call(td.eline, td.ecol, "Empty character constant")
        }
        if (curCh == "\\") {
            nextChar.call()
            if (curCh == "n") {
                td.v = "10"
            } else if (curCh == "\\") {
                td.v = "92"
            } else {
                errorMsg.call(td.eline, td.ecol, "unknown escape sequence: "+ curCh)
            }
        }
        nextChar.call()
        if (curCh != "'") {
            errorMsg.call(td.eline, td.ecol, "multi-character constant")
        }
        nextChar.call()
        td.tok = Token.Integer
        return td
    }
    if (curCh == "<") {
        nextChar.call()
        td.tok = follow.call(td.eline, td.ecol, "=",  Token.Leq, Token.Lss)
        return td
    }
    if (curCh == ">") {
        nextChar.call()
        td.tok = follow.call(td.eline, td.ecol, "=", Token.Geq, Token.Gtr)
        return td
    }
    if (curCh == "!") {
        nextChar.call()
        td.tok = follow.call(td.eline, td.ecol, "=", Token.Neq, Token.Not)
        return td
    }
    if (curCh == "=") {
        nextChar.call()
        td.tok = follow.call(td.eline, td.ecol, "=", Token.Eq, Token.Assign)
        return td
    }
    if (curCh == "&") {
        nextChar.call()
        td.tok = follow.call(td.eline, td.ecol, "&", Token.And, Token.EOI)
        return td
    }
    if (curCh == "|") {
        nextChar.call()
        td.tok = follow.call(td.eline, td.ecol, "|", Token.Or, Token.EOI)
        return td
    }
    if (curCh == "\"") { // string
        td.v = curCh
        nextChar.call()
        while (curCh != "\"") {
            if (curCh == "\n") {
                errorMsg.call(td.eline, td.ecol, "EOL in string")
            }
            if (curCh == etx) {
                errorMsg.call(td.eline, td.ecol, "EOF in string")
            }
            td.v = td.v + curCh
            nextChar.call()
        }
        td.v = td.v + curCh
        nextChar.call()
        td.tok = Token.String
        return td
    }
    if (curCh == "/") { // div or comment
        nextChar.call()
        if (curCh != "*") {
            td.tok = Token.Div
            return td
        }
        // skip comments
        nextChar.call()
        while (true) {
            if (curCh == "*") {
                nextChar.call()
                if (curCh == "/") {
                    nextChar.call()
                    return getTok.call()
                }
            } else if (curCh == etx) {
                errorMsg.call(td.eline, td.ecol, "EOF in comment")
            } else {
                nextChar.call()
            }
        }
    }
    //integers or identifiers
    var isNumber = Char.isDigit(curCh)
    td.v = ""
    while (Char.isAsciiAlphaNum(curCh) || curCh == "_") {
        if (!Char.isDigit(curCh)) isNumber = false
        td.v = td.v + curCh
        nextChar.call()
    }
    if (td.v.count == 0) {
        errorMsg.call(td.eline, td.ecol, "unknown character: " + curCh)
    }
    if (Char.isDigit(td.v[0])) {
        if (!isNumber) {
            errorMsg.call(td.eline, td.ecol, "invalid number: " + curCh)
        }
        td.tok = Token.Integer
        return td
    }
    var index = lookup.call(td.v)
    td.tok = (index == -1) ? Token.Ident : symtab[index].tok
    return td
}

var initLex = Fn.new {
    install.call("else", Token.Else)
    install.call("if", Token.If)
    install.call("print", Token.Print)
    install.call("putc", Token.Putc)
    install.call("while", Token.While)
    nextChar.call()
}

var process = Fn.new {
    var tokMap = {}
    tokMap[Token.EOI]     = "End_of_input"
    tokMap[Token.Mul]     = "Op_multiply"
    tokMap[Token.Div]     = "Op_divide"
    tokMap[Token.Mod]     = "Op_mod"
    tokMap[Token.Add]     = "Op_add"
    tokMap[Token.Sub]     = "Op_subtract"
    tokMap[Token.Negate]  = "Op_negate"
    tokMap[Token.Not]     = "Op_not"
    tokMap[Token.Lss]     = "Op_less"
    tokMap[Token.Leq]     = "Op_lessequal"
    tokMap[Token.Gtr]     = "Op_greater"
    tokMap[Token.Geq]     = "Op_greaterequal"
    tokMap[Token.Eq]      = "Op_equal"
    tokMap[Token.Neq]     = "Op_notequal"
    tokMap[Token.Assign]  = "Op_assign"
    tokMap[Token.And]     = "Op_and"
    tokMap[Token.Or]      = "Op_or"
    tokMap[Token.If]      = "Keyword_if"
    tokMap[Token.Else]    = "Keyword_else"
    tokMap[Token.While]   = "Keyword_while"
    tokMap[Token.Print]   = "Keyword_print"
    tokMap[Token.Putc]    = "Keyword_putc"
    tokMap[Token.Lparen]  = "LeftParen"
    tokMap[Token.Rparen]  = "RightParen"
    tokMap[Token.Lbrace]  = "LeftBrace"
    tokMap[Token.Rbrace]  = "RightBrace"
    tokMap[Token.Semi]    = "Semicolon"
    tokMap[Token.Comma]   = "Comma"
    tokMap[Token.Ident]   = "Identifier"
    tokMap[Token.Integer] = "Integer"
    tokMap[Token.String]  = "String"

    while (true) {
        var td = getTok.call()
        Fmt.write("$5d  $5d $-16s", td.eline, td.ecol, tokMap[td.tok])
        if (td.tok == Token.Integer || td.tok == Token.Ident || td.tok == Token.String) {
            System.print(td.v)
        } else {
            System.print()
        }
        if (td.tok == Token.EOI) return
    }
}

var args = Process.arguments
if (args.count == 0) {
    System.print("Filename required")
    return
}

lines = FileUtil.readLines(args[0])
lineCount = lines.count
initLex.call()
process.call()


#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <sys/mman.h>

typedef int (*f_int)();

#define TAG 0xdeadbeef
int _tmpl() {
	volatile int x = TAG;
	return x * x;
}

#define PROT (PROT_EXEC | PROT_WRITE)
#define FLAGS (MAP_PRIVATE | MAP_ANONYMOUS)
f_int dupf(int v)
{
	size_t len = (void*)dupf - (void*)_tmpl;
	f_int ret = mmap(NULL, len, PROT, FLAGS, 0, 0);
	char *p;
	if(ret == MAP_FAILED) {
		perror("mmap");
		exit(-1);
	}
	memcpy(ret, _tmpl, len);
	for (p = (char*)ret; p < (char*)ret + len - sizeof(int); p++)
		if (*(int *)p == TAG) *(int *)p = v;
	return ret;
}

int main()
{
	f_int funcs[10];
	int i;
	for (i = 0; i < 10; i++) funcs[i] = dupf(i);

	for (i = 0; i < 9; i++)
		printf("func[%d]: %d\n", i, funcs[i]());

	return 0;
}


const std = @import("std");

pub const TokenType = enum {
    unknown,
    multiply,
    divide,
    mod,
    add,
    subtract,
    negate,
    less,
    less_equal,
    greater,
    greater_equal,
    equal,
    not_equal,
    not,
    assign,
    bool_and,
    bool_or,
    left_paren,
    right_paren,
    left_brace,
    right_brace,
    semicolon,
    comma,
    kw_if,
    kw_else,
    kw_while,
    kw_print,
    kw_putc,
    identifier,
    integer,
    string,
    eof,

    // More efficient implementation can be done with `std.enums.directEnumArray`.
    pub fn toString(self: @This()) []const u8 {
        return switch (self) {
            .unknown => "UNKNOWN",
            .multiply => "Op_multiply",
            .divide => "Op_divide",
            .mod => "Op_mod",
            .add => "Op_add",
            .subtract => "Op_subtract",
            .negate => "Op_negate",
            .less => "Op_less",
            .less_equal => "Op_lessequal",
            .greater => "Op_greater",
            .greater_equal => "Op_greaterequal",
            .equal => "Op_equal",
            .not_equal => "Op_notequal",
            .not => "Op_not",
            .assign => "Op_assign",
            .bool_and => "Op_and",
            .bool_or => "Op_or",
            .left_paren => "LeftParen",
            .right_paren => "RightParen",
            .left_brace => "LeftBrace",
            .right_brace => "RightBrace",
            .semicolon => "Semicolon",
            .comma => "Comma",
            .kw_if => "Keyword_if",
            .kw_else => "Keyword_else",
            .kw_while => "Keyword_while",
            .kw_print => "Keyword_print",
            .kw_putc => "Keyword_putc",
            .identifier => "Identifier",
            .integer => "Integer",
            .string => "String",
            .eof => "End_of_input",
        };
    }
};

pub const TokenValue = union(enum) {
    intlit: i32,
    string: []const u8,
};

pub const Token = struct {
    line: usize,
    col: usize,
    typ: TokenType = .unknown,
    value: ?TokenValue = null,
};

// Error conditions described in the task.
pub const LexerError = error{
    EmptyCharacterConstant,
    UnknownEscapeSequence,
    MulticharacterConstant,
    EndOfFileInComment,
    EndOfFileInString,
    EndOfLineInString,
    UnrecognizedCharacter,
    InvalidNumber,
};

pub const Lexer = struct {
    content: []const u8,
    line: usize,
    col: usize,
    offset: usize,
    start: bool,

    const Self = @This();

    pub fn init(content: []const u8) Lexer {
        return Lexer{
            .content = content,
            .line = 1,
            .col = 1,
            .offset = 0,
            .start = true,
        };
    }

    pub fn buildToken(self: Self) Token {
        return Token{ .line = self.line, .col = self.col };
    }

    pub fn buildTokenT(self: Self, typ: TokenType) Token {
        return Token{ .line = self.line, .col = self.col, .typ = typ };
    }

    pub fn curr(self: Self) u8 {
        return self.content[self.offset];
    }

    // Alternative implementation is to return `Token` value from `next()` which is
    // arguably more idiomatic version.
    pub fn next(self: *Self) ?u8 {
        // We use `start` in order to make the very first invocation of `next()` to return
        // the very first character. It should be possible to avoid this variable.
        if (self.start) {
            self.start = false;
        } else {
            const newline = self.curr() == '\n';
            self.offset += 1;
            if (newline) {
                self.col = 1;
                self.line += 1;
            } else {
                self.col += 1;
            }
        }
        if (self.offset >= self.content.len) {
            return null;
        } else {
            return self.curr();
        }
    }

    pub fn peek(self: Self) ?u8 {
        if (self.offset + 1 >= self.content.len) {
            return null;
        } else {
            return self.content[self.offset + 1];
        }
    }

    fn divOrComment(self: *Self) LexerError!?Token {
        var result = self.buildToken();
        if (self.peek()) |peek_ch| {
            if (peek_ch == '*') {
                _ = self.next(); // peeked character
                while (self.next()) |ch| {
                    if (ch == '*') {
                        if (self.peek()) |next_ch| {
                            if (next_ch == '/') {
                                _ = self.next(); // peeked character
                                return null;
                            }
                        }
                    }
                }
                return LexerError.EndOfFileInComment;
            }
        }
        result.typ = .divide;
        return result;
    }

    fn identifierOrKeyword(self: *Self) !Token {
        var result = self.buildToken();
        const init_offset = self.offset;
        while (self.peek()) |ch| : (_ = self.next()) {
            switch (ch) {
                '_', 'a'...'z', 'A'...'Z', '0'...'9' => {},
                else => break,
            }
        }
        const final_offset = self.offset + 1;

        if (std.mem.eql(u8, self.content[init_offset..final_offset], "if")) {
            result.typ = .kw_if;
        } else if (std.mem.eql(u8, self.content[init_offset..final_offset], "else")) {
            result.typ = .kw_else;
        } else if (std.mem.eql(u8, self.content[init_offset..final_offset], "while")) {
            result.typ = .kw_while;
        } else if (std.mem.eql(u8, self.content[init_offset..final_offset], "print")) {
            result.typ = .kw_print;
        } else if (std.mem.eql(u8, self.content[init_offset..final_offset], "putc")) {
            result.typ = .kw_putc;
        } else {
            result.typ = .identifier;
            result.value = TokenValue{ .string = self.content[init_offset..final_offset] };
        }

        return result;
    }

    fn string(self: *Self) !Token {
        var result = self.buildToken();
        result.typ = .string;
        const init_offset = self.offset;
        while (self.next()) |ch| {
            switch (ch) {
                '"' => break,
                '\n' => return LexerError.EndOfLineInString,
                '\\' => {
                    switch (self.peek() orelse return LexerError.EndOfFileInString) {
                        'n', '\\' => _ = self.next(), // peeked character
                        else => return LexerError.UnknownEscapeSequence,
                    }
                },
                else => {},
            }
        } else {
            return LexerError.EndOfFileInString;
        }
        const final_offset = self.offset + 1;
        result.value = TokenValue{ .string = self.content[init_offset..final_offset] };
        return result;
    }

    /// Choose either `ifyes` or `ifno` token type depending on whether the peeked
    /// character is `by`.
    fn followed(self: *Self, by: u8, ifyes: TokenType, ifno: TokenType) Token {
        var result = self.buildToken();
        if (self.peek()) |ch| {
            if (ch == by) {
                _ = self.next(); // peeked character
                result.typ = ifyes;
            } else {
                result.typ = ifno;
            }
        } else {
            result.typ = ifno;
        }
        return result;
    }

    /// Raise an error if there's no next `by` character but return token with `typ` otherwise.
    fn consecutive(self: *Self, by: u8, typ: TokenType) LexerError!Token {
        const result = self.buildTokenT(typ);
        if (self.peek()) |ch| {
            if (ch == by) {
                _ = self.next(); // peeked character
                return result;
            } else {
                return LexerError.UnrecognizedCharacter;
            }
        } else {
            return LexerError.UnrecognizedCharacter;
        }
    }

    fn integerLiteral(self: *Self) LexerError!Token {
        var result = self.buildTokenT(.integer);
        const init_offset = self.offset;
        while (self.peek()) |ch| {
            switch (ch) {
                '0'...'9' => _ = self.next(), // peeked character
                '_', 'a'...'z', 'A'...'Z' => return LexerError.InvalidNumber,
                else => break,
            }
        }
        const final_offset = self.offset + 1;
        result.value = TokenValue{
            .intlit = std.fmt.parseInt(i32, self.content[init_offset..final_offset], 10) catch {
                return LexerError.InvalidNumber;
            },
        };
        return result;
    }

    // This is a beautiful way of how Zig allows to remove bilerplate and at the same time
    // to not lose any error completeness guarantees.
    fn nextOrEmpty(self: *Self) LexerError!u8 {
        return self.next() orelse LexerError.EmptyCharacterConstant;
    }

    fn integerChar(self: *Self) LexerError!Token {
        var result = self.buildTokenT(.integer);
        switch (try self.nextOrEmpty()) {
            '\'', '\n' => return LexerError.EmptyCharacterConstant,
            '\\' => {
                switch (try self.nextOrEmpty()) {
                    'n' => result.value = TokenValue{ .intlit = '\n' },
                    '\\' => result.value = TokenValue{ .intlit = '\\' },
                    else => return LexerError.EmptyCharacterConstant,
                }
                switch (try self.nextOrEmpty()) {
                    '\'' => {},
                    else => return LexerError.MulticharacterConstant,
                }
            },
            else => {
                result.value = TokenValue{ .intlit = self.curr() };
                switch (try self.nextOrEmpty()) {
                    '\'' => {},
                    else => return LexerError.MulticharacterConstant,
                }
            },
        }
        return result;
    }
};

pub fn lex(allocator: std.mem.Allocator, content: []u8) !std.ArrayList(Token) {
    var tokens = std.ArrayList(Token).init(allocator);
    var lexer = Lexer.init(content);
    while (lexer.next()) |ch| {
        switch (ch) {
            ' ' => {},
            '*' => try tokens.append(lexer.buildTokenT(.multiply)),
            '%' => try tokens.append(lexer.buildTokenT(.mod)),
            '+' => try tokens.append(lexer.buildTokenT(.add)),
            '-' => try tokens.append(lexer.buildTokenT(.subtract)),
            '<' => try tokens.append(lexer.followed('=', .less_equal, .less)),
            '>' => try tokens.append(lexer.followed('=', .greater_equal, .greater)),
            '=' => try tokens.append(lexer.followed('=', .equal, .assign)),
            '!' => try tokens.append(lexer.followed('=', .not_equal, .not)),
            '(' => try tokens.append(lexer.buildTokenT(.left_paren)),
            ')' => try tokens.append(lexer.buildTokenT(.right_paren)),
            '{' => try tokens.append(lexer.buildTokenT(.left_brace)),
            '}' => try tokens.append(lexer.buildTokenT(.right_brace)),
            ';' => try tokens.append(lexer.buildTokenT(.semicolon)),
            ',' => try tokens.append(lexer.buildTokenT(.comma)),
            '&' => try tokens.append(try lexer.consecutive('&', .bool_and)),
            '|' => try tokens.append(try lexer.consecutive('|', .bool_or)),
            '/' => {
                if (try lexer.divOrComment()) |token| try tokens.append(token);
            },
            '_', 'a'...'z', 'A'...'Z' => try tokens.append(try lexer.identifierOrKeyword()),
            '"' => try tokens.append(try lexer.string()),
            '0'...'9' => try tokens.append(try lexer.integerLiteral()),
            '\'' => try tokens.append(try lexer.integerChar()),
            else => {},
        }
    }
    try tokens.append(lexer.buildTokenT(.eof));

    return tokens;
}

pub fn main() !void {
    var arena = std.heap.ArenaAllocator.init(std.heap.page_allocator);
    defer arena.deinit();
    const allocator = arena.allocator();

    var arg_it = std.process.args();
    _ = try arg_it.next(allocator) orelse unreachable; // program name
    const file_name = arg_it.next(allocator);
    // We accept both files and standard input.
    var file_handle = blk: {
        if (file_name) |file_name_delimited| {
            const fname: []const u8 = try file_name_delimited;
            break :blk try std.fs.cwd().openFile(fname, .{});
        } else {
            break :blk std.io.getStdIn();
        }
    };
    defer file_handle.close();
    const input_content = try file_handle.readToEndAlloc(allocator, std.math.maxInt(usize));

    const tokens = try lex(allocator, input_content);
    const pretty_output = try tokenListToString(allocator, tokens);
    _ = try std.io.getStdOut().write(pretty_output);
}

fn tokenListToString(allocator: std.mem.Allocator, token_list: std.ArrayList(Token)) ![]u8 {
    var result = std.ArrayList(u8).init(allocator);
    var w = result.writer();
    for (token_list.items) |token| {
        const common_args = .{ token.line, token.col, token.typ.toString() };
        if (token.value) |value| {
            const init_fmt = "{d:>5}{d:>7} {s:<15}";
            switch (value) {
                .string => |str| _ = try w.write(try std.fmt.allocPrint(
                    allocator,
                    init_fmt ++ "{s}\n",
                    common_args ++ .{str},
                )),
                .intlit => |i| _ = try w.write(try std.fmt.allocPrint(
                    allocator,
                    init_fmt ++ "{d}\n",
                    common_args ++ .{i},
                )),
            }
        } else {
            _ = try w.write(try std.fmt.allocPrint(allocator, "{d:>5}{d:>7} {s}\n", common_args));
        }
    }
    return result.items;
}


using System;
using System.Linq;

class Program
{
    static void Main()
    {
        var captor = (Func<int, Func<int>>)(number => () => number * number);
        var functions = Enumerable.Range(0, 10).Select(captor);
        foreach (var function in functions.Take(9))
        {
            Console.WriteLine(function());
        }
    }
}


#include <iostream>
#include <functional>
#include <vector>

int main() {
  std::vector<std::function<int()> > funcs;
  for (int i = 0; i < 10; i++)
    funcs.push_back([=]() { return i * i; });
  for ( std::function<int( )> f : funcs )
    std::cout << f( ) << std::endl ;
  return 0;
}


shared void run() {

	//create a list of closures with a list comprehension
	value closures = [for(i in 0:10) () => i ^ 2];

	for(i->closure in closures.indexed) {
		print("closure number ``i`` returns: ``closure()``");
	}
}


(def funcs (map #(fn [] (* % %)) (range 11)))
(printf "%d\n%d\n" ((nth funcs 3)) ((nth funcs 4)))


# Generate an array of functions.
funcs = ( for i in [ 0...10 ] then do ( i ) -> -> i * i )

# Call each function to demonstrate value capture.
console.log func() for func in funcs


CL-USER> (defparameter alist
	   (loop for i from 1 to 10
	      collect (cons i (let ((i i))
				(lambda () (* i i))))))
ALIST
CL-USER> (funcall (cdr (assoc 2 alist)))
4
CL-USER> (funcall (cdr (assoc 8 alist)))
64


import std.stdio;

void main() {
    int delegate()[] funcs;

    foreach (i; 0 .. 10)
        funcs ~= (i => () => i ^^ 2)(i);

    writeln(funcs[3]());
}


program Project1;

type
  TFuncIntResult = reference to function: Integer;

// use function that returns anonymous method to avoid capturing the loop variable
function CreateFunc(i: Integer): TFuncIntResult;
begin
  Result :=
    function: Integer
    begin
      Result := i * i;
    end;
end;

var
  Funcs: array[0..9] of TFuncIntResult;
  i: integer;
begin
  // create 10 anonymous functions
  for i := Low(Funcs) to High(Funcs) do
    Funcs[i] := CreateFunc(i);

  // call all 10 functions
  for i := Low(Funcs) to High(Funcs) do
    Writeln(Funcs[i]());
end.


var xs = []
let num = 10

for n in 0..<num {
    xs.Add((n => () => n * n)(n))
}

for x in xs {
    print(x())
}


(define (fgen i) (lambda () (* i i)))
(define fs (for/vector ((i 10)) (fgen i))) ;; vector of 10 anonymous functions
((vector-ref fs 5)) ;; calls fs[5]
    → 25


import system'routines;
import extensions;

public program()
{
    var functions := Array.allocate(10).populate:(int i => {^ i * i} );

    functions.forEach:(func) { console.printLine(func()) }
}


funs = for i <- 0..9, do: (fn -> i*i end)
Enum.each(funs, &IO.puts &1.())


-module(capture_demo).
-export([demo/0]).

demo() ->
    Funs = lists:map(fun (X) ->
                             fun () ->
                                     X * X
                             end
                     end,
                     lists:seq(1,10)),
    lists:foreach(fun (F) ->
                    io:fwrite("~B~n",[F()])
            end, Funs).


[<EntryPoint>]
let main argv =
    let fs = List.init 10 (fun i -> fun () -> i*i)
    do List.iter (fun f -> printfn "%d" <| f()) fs
    0


USING: io kernel locals math prettyprint sequences ;

[let
    ! Create a sequence of 10 quotations
    10 iota [
        :> i            ! Bind lexical variable i
        [ i i * ]       ! Push a quotation to calculate i squared
    ] map :> seq

    { 3 8 } [
        dup pprint " squared is " write
        seq nth call .
    ] each
]


class Closures
{
  Void main ()
  {
    // define a list of functions, which take no arguments and return an Int
    |->Int|[] functions := [,]

    // create and store a function which returns i*i for i in 0 to 10
    (0..10).each |Int i|
    {
      functions.add (|->Int| { i*i })
    }

    // show result of calling function at index position 7
    echo ("Function at index: " + 7 + " outputs " + functions[7].call)
  }
}


: xt-array here { a }
    10 cells allot 10 0 do
	:noname i ]] literal dup * ; [[ a i cells + !
    loop a ;

xt-array 5 cells + @ execute .