@fraczak/k 6.2.0 → 6.2.1

package/Examples/bnat.k

@@ -0,0 +1,291 @@
+-- Standard binary encoding of natural numbers
+
+$ bnat = < {} _, bnat 0, bnat 1 >;
+
+_ = {}|_;
+_1 = |1;
+_0 = |0;
+
+bnat_0  = _ ;
+bnat_1  = _ _1 ;
+bnat_2  = _ _0 _1 ;
+bnat_3  = _ _1 _1 ;
+bnat_4  = _ _0 _0 _1 ;
+bnat_5  = _ _1 _0 _1 ;
+bnat_6  = _ _0 _1 _1 ;
+bnat_7  = _ _1 _1 _1 ;
+bnat_8  = _ _0 _0 _0 _1 ;
+bnat_9  = _ _1 _0 _0 _1 ;
+bnat_10 = _ _0 _1 _0 _1 ;
+
+remove_leading_zeros = < /0 remove_leading_zeros, () >;
+
+reverse = {() x, _ result} _reverse;
+
+_reverse =
+  ${bnat x, bnat result}
+  <
+    {.x/_ if, .result then} .then,
+    {.x/0 x, .result _0 result} _reverse,
+    {.x/1 x, .result _1 result} _reverse
+  >
+;
+
+append_0 = reverse _0 reverse; -- i.e., shift_left, double, or times2 
+
+$carry = <{} 0, {} 1>;
+c0 = {} |0 ;
+c1 = {} |1 ;
+
+$ pair = {bnat x, bnat y};
+
+plus = 
+  -- ${bnat x, bnat y} -- $ pair 
+  { 
+    .x remove_leading_zeros reverse x, 
+    .y remove_leading_zeros reverse y, 
+    c0 c 
+  } 
+  _plus 
+  reverse
+;
+
+_plus =
+  -- least significant bit first addition with carry
+  ${bnat x, bnat y, carry c}
+  <
+    {.x/_ if1, .y/_ if2, <.c/0 bnat_0, bnat_1> then} .then,
+    {.x/_ if1, .c/0 if2, .y                    then} .then,
+
+    {.x     y, .y/_ _ x, .c      c} _plus, -- swap x with y, if y = 0
+    {<.c/0 bnat_0, bnat_1> 
+            x, .y     y, .x/_ c0 c} _plus,
+
+    {.x/0   x, .y/0   y, .c/0 c0 c} _plus _0,
+    {.x/0   x, .y/0   y, .c/1 c0 c} _plus _1,
+    {.x/0   x, .y/1   y, .c/0 c0 c} _plus _1,
+    {.x/0   x, .y/1   y, .c/1 c1 c} _plus _0,
+    
+    {.x/1   x, .y/0   y, .c/0 c0 c} _plus _1,
+    {.x/1   x, .y/0   y, .c/1 c1 c} _plus _0,
+    
+    {.x/1   x, .y/1   y, .c/0 c1 c} _plus _0,
+    {.x/1   x, .y/1   y, .c/1 c1 c} _plus _1     
+  >
+;
+
+minus =
+  -- ${bnat x, bnat y}
+  { 
+    .x remove_leading_zeros reverse x,
+    .y remove_leading_zeros reverse y,
+    c0 c
+  }
+  _minus
+  reverse 
+  remove_leading_zeros
+;
+
+_minus =
+  -- least significat bit first substraction with carry
+  ${bnat x, bnat y, carry c}
+  <
+    {.x   x, .y/_   y, .c/0   if} .x,
+    {.x/1 x, .y/_   y, .c/1   if} .x _0,
+    {.x/0 x, .y/_ _ y, .c/1 c1 c} _minus _1,
+    {.x/0 x, .y/0   y, .c/0 c0 c} _minus _0,
+    {.x/0 x, .y/0   y, .c/1 c1 c} _minus _1,  
+    {.x/0 x, .y/1   y, .c/0 c1 c} _minus _1,
+    {.x/0 x, .y/1   y, .c/1 c1 c} _minus _0,
+    {.x/1 x, .y/0   y, .c/0 c0 c} _minus _1,
+    {.x/1 x, .y/0   y, .c/1 c0 c} _minus _0,
+    {.x/1 x, .y/1   y, .c/0 c0 c} _minus _0,
+    {.x/1 x, .y/1   y, .c/1 c1 c} _minus _1
+  >
+;
+
+times = 
+  -- ${bnat x, bnat y} 
+  { 
+    bnat_0 result, 
+    .x remove_leading_zeros reverse _x, 
+    .y remove_leading_zeros y 
+  } 
+  _times
+  reverse
+;
+
+_times =
+  ${bnat result, bnat _x, bnat y}
+  <
+    { .y/_ if, .result then } .then,
+    { .result _0                           result, ._x _x, .y/0 y } _times,
+    { { ._x x, .result _0 y, c0 c } _plus  result, ._x _x, .y/1 y } _times
+  >
+;
+
+inc = {() x, bnat_1 y} plus;
+dec = {() x, bnat_1 y} minus;
+
+mod =
+  -- ${bnat x, bnat y}
+  <
+    -- if x >= y then (x mod y) = ((x-y mod 2y) mod y)
+    { { minus x, .y append_0 y } mod x, .y y } mod,
+    -- else, i.e., if x < y then, (x mod y) = x 
+    .x
+  >
+; 
+
+align = 
+  -- ${bnat x, bnat y}
+  {
+    .x remove_leading_zeros reverse _x, 
+    .y remove_leading_zeros reverse _y, 
+    bnat_0 x, 
+    bnat_0 y
+  }
+  _align 
+;
+
+_align = 
+  ${bnat _x, bnat _y, bnat x, bnat y}
+  <
+    {._x/_ if1, ._y/_ if2, {.x x, .y y} then} .then,
+    {._x </0, /_ _> _x, ._y </0, /_ _> _y, .x _0 x, .y _0 y} _align,
+    {._x/1          _x, ._y </0, /_ _> _y, .x _1 x, .y _0 y} _align,
+    {._x </0, /_ _> _x, ._y/1          _y, .x _0 x, .y _1 y} _align,
+    {._x/1          _x, ._y/1          _y, .x _1 x, .y _1 y} _align
+  >
+;
+
+-- $compare = <{} lt, {} eq, {} gt >;
+lt = {} |lt;
+eq = {} |eq;
+gt = {} |gt;
+
+compare = align _compare;
+_compare = 
+  $pair -- ${bnat x, bnat y}
+  <
+    {.x/_ if1, .y/_ if2 } eq,
+    {.x/0 x, .y/0 y} _compare,
+    {.x/1 x, .y/1 y} _compare, 
+    .x/0 lt,
+    gt
+  >
+  -- $compare
+;
+
+zero? = remove_leading_zeros /_ bnat_0;
+eq? = {compare /eq if, () then} .then;
+gt? = {compare /gt if, () then} .then;
+lt? = {compare /lt if, () then} .then;
+ge? = < gt?, eq? >;
+le? = < lt?, eq? >;
+
+// gratest common divisor
+gcd = <gt?, {.y x,.x y}> _gcd;
+
+_gcd = <
+  { .y zero? if, .x then } .then,
+  { .y x, mod y } _gcd
+>;
+
+log2_floor =
+  -- ${bnat x, bnat step} 
+-- finds the largest k, such that 'step * 2^k <= x',
+-- returns k+1, i.e., 0 if x < step, and k+1 otherwise.
+  {.x x, .step step, bnat_0 log} _log2_floor;
+
+_log2_floor =
+  <
+    {{.step x, .x y} gt? if, .log then} .then,
+    {.x x, {.step x, bnat_0 y} gt? .x append_0 step, .log inc log} _log2_floor
+  >
+;
+
+append_n_times_0 = 
+  -- ${bnat x, bnat n}
+  <
+    {.n zero? if, .x then} .then,
+    {.x append_0 x, .n dec n} append_n_times_0
+  >
+;
+
+div = 
+  -- $pair -- ${bnat x, bnat y}
+  {.x x, .y step, bnat_0 res} _div
+;
+
+_div =
+  {
+    .x x,
+    .step step,
+    .res res,
+    {.x x, .step step} log2_floor log
+  }
+  < 
+    { .log zero? if, {.res div, .x rem} then } .then,
+    { 
+      -- {2 x, .log [(),1] MINUS count} rep TIMES factor,
+      { bnat_1 x, .log dec n} append_n_times_0 factor,
+      () i
+    }
+    {
+      {.i.x x, {.i.step x, .factor y} times y} minus x, 
+      .i.step step, 
+      {.i.res x, .factor y} plus res
+    } _div
+  >
+;
+
+lcm =
+  -- $pair -- ${bnat x, bnat y}
+  {times x, gcd y}
+  div .div
+;
+
+half =
+  reverse
+  <
+    {/0 reverse div, bnat_0 rem},
+    {/1 reverse div, bnat_1 rem},
+    {bnat_0 div, bnat_0 rem}
+  >
+;
+
+pow =
+  -- ${ bnat base, bnat exponent }
+  <
+    .exponent zero? bnat_1,
+    {.base base, .exponent half half}
+    {.base base, .half.rem extra, {.base base, .half.div exponent} pow {()x,()y} times pow}
+    <
+      {.extra zero? if, .pow then} .then,
+      {.base x, .pow y} times
+    >
+  >
+;
+
+sqrt =
+  <
+    { () x, {bnat_1 min, () max} range } _sqrt
+  >
+;
+
+_sqrt =
+  { () input, {.range.max x, .range.min y} plus half .div middle }
+  <
+    { .input.range.min x, .middle y} eq? .x,
+    { () aux, {.input.x x, .middle y} div .div middle }
+    { 
+      .aux.input.x x, 
+      { .aux.middle x, .middle y } < gt?, {.x y, .y x} > {.y min, .x max} range
+    } _sqrt
+  >
+;
+
+--------------------
+
+_log! lcm 

package/Examples/byte.k

@@ -0,0 +1,67 @@
+$ bit = < {} 0, {} 1 >;
+
+$ byte = { 
+  bit 0, bit 1, bit 2, bit 3,
+  bit 4, bit 5, bit 6, bit 7 
+};
+
+$ bytes = < {} nil, {byte car, bytes cdr} cons >;
+
+$ ascii = { bit 6, bit 5, bit 4, bit 3, bit 2, bit 1, bit 0 };
+
+$ u0080_07FF = { bit 10, bit 9, bit 8, bit 7, bit 6, bit 5, bit 4, bit 3, bit 2, bit 1, bit 0 };
+
+$ bmp_hi_common = <
+  { bit 2, bit 1, bit 0 } h08_0F,
+  { bit 6, bit 5, bit 4, bit 3, bit 2, bit 1, bit 0 } h10_7F,
+  { bit 6, bit 5, bit 4, bit 3, bit 2, bit 1, bit 0 } h80_CF,
+  { bit 2, bit 1, bit 0 } hD0_D7,
+  {} hF9,
+  { bit 0 } hFA_FB,
+  { bit 0 } hFC_FD,
+  { bit 0 } hFE_FF
+>;
+
+$ bmp_hi_private_use = <
+  { bit 3, bit 2, bit 1, bit 0 } hE0_EF,
+  { bit 2, bit 1, bit 0 } hF0_F7,
+  {} hF8
+>;
+
+$ plane_02_10 = <
+  { bit 0 } p02_03,
+  { bit 1, bit 0 } p04_07,
+  { bit 2, bit 1, bit 0 } p08_0F,
+  {} p10
+>;
+
+$ unicode = <
+  ascii ascii,
+  u0080_07FF plane0,
+  { bmp_hi_common hi, byte lo } bmp_common,
+  { bmp_hi_private_use hi, byte lo } bmp_private_use,
+  { byte mid, byte lo } supplementary_plane1,
+  { plane_02_10 plane, byte mid, byte lo } supplementary_planes2_16
+>;
+
+$ string = < {} nil, { unicode car, string cdr } cons >;
+
+0 = {}|0;
+1 = {}|1;
+
+_ = {1 6, 0 5, 1 4, 1 3, 1 2, 1 1, 1 0};
+map = $ unicode <
+  /ascii <
+    {.6/1 6, .5/1 5, .4/1 4, .3/1 3, .2/1 2, .1/1 1, .0/1 0 } _,
+    {{.6/0 6, .5/1 5} if, () then} .then,
+    {.6/1 if, () then} .then
+  >,
+  _
+> | ascii;
+
+filter = $string <
+  /cons {.car map car, .cdr filter cdr} | cons,
+  () 
+>;
+
+filter

package/Examples/code.k

@@ -0,0 +1,44 @@
+$ code = < fields product, fields union, chars ref >;
+$ fields = < {} nil, { chars car, fields cdr } cons >;
+$ chars = < 
+    chars" ", chars"!", chars'"', chars"#", chars"$", chars"%", chars"&", chars"'", 
+    chars"(", chars")", chars"*", chars"+", chars",", chars"-", chars".", chars"/", 
+    chars"0", chars"1", chars"2", chars"3", chars"4", chars"5", chars"6", chars"7", 
+    chars"8", chars"9", chars":", chars";", chars"<", chars"=", chars">", chars"?", 
+    chars"@", chars"A", chars"B", chars"C", chars"D", chars"E", chars"F", chars"G", 
+    chars"H", chars"I", chars"J", chars"K", chars"L", chars"M", chars"N", chars"O", 
+    chars"P", chars"Q", chars"R", chars"S", chars"T", chars"U", chars"V", chars"W", 
+    chars"X", chars"Y", chars"Z", chars"[", chars"\\", chars"]", chars"^", chars"_", 
+    chars"`", chars"a", chars"b", chars"c", chars"d", chars"e", chars"f", chars"g", 
+    chars"h", chars"i", chars"j", chars"k", chars"l", chars"m", chars"n", chars"o", 
+    chars"p", chars"q", chars"r", chars"s", chars"t", chars"u", chars"v", chars"w", 
+    chars"x", chars"y", chars"z", chars"{", chars"|", chars"}", chars"~",
+    {} end
+ >;
+ 
+ $ char = <
+    {}" ", {}"!", {}'"', {}"#", {}"$", {}"%", {}"&", {}"'", 
+    {}"(", {}")", {}"*", {}"+", {}",", {}"-", {}".", {}"/", 
+    {}"0", {}"1", {}"2", {}"3", {}"4", {}"5", {}"6", {}"7", 
+    {}"8", {}"9", {}":", {}";", {}"<", {}"=", {}">", {}"?", 
+    {}"@", {}"A", {}"B", {}"C", {}"D", {}"E", {}"F", {}"G", 
+    {}"H", {}"I", {}"J", {}"K", {}"L", {}"M", {}"N", {}"O", 
+    {}"P", {}"Q", {}"R", {}"S", {}"T", {}"U", {}"V", {}"W", 
+    {}"X", {}"Y", {}"Z", {}"[", {}"\\", {}"]", {}"^", {}"_", 
+    {}"`", {}"a", {}"b", {}"c", {}"d", {}"e", {}"f", {}"g", 
+    {}"h", {}"i", {}"j", {}"k", {}"l", {}"m", {}"n", {}"o", 
+    {}"p", {}"q", {}"r", {}"s", {}"t", {}"u", {}"v", {}"w", 
+    {}"x", {}"y", {}"z", {}"{", {}"|", {}"}", {}"~"
+ >;
+
+
+nil = {}|nil;
+_ = {}|end $chars;
+
+KL = _|L|K $chars;
+ 
+bool =  
+    { KL car, { KL car, nil cdr } | cons cdr } | cons | union
+$code;
+
+bool

package/Examples/esc.k

@@ -0,0 +1,9 @@
+$ utf8 = <{} '
+\u2601\u2600\u2602
+',
+{} '✅',
+{} 'tag \u2705',
+{} "strange and long tag name ✅"
+>;
+
+()