DIGIT_F = {
    "   ## #" => 0,
    "  ##  #" => 1,
    "  #  ##" => 2,
    " #### #" => 3,
    " #   ##" => 4,
    " ##   #" => 5,
    " # ####" => 6,
    " ### ##" => 7,
    " ## ###" => 8,
    "   # ##" => 9,
}

DIGIT_R = {
    "###  # " => 0,
    "##  ## " => 1,
    "## ##  " => 2,
    "#    # " => 3,
    "# ###  " => 4,
    "#  ### " => 5,
    "# #    " => 6,
    "#   #  " => 7,
    "#  #   " => 8,
    "### #  " => 9,
}

END_SENTINEL = "# #"
MID_SENTINEL = " # # "

def decode_upc(s)
    def decode_upc_impl(input)
        upc = input.strip
        if upc.length != 95 then
            return false
        end

        pos = 0
        digits = []
        sum = 0

        # end sentinel
        if upc[pos .. pos + 2] == END_SENTINEL then
            pos += 3
        else
            return false
        end

        # 6 left hand digits
        for i in 0 .. 5
            digit = DIGIT_F[upc[pos .. pos + 6]]
            if digit == nil then
                return false
            else
                digits.push(digit)
                sum += digit * [1, 3][digits.length % 2]
                pos += 7
            end
        end

        # mid sentinel
        if upc[pos .. pos + 4] == MID_SENTINEL then
            pos += 5
        else
            return false
        end

        # 6 right hand digits
        for i in 0 .. 5
            digit = DIGIT_R[upc[pos .. pos + 6]]
            if digit == nil then
                return false
            else
                digits.push(digit)
                sum += digit * [1, 3][digits.length % 2]
                pos += 7
            end
        end

        # end sentinel
        if upc[pos .. pos + 2] == END_SENTINEL then
            pos += 3
        else
            return false
        end

        if sum % 10  == 0 then
            print digits, " "
            return true
        else
            print "Failed Checksum "
            return false
        end
    end

    if decode_upc_impl(s) then
        puts "Rightside Up"
    elsif decode_upc_impl(s.reverse) then
        puts "Upside Down"
    else
        puts "Invalid digit(s)"
    end
end

def main
    num = 0

    print "%2d: " % [num += 1]
    decode_upc("         # #   # ##  #  ## #   ## ### ## ### ## #### # # # ## ##  #   #  ##  ## ###  # ##  ## ### #  # #       ")

    print "%2d: " % [num += 1]
    decode_upc("        # # #   ##   ## # #### #   # ## #   ## #   ## # # # ###  # ###  ##  ## ###  # #  ### ###  # # #         ")

    print "%2d: " % [num += 1]
    decode_upc("         # #    # # #  ###  #   #    # #  #   #    # # # # ## #   ## #   ## #   ##   # # #### ### ## # #         ")

    print "%2d: " % [num += 1]
    decode_upc("       # # ##  ## ##  ##   #  #   #  # ###  # ##  ## # # #   ## ##  #  ### ## ## #   # #### ## #   # #        ")

    print "%2d: " % [num += 1]
    decode_upc("         # # ### ## #   ## ## ###  ##  # ##   #   # ## # # ### #  ## ##  #    # ### #  ## ##  #      # #          ")

    print "%2d: " % [num += 1]
    decode_upc("          # #  #   # ##  ##  #   #   #  # ##  ##  #   # # # # #### #  ##  # #### #### # #  ##  # #### # #         ")

    print "%2d: " % [num += 1]
    decode_upc("         # #  #  ##  ##  # #   ## ##   # ### ## ##   # # # #  #   #   #  #  ### # #    ###  # #  #   # #        ")

    print "%2d: " % [num += 1]
    decode_upc("        # # #    # ##  ##   #  # ##  ##  ### #   #  # # # ### ## ## ### ## ### ### ## #  ##  ### ## # #         ")

    print "%2d: " % [num += 1]
    decode_upc("         # # ### ##   ## # # #### #   ## # #### # #### # # #   #  # ###  #    # ###  # #    # ###  # # #       ")

    print "%2d: " % [num += 1]
    decode_upc("        # # # #### ##   # #### # #   ## ## ### #### # # # #  ### # ###  ###  # # ###  #    # #  ### # #         ")
end

main()


import "/fmt" for Fmt

var digitL = {
    "   ## #": 0,
    "  ##  #": 1,
    "  #  ##": 2,
    " #### #": 3,
    " #   ##": 4,
    " ##   #": 5,
    " # ####": 6,
    " ### ##": 7,
    " ## ###": 8,
    "   # ##": 9
}

var digitR = {
    "###  # ": 0,
    "##  ## ": 1,
    "## ##  ": 2,
    "#    # ": 3,
    "# ###  ": 4,
    "#  ### ": 5,
    "# #    ": 6,
    "#   #  ": 7,
    "#  #   ": 8,
    "### #  ": 9
}

var endSentinel = "# #"  //  also at start
var midSentinel = " # # "

var decodeUpc = Fn.new { |s|
    var decodeUpcImpl = Fn.new { |input|
        var upc = input.trim()
        if (upc.count != 95) return false
        var pos = 0
        var digits = []
        var sum = 0
        var oneThree = [1, 3]

        // end sentinel
        if (upc[pos..pos+2] == endSentinel) {
            pos = pos + 3
        } else {
            return false
        }

        // 6 left hand digits
        for (i in 0..5) {
            var digit = digitL[upc[pos..pos+6]]
            if (!digit) return false
            digits.add(digit)
            sum = sum + digit * oneThree[digits.count % 2]
            pos = pos + 7
        }

        // mid sentinel
        if (upc[pos..pos+4] == midSentinel) {
            pos = pos + 5
        } else {
            return false
        }

        // 6 right hand digits
        for (i in 0..5) {
            var digit = digitR[upc[pos..pos+6]]
            if (!digit) return false
            digits.add(digit)
            sum = sum + digit * oneThree[digits.count % 2]
            pos = pos + 7
        }

        // end sentinel
        if (upc[pos..pos+2] != endSentinel) return false

        if (sum%10 == 0) {
            System.write("%(digits) ")
            return true
        }
        System.write("Failed Checksum ")
        return false
    }

    if (decodeUpcImpl.call(s)) {
        System.print("Rightside Up")
    } else if (decodeUpcImpl.call(s[-1..0])) {
        System.print("Upside Down")
    } else {
        System.print("Invalid digit(s)")
    }
}

var barcodes = [
    "         # #   # ##  #  ## #   ## ### ## ### ## #### # # # ## ##  #   #  ##  ## ###  # ##  ## ### #  # #       ",
    "        # # #   ##   ## # #### #   # ## #   ## #   ## # # # ###  # ###  ##  ## ###  # #  ### ###  # # #         ",
    "         # #    # # #  ###  #   #    # #  #   #    # # # # ## #   ## #   ## #   ##   # # #### ### ## # #         ",
    "       # # ##  ## ##  ##   #  #   #  # ###  # ##  ## # # #   ## ##  #  ### ## ## #   # #### ## #   # #        ",
    "         # # ### ## #   ## ## ###  ##  # ##   #   # ## # # ### #  ## ##  #    # ### #  ## ##  #      # #          ",
    "          # #  #   # ##  ##  #   #   #  # ##  ##  #   # # # # #### #  ##  # #### #### # #  ##  # #### # #         ",
    "         # #  #  ##  ##  # #   ## ##   # ### ## ##   # # # #  #   #   #  #  ### # #    ###  # #  #   # #        ",
    "        # # #    # ##  ##   #  # ##  ##  ### #   #  # # # ### ## ## ### ## ### ### ## #  ##  ### ## # #         ",
    "         # # ### ##   ## # # #### #   ## # #### # #### # # #   #  # ###  #    # ###  # #    # ###  # # #       ",
    "        # # # #### ##   # #### # #   ## ## ### #### # # # #  ### # ###  ###  # # ###  #    # #  ### # #         "
]
var n = 0
for (barcode in barcodes) {
    n = n + 1
    Fmt.write("$2d: ", n)
    decodeUpc.call(barcode)
}


var lhd=Dictionary(), rhd=Dictionary();
[0..].zip(List(
    "0 0 0 1 1 0 1", //--> "___##_#":0   "###__#_":0
    "0 0 1 1 0 0 1",
    "0 0 1 0 0 1 1",
    "0 1 1 1 1 0 1",
    "0 1 0 0 0 1 1",
    "0 1 1 0 0 0 1",
    "0 1 0 1 1 1 1",
    "0 1 1 1 0 1 1",
    "0 1 1 0 1 1 1",
    "0 0 0 1 0 1 1") //--> "___#_##":9    "###_#__":9
).pump(Void,fcn([(n,bs)]){
   bs-=" ";
   lhd[bs.translate("01","_#")]=n;
   rhd[bs.translate("10","_#")]=n;
});

fcn parseBarCode(barcode, one=True){	// --> 12 digits
   upsideDown:='wrap{	// was I looking at this bar code upside down?
      if(one and (r:=parseBarCode(barcode.reverse(),False))) return(r);
      return(False);
   };

   var [const] start=RegExp(String("_"*9, "+#_#")), tail="_"*7;
   if(not start.search(barcode)) return(upsideDown());
   r,idx,d,mark := List(), start.matched[0][1], lhd, "_#_#_";
   do(2){
      do(6){
	 if(Void==(z:=d.find(barcode[idx,7]))) return(upsideDown());
	 r.append(z);
	 idx+=7;
      }
      if(barcode[idx,5] != mark) return(Void);
      d,idx,mark = rhd, idx+5, "#_#__";
   }
   if(tail!=barcode[idx,7]) return(Void);  // 9 trailing blanks? two checked above
   r
}


#!/usr/local/bin/a68g --script #
# -*- coding: utf-8 -*- #

# UNICHAR/UNICODE must be printed using REPR to convert to UTF8 #

MODE UNICHAR = STRUCT(BITS #31# bits); # assuming bits width >=31 #
MODE UNICODE = FLEX[0]UNICHAR;

OP INITUNICHAR = (BITS bits)UNICHAR: (UNICHAR out; bits OF out := #ABS# bits; out);
OP INITUNICHAR = (CHAR char)UNICHAR: (UNICHAR out; bits OF out := BIN ABS char; out);
OP INITBITS = (UNICHAR unichar)BITS: #BIN# bits OF unichar;

PROC raise value error = ([]UNION(FORMAT,BITS,STRING)argv )VOID: (
  putf(stand error, argv); stop
);

MODE YIELDCHAR =    PROC(CHAR)VOID;    MODE GENCHAR =    PROC(YIELDCHAR)VOID;
MODE YIELDUNICHAR = PROC(UNICHAR)VOID; MODE GENUNICHAR = PROC(YIELDUNICHAR)VOID;

PRIO DOCONV = 1;

# Convert a stream of UNICHAR into a stream of UTFCHAR #
OP DOCONV = (GENUNICHAR gen unichar, YIELDCHAR yield)VOID:(
  BITS non ascii = NOT 2r1111111;
# FOR UNICHAR unichar IN # gen unichar( # ) DO ( #
##   (UNICHAR unichar)VOID: (
    BITS bits := INITBITS unichar;
    IF (bits AND non ascii) = 2r0 THEN # ascii #
      yield(REPR ABS bits)
    ELSE
      FLEX[6]CHAR buf := "?"*6; # initialise work around #
      INT bytes := 0;
      BITS byte lead bits = 2r10000000;
      FOR ofs FROM UPB buf BY -1 WHILE
        bytes +:= 1;
        buf[ofs]:= REPR ABS (byte lead bits OR bits AND 2r111111);
        bits := bits SHR 6;
    # WHILE # bits NE 2r0 DO
        SKIP
      OD;
      BITS first byte lead bits = BIN (ABS(2r1 SHL bytes)-2) SHL (UPB buf - bytes + 1);
      buf := buf[UPB buf-bytes+1:];
      buf[1] := REPR ABS(BIN ABS buf[1] OR first byte lead bits);
      FOR i TO UPB buf DO yield(buf[i]) OD
    FI
# OD # ))
);

# Convert a STRING into a stream of UNICHAR #
OP DOCONV = (STRING string, YIELDUNICHAR yield)VOID: (
  PROC gen char = (YIELDCHAR yield)VOID:
    FOR i FROM LWB string TO UPB string DO yield(string[i]) OD;
  gen char DOCONV yield
);

CO Prosser/Thompson UTF8 encoding scheme
Bits Last code point Byte 1   Byte 2   Byte 3   Byte 4   Byte 5   Byte 6
 7   U+007F          0xxxxxxx
11   U+07FF          110xxxxx 10xxxxxx
16   U+FFFF          1110xxxx 10xxxxxx 10xxxxxx
21   U+1FFFFF        11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
26   U+3FFFFFF       111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
31   U+7FFFFFFF      1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
END CO

# Quickly calculate the length of the UTF8 encoded string #
PROC upb utf8 = (STRING utf8 string)INT:(
  INT bytes to go := 0;
  INT upb := 0;
  FOR i FROM LWB utf8 string TO UPB utf8 string DO
    CHAR byte := utf8 string[i];
    IF bytes to go = 0 THEN # start new utf char #
      bytes to go :=
        IF   ABS byte <= ABS 2r01111111 THEN 1 #  7 bits #
        ELIF ABS byte <= ABS 2r11011111 THEN 2 # 11 bits #
        ELIF ABS byte <= ABS 2r11101111 THEN 3 # 16 bits #
        ELIF ABS byte <= ABS 2r11110111 THEN 4 # 21 bits #
        ELIF ABS byte <= ABS 2r11111011 THEN 5 # 26 bits #
        ELIF ABS byte <= ABS 2r11111101 THEN 6 # 31 bits #
        ELSE raise value error(("Invalid UTF-8 bytes", BIN ABS byte)); ~ FI
    FI;
    bytes to go -:= 1; # skip over trailing bytes #
    IF bytes to go = 0 THEN upb +:= 1 FI
  OD;
  upb
);

# Convert a stream of CHAR into a stream of UNICHAR #
OP DOCONV = (GENCHAR gen char, YIELDUNICHAR yield)VOID: (
  INT bytes to go := 0;
  INT lshift;
  BITS mask, out;

  # FOR CHAR byte IN # gen char( # ) DO ( #
  ##   (CHAR byte)VOID: (
      INT bits := ABS byte;
      IF bytes to go = 0 THEN # start new unichar #
        bytes to go :=
          IF   bits <= ABS 2r01111111 THEN 1 #  7 bits #
          ELIF bits <= ABS 2r11011111 THEN 2 # 11 bits #
          ELIF bits <= ABS 2r11101111 THEN 3 # 16 bits #
          ELIF bits <= ABS 2r11110111 THEN 4 # 21 bits #
          ELIF bits <= ABS 2r11111011 THEN 5 # 26 bits #
          ELIF bits <= ABS 2r11111101 THEN 6 # 31 bits #
          ELSE raise value error(("Invalid UTF-8 bytes", BIN bits)); ~ FI;
        IF bytes to go = 1 THEN
          lshift := 7; mask := 2r1111111
        ELSE
          lshift := 7 - bytes to go; mask :=  BIN(ABS(2r1 SHL lshift)-1)
        FI;
        out := mask AND BIN bits;

        lshift := 6; mask := 2r111111 # subsequently pic 6 bits at a time #
      ELSE
        out := (out SHL lshift) OR ( mask AND BIN bits)
      FI;
      bytes to go -:= 1;
      IF bytes to go = 0 THEN yield(INITUNICHAR out) FI
  # OD # ))
);

# Convert a string of UNICHAR into a stream of UTFCHAR #
OP DOCONV = (UNICODE unicode, YIELDCHAR yield)VOID:(
  PROC gen unichar = (YIELDUNICHAR yield)VOID:
    FOR i FROM LWB unicode TO UPB unicode DO yield(unicode[i]) OD;
  gen unichar DOCONV yield
);

# Some convenience/shorthand U operators #
# Convert a BITS into a UNICODE char #
OP U = (BITS bits)UNICHAR:
  INITUNICHAR bits;

# Convert a []BITS into a UNICODE char #
OP U = ([]BITS array bits)[]UNICHAR:(
  [LWB array bits:UPB array bits]UNICHAR out;
  FOR i FROM LWB array bits TO UPB array bits DO bits OF out[i]:=array bits[i] OD;
  out
);

# Convert a CHAR into a UNICODE char #
OP U = (CHAR char)UNICHAR:
  INITUNICHAR char;

# Convert a STRING into a UNICODE string #
OP U = (STRING utf8 string)UNICODE: (
  FLEX[upb utf8(utf8 string)]UNICHAR out;
  INT i := 0;
# FOR UNICHAR char IN # utf8 string DOCONV (
##   (UNICHAR char)VOID:
       out[i+:=1] := char
# OD #);
  out
);

# Convert a UNICODE string into a UTF8 STRING #
OP REPR = (UNICODE string)STRING: (
  STRING out;
# FOR CHAR char IN # string DOCONV (
##   (CHAR char)VOID: (
       out +:= char
# OD #));
  out
);

# define the most useful OPerators on UNICODE CHARacter arrays #
# Note: LWB, UPB and slicing works as per normal #

OP + = (UNICODE a,b)UNICODE: (
  [UPB a + UPB b]UNICHAR out;
  out[:UPB a]:= a; out[UPB a+1:]:= b;
  out
);

OP + = (UNICODE a, UNICHAR b)UNICODE: a+UNICODE(b);
OP + = (UNICHAR a, UNICODE b)UNICODE: UNICODE(a)+b;
OP + = (UNICHAR a,b)UNICODE: UNICODE(a)+b;

# Suffix a character to the end of a UNICODE string #
OP +:= = (REF UNICODE a, UNICODE b)VOID: a := a + b;
OP +:= = (REF UNICODE a, UNICHAR b)VOID: a := a + b;

# Prefix a character to the beginning of a UNICODE string #
OP +=: = (UNICODE b, REF UNICODE a)VOID: a := b + a;
OP +=: = (UNICHAR b, REF UNICODE a)VOID: a := b + a;

OP * = (UNICODE a, INT n)UNICODE: (
  UNICODE out := a;
  FOR i FROM 2 TO n DO out +:= a OD;
  out
);
OP * = (INT n, UNICODE a)UNICODE: a * n;

OP * = (UNICHAR a, INT n)UNICODE: UNICODE(a)*n;
OP * = (INT n, UNICHAR a)UNICODE: n*UNICODE(a);

OP *:= = (REF UNICODE a, INT b)VOID: a := a * b;

# Wirthy Operators #
OP LT = (UNICHAR a,b)BOOL: ABS bits OF a LT ABS bits OF b,
   LE = (UNICHAR a,b)BOOL: ABS bits OF a LE ABS bits OF b,
   EQ = (UNICHAR a,b)BOOL: ABS bits OF a EQ ABS bits OF b,
   NE = (UNICHAR a,b)BOOL: ABS bits OF a NE ABS bits OF b,
   GE = (UNICHAR a,b)BOOL: ABS bits OF a GE ABS bits OF b,
   GT = (UNICHAR a,b)BOOL: ABS bits OF a GT ABS bits OF b;

# ASCII OPerators #
OP <  = (UNICHAR a,b)BOOL: a LT b,
   <= = (UNICHAR a,b)BOOL: a LE b,
    = = (UNICHAR a,b)BOOL: a EQ b,
   /= = (UNICHAR a,b)BOOL: a NE b,
   >= = (UNICHAR a,b)BOOL: a GE b,
   >  = (UNICHAR a,b)BOOL: a GT b;

# Non ASCII OPerators
OP ≤ = (UNICHAR a,b)BOOL: a LE b,
   ≠ = (UNICHAR a,b)BOOL: a NE b,
   ≥ = (UNICHAR a,b)BOOL: a GE b;
#

# Compare two UNICODE strings for equality #
PROC unicode cmp = (UNICODE str a,str b)INT: (

  IF LWB str a > LWB str b THEN exit lt ELIF LWB str a < LWB str b THEN exit gt FI;

  INT min upb = UPB(UPB str a < UPB str b | str a | str b );

  FOR i FROM LWB str a TO min upb DO
    UNICHAR a := str a[i], UNICHAR b := str b[i];
    IF a < b THEN exit lt ELIF a > b THEN exit gt FI
  OD;

  IF UPB str a > UPB str b THEN exit gt ELIF UPB str a < UPB str b THEN exit lt FI;

  exit eq:  0 EXIT
  exit lt: -1 EXIT
  exit gt:  1
);

OP LT = (UNICODE a,b)BOOL: unicode cmp(a,b)< 0,
   LE = (UNICODE a,b)BOOL: unicode cmp(a,b)<=0,
   EQ = (UNICODE a,b)BOOL: unicode cmp(a,b) =0,
   NE = (UNICODE a,b)BOOL: unicode cmp(a,b)/=0,
   GE = (UNICODE a,b)BOOL: unicode cmp(a,b)>=0,
   GT = (UNICODE a,b)BOOL: unicode cmp(a,b)> 0;

# ASCII OPerators #
OP <  = (UNICODE a,b)BOOL: a LT b,
   <= = (UNICODE a,b)BOOL: a LE b,
    = = (UNICODE a,b)BOOL: a EQ b,
   /= = (UNICODE a,b)BOOL: a NE b,
   >= = (UNICODE a,b)BOOL: a GE b,
   >  = (UNICODE a,b)BOOL: a GT b;

# Non ASCII OPerators
OP ≤ = (UNICODE a,b)BOOL: a LE b,
   ≠ = (UNICODE a,b)BOOL: a NE b,
   ≥ = (UNICODE a,b)BOOL: a GE b;
#

COMMENT - Todo: for all UNICODE and UNICHAR
  Add NonASCII OPerators: ×, ×:=,
  Add ASCII Operators: &, &:=, &=:
  Add Wirthy OPerators: PLUSTO, PLUSAB, TIMESAB for UNICODE/UNICHAR,
  Add UNICODE against UNICHAR comparison OPerators,
  Add char_in_string and string_in_string PROCedures,
  Add standard Unicode functions:
    to_upper_case, to_lower_case, unicode_block, char_count,
    get_directionality, get_numeric_value, get_type, is_defined,
    is_digit, is_identifier_ignorable, is_iso_control,
    is_letter, is_letter_or_digit, is_lower_case, is_mirrored,
    is_space_char, is_supplementary_code_point, is_title_case,
    is_unicode_identifier_part, is_unicode_identifier_start,
    is_upper_case, is_valid_code_point, is_whitespace
END COMMENT

test:(

  UNICHAR aircraft := U16r 2708;
  printf(($"aircraft: "$, $"16r"16rdddd$, UNICODE(aircraft), $g$, " => ", REPR UNICODE(aircraft), $l$));

  UNICODE chinese forty two = U16r 56db + U16r 5341 + U16r 4e8c;
  printf(($"chinese forty two: "$, $g$, REPR chinese forty two, ", length string = ", UPB chinese forty two, $l$));

  UNICODE poker = U "A123456789♥♦♣♠JQK";
  printf(($"poker: "$, $g$, REPR poker, ", length string = ", UPB poker, $l$));

  UNICODE selectric := U"×÷≤≥≠¬∨∧⏨→↓↑□⌊⌈⎩⎧○⊥¢";
  printf(($"selectric: "$, $g$, REPR selectric, $l$));
  printf(($"selectric*4: "$, $g$, REPR(selectric*4), $l$));

  print((
    "1 < 2 is ",  U"1" < U"2", ", ",
    "111 < 11 is ",U"111" < U"11", ", ",
    "111 < 12 is ",U"111" < U"12", ", ",
    "♥ < ♦ is ",  U"♥" < U"♦", ", ",
    "♥Q < ♥K is ",U"♥Q" < U"♥K", " & ",
    "♥J < ♥K is ",U"♥J" < U"♥K", new line
  ))

)


text: "你好"

print ["text:" text]
print ["length:" size text]
print ["contains string '好'?:" contains? text "好"]
print ["contains character '平'?:" contains? text `平`]
print ["text as ascii:" as.ascii text]


      VDU 23,22,640;512;8,16,16,128+8 : REM Select UTF-8 mode
      *FONT Times New Roman, 20

      PRINT "Arabic:"

      arabic1$ = "هنا مثال يمكنك من الكتابة من اليمين"
      arabic2$ = "الى اليسار باللغة العربية"

      VDU 23,16,2;0;0;0;13 : REM Select right-to-left printing
      PRINT FNarabic(arabic1$) ' FNarabic(arabic2$)
      VDU 23,16,0;0;0;0;13 : REM Select left-to-right printing

      PRINT '"Hebrew:"

      hebrew$ = "זוהי הדגמה של כתיבת טקסט בעברית מימין לשמאל"

      VDU 23,16,2;0;0;0;13 : REM Select right-to-left printing
      PRINT hebrew$
      VDU 23,16,0;0;0;0;13 : REM Select left-to-right printing

      END

      REM!Eject
      DEF FNarabic(A$)
      LOCAL A%, B%, L%, O%, P%, U%, B$
      A$ += CHR$0
      FOR A% = !^A$ TO !^A$+LENA$-1
        IF ?A%<&80 OR ?A%>=&C0 THEN
          L% = O% : O% = P% : P% = U%
          U% = ((?A% AND &3F) << 6) + (A%?1 AND &3F)
          IF ?A%<&80 U% = 0
          CASE TRUE OF
            WHEN U%=&60C OR U%=&61F: U% = 0
            WHEN U%<&622:
            WHEN U%<&626: U% = &01+2*(U%-&622)
            WHEN U%<&628: U% = &09+4*(U%-&626)
            WHEN U%<&62A: U% = &0F+4*(U%-&628)
            WHEN U%<&62F: U% = &15+4*(U%-&62A)
            WHEN U%<&633: U% = &29+2*(U%-&62F)
            WHEN U%<&63B: U% = &31+4*(U%-&633)
            WHEN U%<&641:
            WHEN U%<&648: U% = &51+4*(U%-&641)
            WHEN U%<&64B: U% = &6D+2*(U%-&648)
          ENDCASE
          IF P% IF P%<&80 THEN
            B% = P%
            IF O%=&5D IF P%<&5 B% += &74
            IF O%=&5D IF P%=&7 B% += &72
            IF O%=&5D IF P%=&D B% += &6E
            IF B%>P% B$=LEFT$(B$,LENB$-3) : O% = L%
            IF U% IF P%>7 IF P%<>&D IF P%<>&13 IF P%<>&29 IF P%<>&2B IF P%<>&2D IF P%<>&2F IF P%<>&6D IF P%<>&6F B% += 2
            IF O% IF O%>7 IF O%<>&D IF O%<>&13 IF O%<>&29 IF O%<>&2B IF O%<>&2D IF O%<>&2F IF O%<>&6D IF O%<>&6F B% += 1
            B$ = LEFT$(LEFT$(B$))+CHR$&EF+CHR$(&BA+(B%>>6))+CHR$(&80+(B%AND&3F))
          ENDIF
        ENDIF
        B$ += CHR$?A%
      NEXT
      = LEFT$(B$)


#include <stdio.h>
#include <stdlib.h>
#include <locale.h>

/* wchar_t is the standard type for wide chars; what it is internally
 * depends on the compiler.
 */
wchar_t poker[] = L"♥♦♣♠";
wchar_t four_two[] = L"\x56db\x5341\x4e8c";

int main() {
    /* Set the locale to alert C's multibyte output routines */
    if (!setlocale(LC_CTYPE, "")) {
        fprintf(stderr, "Locale failure, check your env vars\n");
        return 1;
    }

#ifdef __STDC_ISO_10646__
    /* C99 compilers should understand these */
    printf("%lc\n", 0x2708);    /* ✈ */
    printf("%ls\n", poker);     /* ♥♦♣♠ */
    printf("%ls\n", four_two);  /* 四十二 */
#else
    /* oh well */
    printf("airplane\n");
    printf("club diamond club spade\n");
    printf("for ty two\n");
#endif
    return 0;
}


(defvar ♥♦♣♠ "♥♦♣♠")
(defun ✈ () "a plane unicode function")


import std.stdio;
import std.uni; // standard package for normalization, composition/decomposition, etc..
import std.utf; // standard package for decoding/encoding, etc...

void main() {
    // normal identifiers are allowed
    int a;
    // unicode characters are allowed for identifers
    int δ;

    char c;  // 1 to 4 byte unicode character
    wchar w; // 2 or 4 byte unicode character
    dchar d; // 4 byte unicode character

    writeln("some text");     // strings by default are UTF8
    writeln("some text"c);    // optional suffix for UTF8
    writeln("こんにちは"c);      // unicode charcters are just fine (stored in the string type)
    writeln("Здравствуйте"w); // also avaiable are UTF16 string  (stored in the wstring type)
    writeln("שלום"d);         // and UTF32 strings (stored in the dstring type)

    // escape sequences like what is defined in C are also allowed inside of strings and characters.
}


public program()
{
    var 四十二 := "♥♦♣♠";     // UTF8 string
    var строка := "Привет"w;  // UTF16 string

    console.writeLine:строка;
    console.writeLine:四十二;
}


    var i int
    var u rune
    for i, u = range "voilà" {
        fmt.Println(i, u)
    }


 --raw-input    | -R :: each line of input is converted to a JSON string;
 --ascii-output | -a :: every non-ASCII character that would otherwise
                        be sent to output is translated to an equivalent
                        ASCII escape sequence;
 --raw-output   | -r :: output strings as raw strings, e.g. "a\nb" is
                        output as:


julia> 四十二 = "voilà";
julia> println(四十二)
voilà


// version 1.1.2

fun main(args: Array<String>) {
    val åäö = "as⃝df̅ ♥♦♣♠ 頰"
    println(åäö)
}


local(unicode = '♥♦♣♠')
#unicode -> append('\u9830')
#unicode
'
'
#unicode -> get (2)
'
'
#unicode -> get (4) -> integer


Font "Arial"
Mode 32
' M2000 internal editor can display  left to rigtht languages if text is in same line, and same color.
a$="لم أجد هذا الكتاب القديم"
' We can use console to display text, using proportional spacing
Print Part $(4), a$
Print
' We can display right to left using
' the legend statement which render text at a given
' graphic  point, specify the font type and font size
' and optional:
' rotation angle, justification (1 for right,2 for center, 3 for left)
'quality (0 or non 0, which 0 no antialliasing)
' letter spacing in twips (not good for arabic language)
move 6000,6000
legend  a$, "Arial", 32, pi/4, 2, 0
' Variables can use any unicode letter.
' Here we can't display it as in M2000 editor.
' in the editor we see at the left the variable name
' and at the right the value
القديم=10
Print القديم+1=11  ' true


{"AdobeStandard", "ASCII", "CP936", "CP949", "CP950", "Custom",
"EUC-JP", "EUC", "IBM-850", "ISO10646-1", "ISO8859-15", "ISO8859-1",
"ISO8859-2", "ISO8859-3", "ISO8859-4", "ISO8859-5", "ISO8859-6",
"ISO8859-7", "ISO8859-8", "ISO8859-9", "ISOLatin1", "ISOLatin2",
"ISOLatin3", "ISOLatin4", "ISOLatinCyrillic", "Klingon", "KOI8-R",
"MacintoshArabic", "MacintoshChineseSimplified",
"MacintoshChineseTraditional", "MacintoshCroatian",
"MacintoshCyrillic", "MacintoshGreek", "MacintoshHebrew",
"MacintoshIcelandic", "MacintoshKorean",
"MacintoshNonCyrillicSlavic", "MacintoshRomanian", "MacintoshRoman",
"MacintoshThai", "MacintoshTurkish", "MacintoshUkrainian", "Math1",
"Math2", "Math3", "Math4", "Math5", "Mathematica1", "Mathematica2",
"Mathematica3", "Mathematica4", "Mathematica5", "Mathematica6",
"Mathematica7", "PrintableASCII", "ShiftJIS", "Symbol", "Unicode",
"UTF8", "WindowsANSI", "WindowsBaltic", "WindowsCyrillic",
"WindowsEastEurope", "WindowsGreek", "WindowsThai", "WindowsTurkish",
"ZapfDingbats"}


#charset utf8
void main()
{
    string nånsense = "\u03bb \0344 \n";
    string hello = "你好";
    string 水果 = "pineapple";
    string 真相 = sprintf("%s, %s goes really well on pizza\n", hello, 水果);
    write( string_to_utf8(真相) );
    write( string_to_utf8(nånsense) );
}


#!/usr/bin/env python
# -*- coding: latin-1 -*-

u = 'abcdé'
print(ord(u[-1]))


#lang racket

;; Unicode in strings, using ascii
"\u03bb" ; -> "λ"
;; and since Racket source code is read in UTF-8, Unicode can be used
;; directly
"λ" ; -> same

;; The same holds for character constants
#\u3bb ; -> #\λ
#\λ    ; -> same

;; And of course Unicode can be used in identifiers,
(define √ sqrt)
(√ 256) ; -> 16
;; and in fact the standard language makes use of some of these
(λ(x) x) ; -> an identity function


sub prefix:<∛> (\𝐕) { 𝐕 ** (1/3) }
say ∛27;  # prints 3


see "Hello, World!"

func ringvm_see cText
     ring_see("I can play with the string before displaying it" + nl)
     ring_see("I can convert it :D" + nl)
     ring_see("Original Text: " + cText + nl)
     if cText = "Hello, World!"
        # Convert it from English to Hindi
        cText = "नमस्ते दुनिया!"
     ok
     ring_see("Converted To (Hindi): " + cText + nl)


object UTF8 extends App {

  def charToInt(s: String) = {
    def charToInt0(c: Char, next: Char): Option[Int] = (c, next) match {
      case _ if (c.isHighSurrogate && next.isLowSurrogate) =>
        Some(java.lang.Character.toCodePoint(c, next))
      case _ if (c.isLowSurrogate) => None
      case _                       => Some(c.toInt)
    }

    if (s.length > 1) charToInt0(s(0), s(1)) else Some(s.toInt)
  }

  def intToChars(n: Int) = java.lang.Character.toChars(n).mkString

  println('\uD869'.isHighSurrogate + " " + '\uDEA5'.isLowSurrogate)

  println(charToInt("\uD869\uDEA5"))

  val b = "\uD869\uDEA5"
  println(b)

  val c = "\uD834\uDD1E"
  println(c)

  val a = "$abcde¢£¤¥©ÇßçĲĳŁłʒλπ•₠₡₢₣₤₥₦₧₨₩₪₫€₭₮₯₰₱₲₳₴₵₵←→⇒∙⌘☺☻ア字文𪚥".
    map(c => "%s\t\\u%04X".format(c, c.toInt)).foreach(println)
}


let flag = "🇵🇷"
print(flag.characters.count)
// Prints "1"
print(flag.unicodeScalars.count)
// Prints "2"
print(flag.utf16.count)
// Prints "4"
print(flag.utf8.count)
// Prints "8"

let nfc = "\u{01FA}"//Ǻ LATIN CAPITAL LETTER A WITH RING ABOVE AND ACUTE
let nfd = "\u{0041}\u{030A}\u{0301}"//Latin Capital Letter A + ◌̊ COMBINING RING ABOVE + ◌́ COMBINING ACUTE ACCENT
let nfkx = "\u{FF21}\u{030A}\u{0301}"//Fullwidth Latin Capital Letter A + ◌̊ COMBINING RING ABOVE + ◌́ COMBINING ACUTE ACCENT
print(nfc == nfd) //NFx: true
print(nfc == nfkx) //NFKx: false


# International class; name and street
 class 国際( なまえ, Straße ) {

    # Say who am I!
    method 言え {
        say "I am #{self.なまえ} from #{self.Straße}";
    }
}

 # all the people of the world!
 var 民族 = [
              国際( "高田　Friederich", "台湾" ),
              国際( "Smith Σωκράτης", "Cantù" ),
              国際( "Stanisław Lec", "południow" ),
            ];

民族.each { |garçon|
    garçon.言え;
}


@{TITLE /[あ-ん一-耙]+/} (@ROMAJI/@ENGLISH)
@(freeform)
@(coll)@{STANZA /[^\n\x3000 ]+/}@(end)@/.*/


stdout.printf ("UTF-8 encoded string. Let's go to a café!");


Module Module1

    Sub Main()
        Console.OutputEncoding = Text.Encoding.Unicode

        ' normal identifiers allowed
        Dim a = 0
        ' unicode characters allowed
        Dim δ = 1

        ' ascii strings
        Console.WriteLine("some text")
        ' unicode strings strings
        Console.WriteLine("こんにちは")
        Console.WriteLine("Здравствуйте")
        Console.WriteLine("שלום")
        ' escape sequences
        Console.WriteLine(vbTab + "text" + vbTab + ChrW(&H2708) + """blue")
        Console.ReadLine()
    End Sub

End Module


let プリント t => io.writeln io.stdout t;

プリント 'これは実験です。';


var w = "voilà"
for (c in w) {
    System.write("%(c) ") // prints the 5 Unicode 'characters'.
}
System.print("\nThe length of %(w) is %(w.count)")

System.print("\nIts code-points are:")
for (cp in w.codePoints) {
    System.write("%(cp) ") // prints the code-points as numbers
}

System.print("\n\nIts bytes are: ")
for (b in w.bytes) {
    System.write("%(b) ") // prints the bytes as numbers
}

var zwe = "👨👩👧"
System.print("\n\n%(zwe) has:")
System.print("  %(zwe.bytes.count) bytes: %(zwe.bytes.toList.join(" "))")
System.print("  %(zwe.codePoints.count) code-points: %(zwe.codePoints.toList.join(" "))")
System.print("  %(Graphemes.clusterCount(zwe)) grapheme")


dma:		equ	80h
puts:		equ	9h		; Write string to console
sfirst:		equ	11h		; Find first matching file
snext:		equ	12h		; Get next matching file
		org	100h
		;;;	First, retrieve all filenames in current directory
		;;;	CP/M has function 11h (sfirst) and function 13h (snext)
		;;;	to return the first, and then following, files that
		;;;	match a wildcard.
		lxi	d,0		; Amount of files
		push	d 		; Push on stack
		lxi	h,fnames	; Start of area to save names
		push	h 		; Push on stack
		lxi	d,fcb		; FCB that will match any file
		mvi	c,sfirst	; Get the first file
getnames:	call	5		; Call CP/M BDOS
		inr	a
		jz	namesdone	; FF = we have all files
		dcr	a		; Dir entry is at DMA+32*A
		rrc			; Rotate 3 right, same as
		rrc			; rotate 5 left, *32
		rrc
		adi	dma+1		; Add DMA offset + 1 (filename offset)
		mov	e,a		; Low byte of address
		mvi	d,0		; High byte is 0
		mvi	b,8		; Filename is 8 bytes
		pop	h		; Get pointer to name area
		call	memcpy		; Copy the name
		mvi	m,' '		; Separate name and extension
		inx	h
		mvi	b,3		; Extension is 3 bytes
		call 	memcpy		; Copy the extension
		mvi	m,13		; While we're at it, terminate
		inx	h		; the filename with \r\n
		mvi 	m,10
		inx	h
		pop	d		; Get amount of files
		inx	d		; Increment it (we've added a file)
		push 	d 		; Put it back onto the stack
		push	h		; Put the name pointer on the stack too
		mvi	c,snext		; Go get the next file
		jmp	getnames
namesdone:	pop	h		; Terminate the file list with $
		mvi	m,'$'		; so it can be printed with function 9
		;;;	CP/M does not keep its directory in sorted order,
		;;;	so we need to sort the list of files ourselves.
		;;;	What follows is a simple insertion sort.
		lxi	d,1		; DE (i) = 1
sortouter:	pop	h		; Get amount of files
		push	h
		call 	cmpdehl		; i < length(files)?
		jnc	sortdone	; If not, we're done
		push	d		; push i; DE (j) = i
sortinner:	push	d		; push j
		mov	a,d		; j > 0?
		ora	e
		jz	sortinnerdone	; If not, inner loop is done
		dcx	d		; DE = j-1
		call	lookup		; HL = files[j-1]
		push	h		; push files[j-1]
		inx	d		; DE = j
		call 	lookup		; HL = files[j]
		pop	d		; pop DE = files[j-1]
		push	d		; keep them across comparison
		push	h
		call 	cmpentries	; A[j] >= A[j-1]?
		pop	h
		pop	d
		jc	sortinnerdone	; Then inner loop is done.
		mvi	b,12		; Otherwise we should swap them
swaploop:	ldax	d		; Get byte from files[j-1]
		mov	c,m		; Get byte from files[j]
		mov	m,a		; files[j][x]=files[j-1][x]
		mov	a,c		; files[j-1][x]=files[j]-[x]
		stax	d
		inx	h		; Increment pointers
		inx	d
		dcr	b		; all 12 bytes done yet?
		jnz	swaploop	; if not, swap next byte
		pop	d		; DE = j
		dcx	d		; j = j-1
		jmp	sortinner
sortinnerdone:	pop	d		; pop j
		pop	d		; pop i
		inx	d		; i = i + 1
		jmp	sortouter
sortdone:	pop	h		; Remove file count from stack
		;;;	We're done sorting the list, print it.
		lxi	d,fnames	; Print the now sorted list of files
		mvi	c,puts
		jmp	5
		;;;	Subroutine: compare entries under DE and HL
cmpentries:	mvi	b,12		; Each entry has 12 relevant bytes.
cmploop:	ldax	d		; Get byte from entry DE
		cmp	m 		; Compare with byte from entry HL
		rnz			; If they differ, we know the ordering
		inx	h		; Increment both pointers
		inx	d
		dcr	b 		; Decrement byte counter
		jnz	cmploop		; Compare next byte
		ret
		;;;	Subroutine: look up filename entry (HL=DE*14+fnames)
lookup:		push	d		; Save entry number
		mov	h,d
		mov	l,e
		dad	h		; HL = HL' * 2
		dad	d		; HL = HL' * 3
		dad	h		; HL = HL' * 6
		dad	d		; HL = HL' * 7
		dad	h		; HL = HL' * 14
		lxi	d,fnames	; Offset
		dad	d 		; Add the offset
		pop	d 		; Restore entry number
		ret
		;;;	Subroutine: compare DE and HL
cmpdehl:	mov	a,d
		cmp	h
		rnz
		mov	a,e
		cmp	l
		ret
		;;;	Subroutine: copy B bytes from DE to HL
memcpy:		ldax	d		; Get byte from source
		mov	m,a		; Store byte at destination
		inx	h		; Increment both pointers
		inx	d
		dcr	b		; Done yet?
		jnz	memcpy		; If not, copy next byte
		ret
		;;;	File control block used to specify wildcard
fcb:		db	0,'???????????'	; Accept any file
		ds	fcb+36-$	; Pad the FCB out to 36 bytes
fnames:


with Ada.Text_IO, Ada.Directories, Ada.Containers.Indefinite_Vectors;

procedure Directory_List is

   use Ada.Directories, Ada.Text_IO;
   Search: Search_Type; Found: Directory_Entry_Type;
   package SV is new Ada.Containers.Indefinite_Vectors(Natural, String);
   Result: SV.Vector;
   package Sorting is new SV.Generic_Sorting; use Sorting;
   function SName return String is (Simple_Name(Found));

begin
   -- search directory and store it in Result, a vector of strings
   Start_Search(Search, Directory => ".", Pattern =>"");
   while More_Entries(Search) loop
      Get_Next_Entry(Search, Found);
      declare
         Name: String := Simple_Name(Found);
      begin
         if Name(Name'First) /= '.' then
            Result.Append(Name);
         end if; -- ingnore filenames beginning with "."
      end;
   end loop; -- Result holds the entire directory in arbitrary order

   Sort(Result); -- Result holds the directory in proper order

   -- print Result
   for I in Result.First_Index .. Result.Last_Index loop
      Put_Line(Result.Element(I));
   end loop;
end Directory_List;


record r;
file f;
text s;

f.opendir(1.argv);

while (~f.case(s)) {
    if (s != "." && s != "..") {
        r[s] = 0;
    }
}

r.vcall(o_, 0, "\n");


# syntax: GAWK -f UNIX_LS.AWK * | SORT
BEGINFILE {
    printf("%s\n",FILENAME)
    nextfile
}
END {
    exit(0)
}


' Emulate ls
cnt% = 0
files$ = ""
OPEN CURDIR$ FOR DIRECTORY AS mydir
GETFILE myfile$ FROM mydir
WHILE ISTRUE(LEN(myfile$))
    IF LEFT$(myfile$, 1) != "." THEN
        INCR cnt%
        files$ = APPEND$(files$, cnt%, UNFLATTEN$(myfile$))
    ENDIF
    GETFILE myfile$ FROM mydir
WEND
CLOSE DIRECTORY mydir
IF cnt% > 0 THEN
    FOR f$ IN SORT$(files$)
        PRINT FLATTEN$(f$)
    NEXT
ENDIF


directory$ = dir("m:\foo\bar\")	#Specified directory
#directory$ = dir(currentdir)	#Current directory

while directory$ <> ""
	print directory$
	directory$ = dir()
end while
end


#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <limits.h>
#include <sys/types.h>
#include <dirent.h>
#include <unistd.h>

int cmpstr(const void *a, const void *b)
{
    return strcmp(*(const char**)a, *(const char**)b);
}

int main(void)
{
    DIR *basedir;
    char path[PATH_MAX];
    struct dirent *entry;
    char **dirnames;
    int diralloc = 128;
    int dirsize  = 0;

    if (!(dirnames = malloc(diralloc * sizeof(char*)))) {
        perror("malloc error:");
        return 1;
    }

    if (!getcwd(path, PATH_MAX)) {
        perror("getcwd error:");
        return 1;
    }

    if (!(basedir = opendir(path))) {
        perror("opendir error:");
        return 1;
    }

    while ((entry = readdir(basedir))) {
        if (dirsize >= diralloc) {
            diralloc *= 2;
            if (!(dirnames = realloc(dirnames, diralloc * sizeof(char*)))) {
                perror("realloc error:");
                return 1;
            }
        }
        dirnames[dirsize++] = strdup(entry->d_name);
    }

    qsort(dirnames, dirsize, sizeof(char*), cmpstr);

    int i;
    for (i = 0; i < dirsize; ++i) {
        if (dirnames[i][0] != '.') {
            printf("%s\n", dirnames[i]);
        }
    }

    for (i = 0; i < dirsize; ++i)
        free(dirnames[i]);
    free(dirnames);
    closedir(basedir);
    return 0;
}


using System;
using System.Collections.Generic;
using System.IO;
using System.Linq;
using System.Threading.Tasks;

namespace Unix_ls
{
    public class UnixLS
    {
        public static void Main(string[] args)
        {
            UnixLS ls = new UnixLS();
            ls.list(args.Length.Equals(0) ? "." : args[0]);
        }

        private void list(string folder)
        {
            foreach (FileSystemInfo fileSystemInfo in new DirectoryInfo(folder).EnumerateFileSystemInfos("*", SearchOption.TopDirectoryOnly))
            {
                Console.WriteLine(fileSystemInfo.Name);
            }
        }
    }
}


#include <iostream>
#include <set>
#include <boost/filesystem.hpp>

namespace fs = boost::filesystem;

int main(void)
{
    fs::path p(fs::current_path());
    std::set<std::string> tree;

    for (auto it = fs::directory_iterator(p); it != fs::directory_iterator(); ++it)
        tree.insert(it->path().filename().native());

    for (auto entry : tree)
        std::cout << entry << '\n';
}


(def files (sort (filter #(= "." (.getParent %)) (file-seq (clojure.java.io/file ".")))))

(doseq [n files] (println (.getName n)))


(defun files-list (&optional (path "."))
  (let* ((dir (concatenate 'string path "/"))
         (abs-path (car (directory dir)))
         (file-pattern (concatenate 'string dir "*"))
         (subdir-pattern (concatenate 'string file-pattern "/")))
    (remove-duplicates
       (mapcar (lambda (p) (enough-namestring p abs-path))
               (mapcan #'directory (list file-pattern subdir-pattern)))
       :test #'string-equal)))

(defun ls (&optional (path "."))
  (format t "~{~a~%~}" (sort (files-list path) #'string-lessp)))


void main() {
    import std.stdio, std.file, std.path, std.array, std.algorithm;

    foreach (const string path; dirEntries(getcwd, SpanMode.shallow).array.sort)
        path.baseName.writeln;
}


program LsCommand;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  System.IoUtils;

procedure Ls(folder: string = '.');
var
  offset: Integer;
  fileName: string;

  // simulate unix results in windows

  function ToUnix(path: string): string;
  begin
    Result := path.Replace('/', PathDelim, [rfReplaceAll])
  end;

begin
  folder := IncludeTrailingPathDelimiter(ToUnix(folder));
  offset := length(folder);

  for fileName in TDirectory.GetFileSystemEntries(folder, '*') do
    writeln(^I, ToUnix(fileName).Substring(offset));
end;

begin
  writeln('cd foo'#10'ls');
  ls('foo');

  writeln(#10'cd bar'#10'ls');
  ls('foo/bar');

  {$IFNDEF LINUX} readln; {$ENDIF}
end.


;; ls of stores (kind of folders)
(for-each writeln (list-sort < (local-stores))) →
    AGES
    NEMESIS
    info
    objects.dat
    reader
    system
    user
    words

;; ls of "NEMESIS" store
(for-each writeln (local-keys "NEMESIS")) →
    Alan
    Glory
    Jonah


iex(1)> ls = fn dir -> File.ls!(dir) |> Enum.each(&IO.puts &1) end
#Function<6.54118792/1 in :erl_eval.expr/5>
iex(2)> ls.("foo")
bar
:ok
iex(3)> ls.("foo/bar")
1
2
a
b
:ok


1> Ls = fun(Dir) ->
1> {ok, DirContents} = file:list_dir(Dir),
1> [io:format("~s~n", [X]) || X <- lists:sort(DirContents)]
1> end.
#Fun<erl_eval.6.36634728>
2> Ls("foo").
bar
[ok]
3> Ls("foo/bar").
1
2
a
b
[ok,ok,ok,ok]


let ls = DirectoryInfo(".").EnumerateFileSystemInfos() |> Seq.map (fun i -> i.Name) |> Seq.sort |> Seq.iter (printfn "%s")


256 buffer: filename-buf
: each-filename { xt -- }  \ xt-consuming variant
  s" ." open-dir throw { d }
  begin filename-buf 256 d read-dir throw while
    filename-buf swap xt execute
  repeat  d close-dir throw ;

\ immediate variant
: each-filename[  s" ." postpone sliteral ]] open-dir throw >r begin filename-buf 256 [email protected] read-dir throw while filename-buf swap [[ ; immediate compile-only
: ]each-filename  ]] repeat drop r> close-dir throw [[ ; immediate compile-only

: ls ( -- )  [: cr type ;] each-filename ;


      PROGRAM LS		!Names the files in the current directory.
      USE DFLIB			!Mysterious library.
      TYPE(FILE$INFO) INFO	!With mysterious content.
      NAMELIST /HIC/INFO	!This enables annotated output.
      INTEGER MARK,L		!Assistants.

      MARK = FILE$FIRST		!Starting state.
Call for the next file.
   10 L = GETFILEINFOQQ("*",INFO,MARK)	!Mystery routine returns the length of the file name.
      IF (MARK.EQ.FILE$ERROR) THEN	!Or possibly, not.
        WRITE (6,*) "Error!",L		!Something went wrong.
        WRITE (6,HIC)			!Reveal INFO, annotated.
        STOP "That wasn't nice."	!Quite.
      ELSE IF (IAND(INFO.PERMIT,FILE$DIR) .EQ. 0) THEN	!Not a directory.
        IF (L.GT.0) WRITE (6,*) INFO.NAME(1:L)	!The object of the exercise!
      END IF				!So much for that entry.
      IF (MARK.NE.FILE$LAST) GO TO 10	!Lastness is discovered after the last file is fingered.
      END	!If FILE$LAST is not reached, "system resources may be lost."


#include "dir.bi"

Sub ls(Byref filespec As String, Byval attrib As Integer)
    Dim As String filename = Dir(filespec, attrib)
    Do While Len(filename) > 0
        Print filename
        filename = Dir()
    Loop
End Sub

Dim As String directory = ""     ' Current directory
ls(directory & "*", fbDirectory)
Sleep


for f = sort[files["."], {|a,b| lexicalCompare[a.getName[], b.getName[]]}]
   println[f.getName[]]


import io.File

for f <- sort( list(File( "." ).list()).filterNot(s -> s.startsWith(".")) )
    println( f )


###sysinclude dir.uh
###sysinclude stringextra.uh

###define COLORS
// delete the COLORS directive above if you do not want colored output!
{ „vonal”  __usebigbossnamespace myself "-" 90 makestring() }
{ „points” __usebigbossnamespace myself "." 60 makestring() }
#g argc 3 < { "." }{ 2 argv } sto mypath
@mypath 'd !istrue { ."The give directory doesn't exist! Exited.\n" end }
@mypath getdir { ."Cannot load the dir! Aborted.\n" end } sto mydir

@mydir ~d {
."Directories:\n"
@mydir ~d  {| #s
@mydir 'd {} octalrights dup print free SPACE
@mydir 'd {} getfilename dup 37 stub print SPACE drop
@mydir 'd {} groupname ': !+
@mydir 'd {} ownername dup sto temp + dup 10 stub print free @temp free
@mydir 'd {} mtime dup print free
NL |}
@points sprint
@mydir ~d { ."Total: " @mydir ~d #g print ." subdirectories.\n" }
@vonal sprint
}
@mydir ~r {
."Regular files:\n"
@mydir ~r  {| #s
@mydir 'r {} octalrights dup print free SPACE
@mydir 'r {} getfilesize sbr §ifcolored
@mydir 'r {} executable { ." >" }{ ."  " } SPACE
@mydir 'r {} getfilename dup 37 stub print SPACE drop
@mydir 'r {} groupname ': !+
@mydir 'r {} ownername dup sto temp + dup 10 stub print free @temp free
@mydir 'r {} mtime dup print free
NL |}
@points sprint
@mydir ~r { ."Total: " @mydir ~r #g print ." regular files. "
."TotalSize = " @mydir 'r totalsize sbr §ifcolored NL
}
@vonal sprint
}
@mydir ~L {
."Symlinks:\n"
@mydir ~L  {| #s
@mydir 'L {} octalrights dup print free SPACE
@mydir 'L {} executable { .">" }{ SPACE } SPACE
@mydir 'L {} getfilename dup 67 stub print SPACE drop
@mydir 'L {} broken { ."--->" }{ ."===>" } SPACE
@mydir 'L {} destination dup 30 stub print drop
NL |}
@points sprint
@mydir ~L { ."Total: " @mydir ~L #g print ." symlinks.\n"
}
}
@vonal sprint
."Size, alltogether = " @mydir alltotal sbr §ifcolored NL
@vonal sprint
@mydir free
."Free spaces:   /* Total size of the filesystem is : " @mypath filesystemsize dup sto filsize sbr §ifcolored ." */\n"
."  for non-privilegized use: " @mypath freenonpriv dup sbr §ifcolored
#g 100 * @filsize / ." ( " print ."% ) " NL
."  All available free space: " @mypath totalfree dup sbr §ifcolored
#g 100 * @filsize / ." ( " print ."% ) " NL
end

ifcolored:
###ifdef COLORS
coloredsize
###endif
###ifndef COLORS
#g !(#s) 21 >|
###endif
dup sprint free
rts

{ „filsize” }
{ „mydir” }
{ „mypath” }
{ „temp” }
{ „makestring” #s * dup 10 !+ swap free #g = }


Public Sub Main()
Dim sDir As String[] = Dir(User.Home &/ "test").Sort()

Print sDir.Join(gb.NewLine)

End


package main

import (
	"fmt"
	"log"
	"os"
	"sort"
)

func main() {
	f, err := os.Open(".")
	if err != nil {
		log.Fatal(err)
	}
	files, err := f.Readdirnames(0)
	f.Close()
	if err != nil {
		log.Fatal(err)
	}
	sort.Strings(files)
	for _, n := range files {
		fmt.Println(n)
	}
}


import Control.Monad
import Data.List
import System.Directory

dontStartWith = flip $ (/=) . head

main = do
  files <- getDirectoryContents "."
  mapM_ putStrLn $ sort $ filter (dontStartWith '.') files


   dir ''       NB. includes properties
   >1 1 dir ''  NB. plain filename as per task


package rosetta;

import java.io.IOException;
import java.nio.file.Files;
import java.nio.file.Path;

public class UnixLS {

	public static void main(String[] args) throws IOException {
		Files.list(Path.of("")).sorted().forEach(System.out::println);
	}
}


const fs = require('fs');
fs.readdir('.', (err, names) => names.sort().map( name => console.log(name) ));


# help File.glob
File.glob(pattern:regexp|string|null='*', options:function|object|null=void):array
Return list of files in dir with optional pattern match.
With no arguments (or null) returns all files/directories in current directory.
The first argument can be a pattern (either a glob or regexp) of the files to return.
When the second argument is a function, it is called with each path, and filter on false.
Otherwise second argument must be a set of options.


# v0.6.0

for e in readdir() # Current directory
    println(e)
end

# Same for...
readdir("~") # Read home directory
readdir("~/documents")


// Version 1.2.41

import java.io.File

fun ls(directory: String) {
    val d = File(directory)
    if (!d.isDirectory) {
        println("$directory is not a directory")
        return
    }
    d.listFiles().map { it.name }
                 .sortedBy { it.toLowerCase() }  // case insensitive
                 .forEach { println(it) }
}

fun main(args: Array<String>) {
    ls(".")  // list files in current directory, say
}


#!/bin/ksh

# List everything in the current folder (sorted), similar to `ls`

#	# Variables:
#
targetDir=${1:-/tmp/foo}

 ######
# main #
 ######

cd ${targetDir}
for obj in *; do
	print ${obj}
done


set the defaultFolder to "/foo"
put the folders & the files
set the defaultFolder to "/foo/bar"
put the folders & the files


require("lfs")
for file in lfs.dir(".") do print(file) end


import Nanoquery.IO
import sort

fnames = sort(new(File).listDir("."))

for i in range(0, len(fnames) - 1)
    println fnames[i]
end


from algorithm import sorted
from os import walkPattern
from sequtils import toSeq

for path in toSeq(walkPattern("*")).sorted:
  echo path


class Test {
  function : Main(args : String[]) ~ Nil {
    file_names := System.IO.File.Directory->List(".");
    each(i : file_names) {
      file_name := file_names[i];
      if(System.IO.File.Directory->Exists(file_name)) {
        file_name += '/';
      };
      file_name->PrintLine();
    };
  }
}


let () =
  Array.iter print_endline (
    Sys.readdir Sys.argv.(1) )


Program ls;	{To list the names of all files/directories in the current directory.}
 Uses DOS;
 var DirInfo: SearchRec;	{Predefined. See page 403 of the Turbo Pascal 4 manual.}
 BEGIN
  FindFirst('*.*',AnyFile,DirInfo);	{AnyFile means any file name OR directory name.}
  While DOSerror = 0 do			{Result of FindFirst/Next not being a function, damnit.}
   begin
    WriteLn(DirInfo.Name);
    FindNext(DirInfo);
   end;
 END.


opendir my $handle, '.' or die "Couldnt open current directory: $!";
while (readdir $handle) {
    print "$_\n";
}
closedir $handle;


without js -- (file i/o)
pp(dir("."),{pp_Nest,1,pp_IntCh,false})


<?php
foreach(scandir('.') as $fileName){
    echo $fileName."\n";
}


import os, util.
main =>
  println(ls()),
  println(ls("foo/bar")).

ls() = ls(".").
ls(Path) = [F : F in listdir(Path), F != ".",F != ".."].sort.join('\n').


foreach(sort(get_dir()), string file)
    write(file +"\n");


# Prints Name, Length, Mode, and LastWriteTime
Get-ChildItem | Sort-Object Name | Write-Output

# Prints only the name of each file in the directory
Get-ChildItem | Sort-Object Name | ForEach-Object Name | Write-Output


NewList lslist.s()

If OpenConsole("ls-sim")
  If ExamineDirectory(0,GetCurrentDirectory(),"*.*")
    While NextDirectoryEntry(0)
      AddElement(lslist()) : lslist()=DirectoryEntryName(0)
    Wend
    FinishDirectory(0)
    SortList(lslist(),#PB_Sort_Ascending)
    ForEach lslist()
      PrintN(lslist())
    Next
  EndIf
  Input()
EndIf


>>> import os
>>> print('\n'.join(sorted(os.listdir('.'))))
DLLs
Doc
LICENSE.txt
Lib
NEWS.txt
README.txt
Scripts
Tools
include
libs
python.exe
pythonw.exe
tcl
>>>


cat(paste(list.files(), collapse  = "\n"), "\n")
cat(paste(list.files("bar"), collapse = "\n"), "\n")


#lang racket/base

;; Racket's `directory-list' produces a sorted list of files
(define (ls) (for-each displayln (directory-list)))

;; Code to run when this file is running directly
(module+ main
  (ls))

(module+ test
  (require tests/eli-tester racket/port racket/file)
  (define (make-directory-tree)
    (make-directory* "foo/bar")
    (for ([f '("1" "2" "a" "b")])
      (with-output-to-file (format "foo/bar/~a"f) #:exists 'replace newline)))
  (make-directory-tree)
  (define (ls/str dir)
    (parameterize ([current-directory dir]) (with-output-to-string ls)))
  (test (ls/str "foo") => "bar\n"
        (ls/str "foo/bar") => "1\n2\na\nb\n"))


/*REXX program lists contents of current folder  (ala mode UNIX's  LS). */
'DIR  /b  /oN'                         /*use Windows DIR: sorts & lists.*/
                                       /*stick a fork in it, we're done.*/


files #f, DefaultDir$ + "\*.*" 	' RunBasic Default directory.. Can be any directroy
print "rowcount: ";#f ROWCOUNT()		' how many rows in directory
#f DATEFORMAT("mm/dd/yy") 			'set format of file date or not
#f TIMEFORMAT("hh:mm:ss") 			'set format of file time or not
count = #f rowcount()
for i = 1 to count				' loop thru the row count
print "info: ";#f nextfile$()			' file info
print "name: ";#f NAME$()			' Name of file
print "size: ";#f SIZE()			' size
print "date: ";#f DATE$()			' date
print "time: ";#f TIME$()			' time
print "isdir: ";#f ISDIR()			' 1 = is a directory
next


use std::{env, fmt, fs, process};
use std::io::{self, Write};
use std::path::Path;

fn main() {
    let cur = env::current_dir().unwrap_or_else(|e| exit_err(e, 1));
    let arg = env::args().nth(1);
    print_files(arg.as_ref().map_or(cur.as_path(), |p| Path::new(p)))
        .unwrap_or_else(|e| exit_err(e, 2));
}

#[inline]
fn print_files(path: &Path) -> io::Result<()> {
    for x in try!(fs::read_dir(path)) {
        println!("{}", try!(x).file_name().to_string_lossy());
    }
    Ok(())
}

#[inline]
fn exit_err<T>(msg: T, code: i32) -> ! where T: fmt::Display {
    writeln!(&mut io::stderr(), "{}", msg).expect("Could not write to stderr");
    process::exit(code)
}


variable d = listdir(getcwd()), p;
foreach p (array_sort(d))
  () = printf("%s\n", d[p] );


scala> new java.io.File("/").listFiles.sorted.foreach(println)
/bin
/boot
/core
/dev
/etc
/home
/lib
/lib64
/local
/lost+found
/media
/mnt
/opt
/proc
/root
/run
/sbin
/selinux
/srv
/sys
/tmp
/user
/usr
/var


BEGIN # find some untouchable numbers - numbers not equal to the sum of the   #
      # proper divisors of any +ve integer                                    #
    INT max untouchable = 1 000 000;
    # a table of the untouchable numbers                                      #
    [ 1 : max untouchable ]BOOL untouchable; FOR i TO UPB untouchable DO untouchable[ i ] := TRUE OD;
    # show the counts of untouchable numbers found                            #
    PROC show untouchable statistics = VOID:
         BEGIN
            print( ( "Untouchable numbers:", newline ) );
            INT u count := 0;
            FOR i TO UPB untouchable DO
                IF untouchable[ i ] THEN u count +:= 1 FI;
                IF i =        10
                OR i =       100
                OR i =     1 000
                OR i =    10 000
                OR i =   100 000
                OR i = 1 000 000
                THEN
                    print( ( whole( u count, -7 ), " to ", whole( i, -8 ), newline ) )
                FI
            OD
         END; # show untouchable counts #
    # prints the untouchable numbers up to n                                  #
    PROC print untouchables = ( INT n )VOID:
         BEGIN
            print( ( "Untouchable numbers up to ", whole( n, 0 ), newline ) );
            INT u count := 0;
            FOR i TO n DO
                IF untouchable[ i ] THEN
                    print( ( whole( i, -4 ) ) );
                    IF u count +:= 1;
                       u count MOD 16 = 0
                    THEN print( ( newline ) )
                    ELSE print( ( " " ) )
                    FI
                FI
            OD;
            print( ( newline ) );
            print( ( whole( u count, -7 ), " to ", whole( n, -8 ), newline ) )
         END; # print untouchables #
    # find the untouchable numbers                                            #
    # to find untouchable numbers up to e.g.: 10 000, we need to sieve up to  #
    # 10 000 ^2 i.e. 100 000 000                                              #
    # however if we also use the facts that no untouchable = prime + 1        #
    # and no untouchable = odd prime + 3 and 5 is (very probably) the only    #
    # odd untouchable, other samples suggest we can use limit * 64 to find    #
    # untlouchables up to 1 000 000 - experimentation reveals this to be true #
    # assume the conjecture that there are no odd untouchables except 5       #
    BEGIN
        untouchable[ 1 ] := FALSE;
        untouchable[ 3 ] := FALSE;
        FOR i FROM 7 BY 2 TO UPB untouchable DO untouchable[ i ] := FALSE OD
    END;
    # sieve the primes to max untouchable and flag the non untouchables       #
    BEGIN
        PR read "primes.incl.a68" PR
        []BOOL prime = PRIMESIEVE max untouchable;
        FOR i FROM 3 BY 2 TO UPB prime DO
            IF prime[ i ] THEN
                IF i < max untouchable THEN
                    untouchable[ i + 1 ] := FALSE;
                    IF i < ( max untouchable - 2 ) THEN
                        untouchable[ i + 3 ] := FALSE
                    FI
                FI
            FI
        OD;
        untouchable[ 2 + 1 ] := FALSE # special case for the only even prime  #
    END;
    # construct the proper divisor sums and flag the non untouchables         #
    BEGIN
        [ 1 : max untouchable * 64 ]INT spd;
        FOR i TO UPB spd DO spd[ i ] := 1 OD;
        FOR i FROM 2 TO UPB spd DO
            FOR j FROM i + i BY i TO UPB spd DO spd[ j ] +:= i OD
        OD;
        FOR i TO UPB spd DO
            IF spd[ i ] <= UPB untouchable THEN untouchable[ spd[ i ] ] := FALSE FI
        OD
    END;
    # show the untouchable numbers up to 2000                                 #
    print untouchables( 2 000 );
    # show the counts of untouchable numbers                                  #
    show untouchable statistics
END


$ include "seed7_05.s7i";
  include "osfiles.s7i";

const proc: main is func
  local
    var string: name is "";
  begin
    for name range readDir(".") do
       writeln(name);
    end for;
  end func;


var content = [];
Dir.cwd.open.each { |file|
    file ~~ < . .. > && next;
    content.append(file);
}

content.sort.each { |file|
    say file;
}


Stdout printCR: ( PipeStream outputFromCommand:'ls' )


puts [join [lsort [glob -nocomplain *]] "\n"]


decl file f
decl string<> fnames
set fnames (sort (f.listdir "."))

for (decl int i) (< i (size fnames)) (inc i)
        out fnames<i> endl console
end for


// Untouchable Numbers : Nigel Galloway - March 4th., 2021;
#include <functional>
#include <bitset>
#include <iostream>
#include <cmath>
using namespace std; using Z0=long long; using Z1=optional<Z0>; using Z2=optional<array<int,3>>; using Z3=function<Z2()>;
const int maxUT{3000000}, dL{(int)log2(maxUT)};
struct uT{
  bitset<maxUT+1>N; vector<int> G{}; array<Z3,int(dL+1)>L{Z3{}}; int sG{0},mUT{};
  void _g(int n,int g){if(g<=mUT){N[g]=false; return _g(n,n+g);}}
  Z1 nxt(const int n){if(n>mUT) return Z1{}; if(N[n]) return Z1(n); return nxt(n+1);}
  Z3 fN(const Z0 n,const Z0 i,int g){return [=]()mutable{if(g<sG && ((n+i)*(1+G[g])-n*G[g]<=mUT)) return Z2{{n,i,g++}}; return Z2{};};}
  Z3 fG(Z0 n,Z0 i,const int g){Z0 e{n+i},l{1},p{1}; return [=]()mutable{n=n*G[g]; p=p*G[g]; l=l+p; i=e*l-n; if(i<=mUT) return Z2{{n,i,g}}; return Z2{};};}
  void fL(Z3 n, int g){for(;;){
    if(auto i=n()){N[(*i)[1]]=false; L[g+1]=fN((*i)[0],(*i)[1],(*i)[2]+1); g=g+1; continue;}
    if(auto i=L[g]()){n=fG((*i)[0],(*i)[1],(*i)[2]); continue;}
    if(g>0) if(auto i=L[g-1]()){ g=g-1; n=fG((*i)[0],(*i)[1],(*i)[2]); continue;}
    if(g>0){ n=[](){return Z2{};}; g=g-1; continue;} break;}
  }
  int count(){int g{0}; for(auto n=nxt(0); n; n=nxt(*n+1)) ++g; return g;}
  uT(const int n):mUT{n}{
    N.set(); N[0]=false; N[1]=false; for(auto n=nxt(0);*n<=sqrt(mUT);n=nxt(*n+1)) _g(*n,*n+*n); for(auto n=nxt(0); n; n=nxt(*n+1)) G.push_back(*n); sG=G.size();
    N.set(); N[0]=false; L[0]=fN(1,0,0); fL([](){return Z2{};},0);
  }
};


import os

fn main() {
	contents := os.ls('.')?
    println(contents)
}


import "io" for Directory

var path = "./" // or whatever

// Note that output is automatically sorted using this method.
Directory.list(path).each { |f| System.print(f) }


string 0;
char S;
[S:= "ls";
asm {   ldr     r0, S
        bl      system
    }
]


program Untouchable_numbers;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

function SumDivisors(n: Integer): Integer;
begin
  Result := 1;
  var k := 2;
  if not odd(n) then
    k := 1;
  var i := 1 + k;
  while i * i <= n do
  begin
    if (n mod i) = 0 then
    begin
      inc(Result, i);
      var j := n div i;
      if j <> i then
        inc(Result, j);
    end;
    inc(i, k);
  end;
end;

function Sieve(n: Integer): TArray<Boolean>;
begin
  inc(n);
  SetLength(result, n + 1);
  for var i := 6 to n do
  begin
    var sd := SumDivisors(i);
    if sd <= n then
      result[sd] := True;
  end;
end;

function PrimeSieve(limit: Integer): TArray<Boolean>;
begin
  inc(limit);
  SetLength(result, limit);
  Result[0] := True;
  Result[1] := True;

  var p := 3;
  repeat
    var p2 := p * p;
    if p2 >= limit then
      Break;
    var i := p2;
    while i < limit do
    begin

      Result[i] := True;
      inc(i, 2 * p);
    end;

    repeat
      inc(p, 2);
    until not Result[p];

  until (False);

end;

function Commatize(n: Double): string;
var
  fmt: TFormatSettings;
begin
  fmt := TFormatSettings.Create('en-US');
  Result := n.ToString(ffNumber, 64, 0, fmt);
end;

begin
  var limit := 1000000;
  var c := primeSieve(limit);
  var s := sieve(63 * limit);
  var untouchable: TArray<Integer> := [2, 5];
  var n := 6;
  while n <= limit do
  begin
    if not s[n] and c[n - 1] and c[n - 3] then
    begin
      SetLength(untouchable, Length(untouchable) + 1);
      untouchable[High(untouchable)] := n;
    end;
    inc(n, 2);
  end;
  writeln('List of untouchable numbers <= 2,000:');
  var count := 0;
  var i := 0;
  while untouchable[i] <= 2000 do
  begin
    write(commatize(untouchable[i]): 6);
    if ((i + 1) mod 10) = 0 then
      writeln;
    inc(i);
  end;
  writeln(#10#10, commatize(count): 7, ' untouchable numbers were found  <=     2,000');

  var p := 10;
  count := 0;
  for n in untouchable do
  begin
    inc(count);
    if n > p then
    begin
      var cc := commatize(count - 1);
      var cp := commatize(p);
      writeln(cc, ' untouchable numbers were found  <= ', cp);
      p := p * 10;
      if p = limit then
        Break;
    end;
  end;

  var cu := commatize(Length(untouchable));
  var cl := commatize(limit);
  writeln(cu:7, ' untouchable numbers were found  <= ', cl);
  readln;
end.


// Applied dendrology. Nigel Galloway: February 15., 2021
let uT a=let N,G=Array.create(a+1) true, [|yield! primes64()|>Seq.takeWhile((>)(int64 a))|]
         let fN n i e=let mutable p=e-1 in (fun()->p<-p+1; if p<G.Length && (n+i)*(1L+G.[p])-n*G.[p]<=(int64 a) then Some(n,i,p) else None)
         let fG n i e=let g=n+i in let mutable n,l,p=n,1L,1L
                          (fun()->n<-n*G.[e]; p<-p*G.[e]; l<-l+p; let i=g*l-n in if i<=(int64 a) then Some(n,i,e) else None)
         let rec fL n g=match n() with Some(f,i,e)->N.[(int i)]<-false; fL n ((fN f i (e+1))::g)
                                      |_->match g with n::t->match n() with Some (n,i,e)->fL (fG n i e) g |_->fL n t
                                                      |_->N.[0]<-false; N
         fL (fG 1L 0L 0) [fN 1L 0L 1]


package main

import "fmt"

func sumDivisors(n int) int {
    sum := 1
    k := 2
    if n%2 == 0 {
        k = 1
    }
    for i := 1 + k; i*i <= n; i += k {
        if n%i == 0 {
            sum += i
            j := n / i
            if j != i {
                sum += j
            }
        }
    }
    return sum
}

func sieve(n int) []bool {
    n++
    s := make([]bool, n+1) // all false by default
    for i := 6; i <= n; i++ {
        sd := sumDivisors(i)
        if sd <= n {
            s[sd] = true
        }
    }
    return s
}

func primeSieve(limit int) []bool {
    limit++
    // True denotes composite, false denotes prime.
    c := make([]bool, limit) // all false by default
    c[0] = true
    c[1] = true
    // no need to bother with even numbers over 2 for this task
    p := 3 // Start from 3.
    for {
        p2 := p * p
        if p2 >= limit {
            break
        }
        for i := p2; i < limit; i += 2 * p {
            c[i] = true
        }
        for {
            p += 2
            if !c[p] {
                break
            }
        }
    }
    return c
}

func commatize(n int) string {
    s := fmt.Sprintf("%d", n)
    if n < 0 {
        s = s[1:]
    }
    le := len(s)
    for i := le - 3; i >= 1; i -= 3 {
        s = s[0:i] + "," + s[i:]
    }
    if n >= 0 {
        return s
    }
    return "-" + s
}

func main() {
    limit := 1000000
    c := primeSieve(limit)
    s := sieve(63 * limit)
    untouchable := []int{2, 5}
    for n := 6; n <= limit; n += 2 {
        if !s[n] && c[n-1] && c[n-3] {
            untouchable = append(untouchable, n)
        }
    }
    fmt.Println("List of untouchable numbers <= 2,000:")
    count := 0
    for i := 0; untouchable[i] <= 2000; i++ {
        fmt.Printf("%6s", commatize(untouchable[i]))
        if (i+1)%10 == 0 {
            fmt.Println()
        }
        count++
    }
    fmt.Printf("\n\n%7s untouchable numbers were found  <=     2,000\n", commatize(count))
    p := 10
    count = 0
    for _, n := range untouchable {
        count++
        if n > p {
            cc := commatize(count - 1)
            cp := commatize(p)
            fmt.Printf("%7s untouchable numbers were found  <= %9s\n", cc, cp)
            p = p * 10
            if p == limit {
                break
            }
        }
    }
    cu := commatize(len(untouchable))
    cl := commatize(limit)
    fmt.Printf("%7s untouchable numbers were found  <= %s\n", cu, cl)
}


factor=: 3 : 0                          NB. explicit
 'primes powers'=. __&q: y
 input_to_cartesian_product=. primes ^&.> i.&.> >: powers
 cartesian_product=. , { input_to_cartesian_product
 , */&> cartesian_product
)

factor=: [: , [: */&> [: { [: (^&.> i.&.>@>:)/ __&q: NB. tacit

proper_divisors=: [: }: factor
sum_of_proper_divisors=: +/@proper_divisors

candidates=: 5 , [: +: [: #\@i. >[email protected]:  NB. within considered range, all but one candidate are even.
spds=:([:sum_of_proper_divisors"0(#\@i.-.i.&.:(p:inv))@*:)f.  NB. remove primes which contribute 1


using Primes

function properfactorsum(n)
    f = [one(n)]
    for (p,e) in factor(n)
        f = reduce(vcat, [f*p^j for j in 1:e], init=f)
    end
    pop!(f)
    return sum(f)
end

const maxtarget, sievelimit = 1_000_000, 512_000_000
const untouchables = ones(Bool, maxtarget)

for i in 2:sievelimit
    n = properfactorsum(i)
    if n <= maxtarget
        untouchables[n] = false
    end
end
for i in 6:maxtarget
    if untouchables[i] && (isprime(i - 1) || isprime(i - 3))
        untouchables[i] = false
    end
end

println("The untouchable numbers ≤ 2000 are: ")
for (i, n) in enumerate(filter(x -> untouchables[x], 1:2000))
    print(rpad(n, 5), i % 10 == 0 || i == 196 ? "\n" : "")
end
for N in [2000, 10, 100, 1000, 10_000, 100_000, 1_000_000]
    println("The count of untouchable numbers ≤ $N is: ", count(x -> untouchables[x], 1:N))
end


f = DivisorSigma[1, #] - # &;
limit = 10^5;
c = Not /@ PrimeQ[Range[limit]];
slimit = 15 limit;
s = ConstantArray[False, slimit + 1];
untouchable = {2, 5};
Do[
 val = f[i];
 If[val <= slimit,
  s[[val]] = True
  ]
 ,
 {i, 6, slimit}
]
Do[
 If[! s[[n]],
  If[c[[n - 1]],
   If[c[[n - 3]],
    AppendTo[untouchable, n]
    ]
   ]
  ]
 ,
 {n, 6, limit, 2}
]
Multicolumn[Select[untouchable, LessEqualThan[2000]]]
Count[untouchable, _?(LessEqualThan[2000])]
Count[untouchable, _?(LessEqualThan[10])]
Count[untouchable, _?(LessEqualThan[100])]
Count[untouchable, _?(LessEqualThan[1000])]
Count[untouchable, _?(LessEqualThan[10000])]
Count[untouchable, _?(LessEqualThan[100000])]


import math, strutils

const
  Lim1 = 100_000    # Limit for untouchable numbers.
  Lim2 = 14 * Lim1  # Limit for computation of sum of divisors.

proc sumdiv(n: uint): uint =
  ## Return the sum of the strict divisors of "n".
  result = 1
  let r = sqrt(n.float).uint
  let k = if (n and 1) == 0: 1u else: 2u
  for d in countup(k + 1, r, k):
    if n mod d == 0:
      result += d
      let q = n div d
      if q != d: result += q

var
  isSumDiv: array[1..Lim2, bool]
  isPrime: array[1..Lim1, bool]

# Fill both sieves in a single pass.
for n in 1u..Lim2:
  let s = sumdiv(n)
  if s <= Lim2:
    isSumDiv[s] = true
    if s == 1 and n <= Lim1:
      isPrime[n] = true
isPrime[1] = false

# Build list of untouchable numbers.
var list = @[2, 5]
for n in countup(6, Lim1, 2):
  if not (isSumDiv[n] or isPrime[n - 1] or isPrime[n - 3]):
    list.add n

echo "Untouchable numbers ≤ 2000:"
var count, lcount = 0
for n in list:
  if n <= 2000:
    stdout.write ($n).align(5)
    inc count
    inc lcount
    if lcount == 20:
      echo()
      lcount = 0
  else:
    if lcount > 0: echo()
    break

const CountMessage = "There are $1 untouchable numbers ≤ $2."
echo CountMessage.format(count, 2000), '\n'

count = 0
var lim = 10
for n in list:
  if n > lim:
    echo CountMessage.format(count, lim)
    lim *= 10
  inc count
if lim == Lim1:
  # Emit last message.
  echo CountMessage.format(count, lim)


program UntouchableNumbers;
program UntouchableNumbers;
{$IFDEF FPC}
  {$MODE DELPHI}  {$OPTIMIZATION ON,ALL}  {$COPERATORS ON}
  {$CODEALIGN proc=16,loop=4}
{$ELSE}
  {$APPTYPE CONSOLE}
{$ENDIF}
uses
  sysutils,strutils
{$IFDEF WINDOWS},Windows{$ENDIF}
  ;
const
  MAXPRIME = 1742537;
  //sqr(MaxPrime) = 3e12
  LIMIT =  5*1000*1000;
  LIMIT_mul = trunc(exp(ln(LIMIT)/3))+1;

const
  SizePrDeFe = 16*8192;//*size of(tprimeFac) =16 byte  2 Mb ~ level 3 cache
type
  tdigits = array [0..31] of Uint32;
  tprimeFac = packed record
                 pfSumOfDivs,
                 pfRemain : Uint64;
               end;
  tpPrimeFac = ^tprimeFac;

  tPrimeDecompField = array[0..SizePrDeFe-1] of tprimeFac;

  tPrimes = array[0..1 shl 17-1] of Uint32;

var
  {$ALIGN 16}
  PrimeDecompField :tPrimeDecompField;
  {$ALIGN 16}
  SmallPrimes: tPrimes;
  pdfIDX,pdfOfs: NativeInt;
  TD : Int64;

procedure OutCounts(pUntouch:pByte);
var
  n,cnt,lim,deltaLim : NativeInt;
Begin
  n := 0;
  cnt := 0;
  deltaLim := 100;
  lim := deltaLim;
  repeat
    cnt += 1-pUntouch[n];
    if n = lim then
    Begin
      writeln(Numb2USA(IntToStr(lim)):13,' ',Numb2USA(IntToStr(cnt)):12);
      lim += deltaLim;
      if lim = 10*deltaLim then
      begin
        deltaLim *=10;
        lim := deltaLim;
        writeln;
      end;
    end;

    inc(n);
  until n > LIMIT;
end;

function OutN(n:UInt64):UInt64;
begin
  write(Numb2USA(IntToStr(n)):15,' dt ',(GettickCount64-TD)/1000:5:3,' s'#13);
  TD := GettickCount64;
  result := n+LIMIT;
end;

//######################################################################
//gets sum of divisors of consecutive integers fast
procedure InitSmallPrimes;
//get primes. Sieving only odd numbers
var
  pr : array[0..MAXPRIME] of byte;
  p,j,d,flipflop :NativeUInt;
Begin
  SmallPrimes[0] := 2;
  fillchar(pr[0],SizeOf(pr),#0);
  p := 0;
  repeat
    repeat
      p +=1
    until pr[p]= 0;
    j := (p+1)*p*2;
    if j>MAXPRIME then
      BREAK;
    d := 2*p+1;
    repeat
      pr[j] := 1;
      j += d;
    until j>MAXPRIME;
  until false;

  SmallPrimes[1] := 3;
  SmallPrimes[2] := 5;
  j := 3;
  flipflop := (2+1)-1;//7+2*2->11+2*1->13 ,17 ,19 , 23
  p := 3;
  repeat
    if pr[p] = 0 then
    begin
      SmallPrimes[j] := 2*p+1;
      inc(j);
    end;
    p+=flipflop;
    flipflop := 3-flipflop;
  until (p > MAXPRIME) OR (j>High(SmallPrimes));
end;

function CnvtoBASE(var dgt:tDigits;n:Uint64;base:NativeUint):NativeInt;
//n must be multiple of base aka n mod base must be 0
var
  q,r: Uint64;
  i : NativeInt;
Begin
  fillchar(dgt,SizeOf(dgt),#0);
  i := 0;
  n := n div base;
  result := 0;
  repeat
    r := n;
    q := n div base;
    r  -= q*base;
    n := q;
    dgt[i] := r;
    inc(i);
  until (q = 0);
  //searching lowest pot in base
  result := 0;
  while (result<i) AND (dgt[result] = 0) do
    inc(result);
  inc(result);
end;

function IncByOneInBase(var dgt:tDigits;base:NativeInt):NativeInt;
var
  q :NativeInt;
Begin
  result := 0;
  q := dgt[result]+1;
  if q = base then
    repeat
      dgt[result] := 0;
      inc(result);
      q := dgt[result]+1;
    until q <> base;
  dgt[result] := q;
  result +=1;
end;

procedure CalcSumOfDivs(var pdf:tPrimeDecompField;var dgt:tDigits;n,k,pr:Uint64);
var
  fac,s :Uint64;
  j : Int32;
Begin
  //j is power of prime
  j := CnvtoBASE(dgt,n+k,pr);
  repeat
    fac := 1;
    s := 1;
    repeat
      fac *= pr;
      dec(j);
      s += fac;
    until j<= 0;
    with pdf[k] do
    Begin
      pfSumOfDivs *= s;
      pfRemain := pfRemain DIV fac;
    end;
    j := IncByOneInBase(dgt,pr);
    k += pr;
  until k >= SizePrDeFe;
end;

function SieveOneSieve(var pdf:tPrimeDecompField):boolean;
var
  dgt:tDigits;
  i,j,k,pr,n,MaxP : Uint64;
begin
  n := pdfOfs;
  if n+SizePrDeFe >= sqr(SmallPrimes[High(SmallPrimes)]) then
    EXIT(FALSE);
  //init
  for i := 0 to SizePrDeFe-1 do
  begin
    with pdf[i] do
    Begin
      pfSumOfDivs := 1;
      pfRemain := n+i;
    end;
  end;
  //first factor 2. Make n+i even
  i := (pdfIdx+n) AND 1;
  IF (n = 0) AND (pdfIdx<2)  then
    i := 2;

  repeat
    with pdf[i] do
    begin
      j := BsfQWord(n+i);
      pfRemain := (n+i) shr j;
      pfSumOfDivs := (Uint64(1) shl (j+1))-1;
    end;
    i += 2;
  until i >=SizePrDeFe;
  //i now index in SmallPrimes
  i := 0;
  maxP := trunc(sqrt(n+SizePrDeFe))+1;
  repeat
    //search next prime that is in bounds of sieve
    if n = 0 then
    begin
      repeat
        inc(i);
        pr := SmallPrimes[i];
        k := pr-n MOD pr;
        if k < SizePrDeFe then
          break;
      until pr > MaxP;
    end
    else
    begin
      repeat
        inc(i);
        pr := SmallPrimes[i];
        k := pr-n MOD pr;
        if (k = pr) AND (n>0) then
          k:= 0;
        if k < SizePrDeFe then
          break;
      until pr > MaxP;
    end;

    //no need to use higher primes
    if pr > maxP then
      BREAK;

    CalcSumOfDivs(pdf,dgt,n,k,pr);
  until false;

  //correct sum of & count of divisors
  for i := 0 to High(pdf) do
  Begin
    with pdf[i] do
    begin
      j := pfRemain;
      if j <> 1 then
        pfSumOFDivs *= (j+1);
    end;
  end;
  result := true;
end;

function NextSieve:boolean;
begin
  dec(pdfIDX,SizePrDeFe);
  inc(pdfOfs,SizePrDeFe);
  result := SieveOneSieve(PrimeDecompField);
end;

function GetNextPrimeDecomp:tpPrimeFac;
begin
  if pdfIDX >= SizePrDeFe then
    if Not(NextSieve) then
    Begin
      writeln('of limits ');
      EXIT(NIL);
    end;
  result := @PrimeDecompField[pdfIDX];
  inc(pdfIDX);
end;

function Init_Sieve(n:NativeUint):boolean;
//Init Sieve pdfIdx,pdfOfs are Global
begin
  pdfIdx := n MOD SizePrDeFe;
  pdfOfs := n-pdfIdx;
  result := SieveOneSieve(PrimeDecompField);
end;
//gets sum of divisors of consecutive integers fast
//######################################################################

procedure CheckRest(n: Uint64;pUntouch:pByte);
var
  k,lim : Uint64;
begin
  lim := 2*LIMIT;
  repeat
    k := GetNextPrimeDecomp^.pfSumOfDivs-n;
    inc(n);
    if Not(ODD(k)) AND (k<=LIMIT) then
      pUntouch[k] := 1;
  // showing still alive not for TIO.RUN
//    if n >= lim then  lim := OutN(n);
  until n >LIMIT_mul*LIMIT;
end;

var
  Untouch : array of byte;
  pUntouch: pByte;
  puQW  : pQword;
  T0:Int64;
  n,k : NativeInt;
Begin
  if sqrt(LIMIT_mul*LIMIT) >=MAXPRIME then
  Begin
    writeln('Need to extend count of primes > ',
      trunc(sqrt(LIMIT_mul*LIMIT))+1);
    HALT(0);
  end;

  setlength(untouch,LIMIT+8+1);
  pUntouch := @untouch[0];
  //Mark all odd as touchable
  puQW := @pUntouch[0];
  For n := 0 to LIMIT DIV 8 do puQW[n] := $0100010001000100;

  InitSmallPrimes;
  T0 := GetTickCount64;
  writeln('LIMIT = ',Numb2USA(IntToStr(LIMIT)));
  writeln('factor beyond LIMIT ',LIMIT_mul);

  n := 0;
  Init_Sieve(n);

  pUntouch[1] := 1;//all primes
  repeat
    k := GetNextPrimeDecomp^.pfSumOfDivs-n;
    inc(n);//n-> n+1
    if k <= LIMIT then
    begin
      If k <> 1 then
        pUntouch[k] := 1
      else
      begin
        //n-1 is prime p
        //mark p*p
        pUntouch[n] := 1;
        //mark 2*p
        //5 marked by prime 2 but that is p*p, but 4 has factor sum = 3
        pUntouch[n+2] := 1;
      end;
    end;
  until n > LIMIT-2;
  //unmark 5 and mark 0
  puntouch[5] := 0;
  pUntouch[0] := 1;

  //n=limit-1
  k := GetNextPrimeDecomp^.pfSumOfDivs-n;
  inc(n);
  If (k <> 1) AND (k<=LIMIT) then
    pUntouch[k] := 1
  else
    pUntouch[n] := 1;
  //n=limit
  k := GetNextPrimeDecomp^.pfSumOfDivs-n;
  If Not(odd(k)) AND (k<=LIMIT) then
    pUntouch[k] := 1;

  n:= limit+1;
  writeln('runtime for n<= LIMIT ',(GetTickCount64-T0)/1000:0:3,' s');
  writeln('Check the rest ',Numb2USA(IntToStr((LIMIT_mul-1)*Limit)));
  TD := GettickCount64;
  CheckRest(n,pUntouch);
  writeln('runtime ',(GetTickCount64-T0)/1000:0:3,' s');
  T0 := GetTickCount64-T0;

  OutCounts(pUntouch);
end.


use strict;
use warnings;
use enum qw(False True);
use ntheory qw/divisor_sum is_prime/;

sub sieve {
    my($n) = @_;
    my %s;
    for my $k (0 .. $n+1) {
        my $sum = divisor_sum($k) - $k;
        $s{$sum} = True if $sum <= $n+1;
    }
    %s
}

my(%s,%c);
my($max, $limit, $cnt) = (2000, 1e5, 0);

%s = sieve 14 * $limit;
!is_prime($_) and $c{$_} = True for 1..$limit;
my @untouchable = (2, 5);
for ( my $n = 6; $n <= $limit; $n += 2 ) {
   push @untouchable, $n if !$s{$n} and $c{$n-1} and $c{$n-3};
}
map { $cnt++ if $_ <= $max } @untouchable;
print "Number of untouchable numbers ≤ $max : $cnt \n\n" .
      (sprintf "@{['%6d' x $cnt]}", @untouchable[0..$cnt-1]) =~ s/(.{84})/$1\n/gr .  "\n";

my($p, $count) = (10, 0);
my $fmt = "%6d untouchable numbers were found  ≤ %7d\n";
for my $n (@untouchable) {
   $count++;
   if ($n > $p) {
      printf $fmt, $count-1, $p;
      printf($fmt, scalar @untouchable, $limit) and last if $limit == ($p *= 10)
   }
}


constant limz = {1,1,8,9,18,64} -- found by experiment

procedure untouchable(integer n, cols=0, tens=0)
    atom t0 = time(), t1 = t0+1
    bool tell = n>0
    n = abs(n)
    sequence sums = repeat(0,n+3)
    for i=1 to n do
        integer p = get_prime(i)
        if p>n then exit end if
        sums[p+1] = 1
        sums[p+3] = 1
    end for
    sums[5] = 0

    integer m = floor(log10(n))
    integer lim = limz[m]*n
    for j=2 to lim do
        integer y = sum(factors(j,-1))
        if y<=n then
            sums[y] = 1
        end if
        if platform()!=JS and time()>t1 then
            progress("j:%,d/%,d (%3.2f%%)\r",{j,lim,(j/lim)*100})
            t1 = time()+1
        end if
    end for
    if platform()!=JS then progress("") end if
    if tell then
        printf(1,"The list of all untouchable numbers <= %d:\n",{n})
    end if
    string line = "       2       5"
    integer cnt = 2
    for t=6 to n by 2 do
        if sums[t]=0 then
            cnt += 1
            if tell then
                line &= sprintf("%,8d",t)
                if remainder(cnt,cols)=0 then
                    printf(1,"%s\n",line)
                    line = ""
                end if
            end if
        end if
    end for
    if tell then
        if line!="" then
            printf(1,"%s\n",line)
        end if
        printf(1,"\n")
    end if
    string t = elapsed(time()-t0,1," (%s)")
    printf(1,"%,20d untouchable numbers were found <= %,d%s\n",{cnt,n,t})
    for p=1 to tens do
        untouchable(-power(10,p))
    end for
end procedure

untouchable(2000, 10, 6-(platform()==JS))


# 20210220 Raku programming solution

sub propdiv (\x) {
   my @l = 1 if x > 1;
   (2 .. x.sqrt.floor).map: -> \d {
      unless x % d { @l.push: d; my \y = x div d; @l.push: y if y != d }
   }
   @l
}

sub sieve (\n) {
   my %s;
   for (0..(n+1)) -> \k {
      given ( [+] propdiv k ) { %s{$_} = True if $_ ≤ (n+1) }
   }
   %s;
}

my \limit = 1e5;
my %c = ( grep { !.is-prime }, 1..limit ).Set; # store composites
my %s = sieve(14 * limit);
my @untouchable = 2, 5;

loop ( my \n = $ = 6 ; n ≤ limit ; n += 2 ) {
   @untouchable.append(n) if (!%s{n} && %c{n-1} && %c{n-3})
}

my ($c, $last) = 0, False;
for @untouchable.rotor(10) {
   say [~] @_».&{$c++ ; $_ > 2000 ?? ( $last = True and last ) !! .fmt: "%6d "}
   $c-- and last if $last
}

say "\nList of untouchable numbers ≤ 2,000 : $c \n";

my ($p, $count) = 10,0;
BREAK: for @untouchable -> \n {
   $count++;
   if (n > $p) {
      printf "%6d untouchable numbers were found  ≤ %7d\n", $count-1, $p;
      last BREAK if limit == ($p *= 10)
   }
}
printf "%6d untouchable numbers were found  ≤ %7d\n", +@untouchable, limit


/*REXX pgm finds N untouchable numbers (numbers that can't be equal to any aliquot sum).*/
parse arg n cols tens over .                     /*obtain optional arguments from the CL*/
if    n='' |    n==","            then    n=2000 /*Not specified?  Then use the default.*/
if cols='' | cols=="," | cols==0  then cols=  10 /* "       "        "   "   "      "   */
if tens='' | tens==","            then tens=   0 /* "       "        "   "   "      "   */
if over='' | over==","            then over=  20 /* "       "        "   "   "      "   */
tell= n>0;                             n= abs(n) /*N>0?  Then display the untouchable #s*/
call genP  n * over                              /*call routine to generate some primes.*/
u.= 0                                            /*define all possible aliquot sums ≡ 0.*/
          do p=1  for #;   _= @.p + 1;   u._= 1  /*any prime+1  is  not  an untouchable.*/
                           _= @.p + 3;   u._= 1  /* "  prime+3   "   "    "      "      */
          end   /*p*/                            /* [↑]  this will also rule out  5.    */
u.5= 0                                           /*special case as prime 2 + 3 sum to 5.*/
          do j=2  for lim;  if !.j  then iterate /*Is  J  a prime?   Yes, then skip it. */
          y= sigmaP()                            /*compute:  aliquot sum (sigma P) of J.*/
          if y<=n  then u.y= 1                   /*mark  Y  as a touchable if in range. */
          end  /*j*/
call show                                        /*maybe show untouchable #s and a count*/
if tens>0  then call powers                      /*Any "tens" specified?  Calculate 'em.*/
exit cnt                                         /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas: parse arg ?;  do jc=length(?)-3  to 1  by -3; ?=insert(',', ?, jc); end;  return ?
genSq:    do _=1  until _*_>lim;  q._= _*_;  end;  q._= _*_;  _= _+1;  q._= _*_;  return
grid:   $= $ right( commas(t), w);  if cnt//cols==0  then do;  say $;  $=;  end;  return
powers:   do pr=1  for tens;   call 'UNTOUCHA' -(10**pr);   end  /*recurse*/;     return
/*──────────────────────────────────────────────────────────────────────────────────────*/
genP: #= 9;  @.1=2; @.2=3; @.3=5; @.4=7; @.5=11; @.6=13; @.7=17; @.8=19; @.9=23 /*a list*/
      !.=0;  !.2=1; !.3=1; !.5=1; !.7=1; !.11=1; !.13=1; !.17=1; !.19=1  !.23=1 /*primes*/
      parse arg lim;   call genSq                /*define the (high) limit for searching*/
                                     qq.10= 100  /*define square of the 10th prime index*/
        do [email protected].#+6  by 2  to lim                 /*find odd primes from here on forward.*/
        parse var  j    ''  -1  _;   if     _==5  then iterate;  if j// 3==0  then iterate
        if j// 7==0  then iterate;   if j//11==0  then iterate;  if j//13==0  then iterate
        if j//17==0  then iterate;   if j//19==0  then iterate;  if j//23==0  then iterate
                                                 /*start dividing by the tenth prime: 29*/
                  do k=10  while qq.k <= j       /* [↓]  divide  J  by known odd primes.*/
                  if j//@.k==0  then iterate j   /*J ÷ by a prime?  Then ¬prime.   ___  */
                  end   /*k*/                    /* [↑]  only process numbers  ≤  √ J   */
        #= #+1;                     @.#= j       /*bump prime count; assign a new prime.*/
        !.j= 1;                    qq.#= j*j     /*mark prime;  compute square of prime.*/
        end             /*j*/;        return     /*#:  is the number of primes generated*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: w=7; $= right(2, w+1)  right(5, w)         /*start the list of an even prime and 5*/
                             cnt= 2              /*count of the only two primes in list.*/
        do t=6  by 2  to n;  if u.t then iterate /*Is  T  touchable?    Then skip it.   */
        cnt= cnt + 1;     if tell then call grid /*bump count;  maybe show a grid line. */
        end   /*t*/
                    if tell & $\==''  then say $ /*display a residual grid line, if any.*/
                    if tell           then say   /*show a spacing blank line for output.*/
      if n>0  then say right( commas(cnt), 20)  ,             /*indent the output a bit.*/
                     ' untouchable numbers were found  ≤ '    commas(n);            return
/*──────────────────────────────────────────────────────────────────────────────────────*/
sigmaP: s= 1                                     /*set initial sigma sum (S) to 1.   ___*/
        if j//2  then do m=3  by 2  while q.m<j  /*divide by odd integers up to the √ J */
                      if j//m==0  then s=s+m+j%m /*add the two divisors to the sum.     */
                      end   /*m*/                /* [↑]  process an odd integer.     ___*/
                 else do m=2        while q.m<j  /*divide by all integers up to the √ J */
                      if j//m==0  then s=s+m+j%m /*add the two divisors to the sum.     */
                      end   /*m*/                /* [↑]  process an even integer.    ___*/
        if q.m==j  then return s + m             /*Was  J  a square?   If so, add   √ J */
                        return s                 /*                    No, just return. */


import "/math" for Int, Nums
import "/seq" for Lst
import "/fmt" for Fmt

var sieve = Fn.new { |n|
    n = n + 1
    var s = List.filled(n+1, false)
    for (i in 0..n) {
        var sum = Nums.sum(Int.properDivisors(i))
        if (sum <= n) s[sum] = true
    }
    return s
}

var limit = 1e5
var c = Int.primeSieve(limit, false)
var s = sieve.call(14 * limit)
var untouchable = [2, 5]
var n = 6
while (n <= limit) {
    if (!s[n] && c[n-1] && c[n-3]) untouchable.add(n)
    n = n + 2
}

System.print("List of untouchable numbers <= 2,000:")
for (chunk in Lst.chunks(untouchable.where { |n| n <= 2000 }.toList, 10)) {
    Fmt.print("$,6d", chunk)
}
System.print()
Fmt.print("$,6d untouchable numbers were found  <=   2,000", untouchable.count { |n| n <= 2000 })
var p = 10
var count = 0
for (n in untouchable) {
    count = count + 1
    if (n > p) {
        Fmt.print("$,6d untouchable numbers were found  <= $,7d", count-1, p)
        p = p * 10
        if (p == limit) break
    }
}
Fmt.print("$,6d untouchable numbers were found  <= $,d", untouchable.count, limit)


T.enum EntryType
   EMPTY
   ENABLED
   DISABLED
   COMMENT
   IGNORE

T Entry
   EntryType etype
   String name
   String value

   F (etype, name = ‘’, value = ‘’)
      .etype = etype
      .name = name
      .value = value

T Config
   String path
   [Entry] entries

   F (path)
      .path = path
      L(=line) File(path).read_lines()
         line = line.ltrim(‘ ’)
         I line.empty
            .entries.append(Entry(EntryType.EMPTY))
         E I line[0] == ‘#’
            .entries.append(Entry(EntryType.COMMENT, line))
         E
            line = line.replace(re:‘[^a-zA-Z0-9\x20;]’, ‘’)
            V m = re:‘^(;*)\s*([a-zA-Z0-9]+)\s*([a-zA-Z0-9]*)’.search(line)
            I m & !m.group(2).empty
               V t = I m.group(1).empty {EntryType.ENABLED} E EntryType.DISABLED
               .addOption(m.group(2), m.group(3), t)

   F enableOption(name)
      Int? i = .getOptionIndex(name)
      I i != N
         .entries[i].etype = EntryType.ENABLED

   F disableOption(name)
      Int? i = .getOptionIndex(name)
      I i != N
         .entries[i].etype = EntryType.DISABLED

   F setOption(name, value)
      Int? i = .getOptionIndex(name)
      I i != N
         .entries[i].value = value

   F addOption(name, val, t = EntryType.ENABLED)
      .entries.append(Entry(t, name.uppercase(), val))

   F removeOption(name)
      Int? i = .getOptionIndex(name)
      I i != N
         .entries[i].etype = EntryType.IGNORE

   F getOptionIndex(name) -> Int?
      L(e) .entries
         I e.etype !C (EntryType.ENABLED, EntryType.DISABLED)
            L.continue
         I e.name == name.uppercase()
            R L.index
      R N

   F store()
      V f = File(.path, ‘w’)
      L(e) .entries
         I e.etype == EMPTY
            f.write("\n")
         E I e.etype == ENABLED
            f.write("#. #.\n".format(e.name, e.value))
         E I e.etype == DISABLED
            f.write("; #. #.\n".format(e.name, e.value))
         E I e.etype == COMMENT
            f.write(e.name"\n")

V cfg = Config(‘config.txt’)
cfg.enableOption(‘seedsremoved’)
cfg.disableOption(‘needspeeling’)
cfg.setOption(‘numberofbananas’, ‘1024’)
cfg.addOption(‘numberofstrawberries’, ‘62000’)
cfg.store()


; Author: AlephX, Aug 17 2011
data = %A_scriptdir%\rosettaconfig.txt
outdata = %A_scriptdir%\rosettaconfig.tmp
FileDelete, %outdata%

NUMBEROFBANANAS := 1024
numberofstrawberries := 560
NEEDSPEELING = "0"
FAVOURITEFRUIT := "bananas"
SEEDSREMOVED = "1"
BOOL0 = "0"
BOOL1 = "1"
NUMBER1 := 1
number0 := 0
STRINGA := "string here"

parameters = bool0|bool1|NUMBER1|number0|stringa|NEEDSPEELING|seedsremoved|numberofbananas|numberofstrawberries

Loop, Read, %data%, %outdata%
	{
	if (instr(A_LoopReadLine, "#") == 1 OR A_LoopReadLine == "")
		{
		Line := A_LoopReadLine
		}
	else
		{
		if instr(A_LoopReadLine, ";") == 1
			{
			parameter := RegExReplace(Substr(A_LoopReadLine,2), "^[ \s]+|[ \s]+$", "")

			parametervalue = %parameter%
			value := %parametervalue%
			if value == 0
				Line := A_loopReadLine
			else
				Line := Parameter
			}
		else
			{
			parameter := RegExReplace(A_LoopReadLine, "^[ \s]+|[ \s]+$", "")
			if instr(parameter, A_Space)
				parameter := substr(parameter, 1, instr(parameter, A_Space)-1)

			if instr(parameters, parameter) > 0
				{
				parametervalue = %parameter%
				value := %parametervalue%

				if (value = chr(34) . "0" . chr(34))
					Line := "; " . Parameter
				else
					{
					if (value = chr(34) . "1" . chr(34))
						Line := Parameter
					else
						Line = %parametervalue% %value%
					}
				}
			else
				Line := A_LoopReadLine
			}

		}
	StringReplace, parameters, parameters, %parametervalue%,,
	StringReplace, parameters, parameters,||,|

	FileAppend, %Line%`n
	}

Loop, parse, parameters,|
	{
	if (A_Loopfield <> "")
		{
		StringUpper, parameter, A_LoopField
		parametervalue = %parameter%
		value := %parametervalue%

		if (value = chr(34) . "0" . chr(34))
			Line := "; " . parameter
		else
			{
			if (value = chr(34) . "1" . chr(34))
				Line := parameter
			else
				Line = %parametervalue% %value%
			}

		FileAppend, %Line%`n, %outdata%
		}
	}

FileCopy, %A_scriptdir%\rosettaconfig.tmp, %A_scriptdir%\rosettaconfig.txt, 1