poke-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[COMMITTED] pkl: support for new indexing of trims


From: Jose E. Marchesi
Subject: [COMMITTED] pkl: support for new indexing of trims
Date: Mon, 16 Nov 2020 20:42:46 +0100
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux)

Up to now the ranges used to specify array trims were closed in both
sides, i.e:

[1,2,3][0:1] -> [1,2]
[0:0]        -> [1]
"foobar"[:3] -> "foo"

This patch changes poke so the right part of the interval is
interpreted as open, like in:

[1,2,3][0:1] -> [1]
[0:0]        -> []
"foo"[:3]    -> "foo"

This patch also adds an alternative syntax to specify ranges in
trimmers, in which the second part denotes the length of the trim:

[1,2,3,4,5][1+:3] -> [2,3,4]
[1,2,3][1+:0]     -> []
"foobarbaz"[3+:3] -> "bar"
"foobarbaz"[3+:0] -> ""
---
 ChangeLog                           | 48 +++++++++++++++++++++++++++++
 doc/poke.texi                       | 42 ++++++++++++++++---------
 etc/poke.rec                        | 24 ---------------
 libpoke/pkl-asm.pks                 | 14 ++++-----
 libpoke/pkl-ast.c                   |  9 +++++-
 libpoke/pkl-ast.h                   | 19 +++++++++---
 libpoke/pkl-gen.c                   | 16 ++++++++--
 libpoke/pkl-lex.l                   |  3 +-
 libpoke/pkl-pass.c                  |  2 ++
 libpoke/pkl-tab.y                   | 16 +++++++---
 libpoke/pkl-trans.c                 | 36 +++++++++++-----------
 libpoke/pvm.jitter                  | 17 ++++++++--
 testsuite/Makefile.am               |  9 ++++++
 testsuite/poke.map/maps-trims-1.pk  |  2 +-
 testsuite/poke.map/trimmed-map-2.pk |  2 +-
 testsuite/poke.map/trimmed-map-3.pk |  4 +--
 testsuite/poke.map/trimmed-map-4.pk |  4 +--
 testsuite/poke.pkl/getenv-1.pk      |  2 +-
 testsuite/poke.pkl/strings-esc-2.pk |  2 +-
 testsuite/poke.pkl/trim-10.pk       |  2 +-
 testsuite/poke.pkl/trim-11.pk       |  2 +-
 testsuite/poke.pkl/trim-13.pk       |  2 +-
 testsuite/poke.pkl/trim-15.pk       |  2 +-
 testsuite/poke.pkl/trim-19.pk       |  2 +-
 testsuite/poke.pkl/trim-20.pk       |  2 +-
 testsuite/poke.pkl/trim-21.pk       |  2 +-
 testsuite/poke.pkl/trim-22.pk       |  2 +-
 testsuite/poke.pkl/trim-23.pk       |  2 +-
 testsuite/poke.pkl/trim-25.pk       |  2 +-
 testsuite/poke.pkl/trim-26.pk       |  2 +-
 testsuite/poke.pkl/trim-27.pk       |  4 +++
 testsuite/poke.pkl/trim-28.pk       |  4 +++
 testsuite/poke.pkl/trim-29.pk       |  4 +++
 testsuite/poke.pkl/trim-30.pk       |  4 +++
 testsuite/poke.pkl/trim-31.pk       |  4 +++
 testsuite/poke.pkl/trim-32.pk       |  4 +++
 testsuite/poke.pkl/trim-33.pk       |  4 +++
 testsuite/poke.pkl/trim-34.pk       |  4 +++
 testsuite/poke.pkl/trim-35.pk       |  4 +++
 testsuite/poke.pkl/trim-5.pk        |  2 +-
 testsuite/poke.pkl/trim-6.pk        |  2 +-
 testsuite/poke.pkl/trim-7.pk        |  2 +-
 testsuite/poke.pkl/trim-8.pk        |  2 +-
 testsuite/poke.pkl/trim-9.pk        |  2 +-
 44 files changed, 236 insertions(+), 103 deletions(-)
 create mode 100644 testsuite/poke.pkl/trim-27.pk
 create mode 100644 testsuite/poke.pkl/trim-28.pk
 create mode 100644 testsuite/poke.pkl/trim-29.pk
 create mode 100644 testsuite/poke.pkl/trim-30.pk
 create mode 100644 testsuite/poke.pkl/trim-31.pk
 create mode 100644 testsuite/poke.pkl/trim-32.pk
 create mode 100644 testsuite/poke.pkl/trim-33.pk
 create mode 100644 testsuite/poke.pkl/trim-34.pk
 create mode 100644 testsuite/poke.pkl/trim-35.pk

diff --git a/ChangeLog b/ChangeLog
index 3314f012..2f3e268a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,51 @@
+2020-11-16  Jose E. Marchesi  <jemarch@gnu.org>
+
+       * libpoke/pkl-ast.h (PKL_AST_TRIMMER_ADDEND): Define.
+       (struct pkl_ast_trimmer): New field `addend'.
+       * libpoke/pkl-ast.c (pkl_ast_make_trimmer): Handle ADDEND.
+       (pkl_ast_node_free): Likewise.
+       (pkl_ast_print_1): Likewise.
+       * libpoke/pkl-pass.c (pkl_do_pass_1): Likewise.
+       * libpoke/pkl-tab.y: New toke RANGEA.
+       (primary): Rule for array trims based on +:.
+       * libpoke/pkl-lex.l: Handle RANGEA tokens.
+       * libpoke/pkl-gen.c (pkl_gen_pr_trimmer): Renamed from
+       pkl_gen_ps_trimmer, and adapted accordingly.
+       * libpoke/pkl-asm.pks (atrim): The TO boundaries in array trims
+       are now open.
+       * libpoke/pvm.jitter (substr): Likewise.
+       * testsuite/poke.map/maps-trims-1.pk: Adjust test accordingly.
+       * testsuite/poke.map/trimmed-map-2.pk: Likewise.
+       * testsuite/poke.map/trimmed-map-3.pk: Likewise.
+       * testsuite/poke.map/trimmed-map-4.pk: Likewise.
+       * testsuite/poke.pkl/getenv-1.pk: Likewise.
+       * testsuite/poke.pkl/strings-esc-2.pk: Likewise.
+       * testsuite/poke.pkl/trim-10.pk: Likewise.
+       * testsuite/poke.pkl/trim-11.pk: Likewise.
+       * testsuite/poke.pkl/trim-13.pk: Likewise.
+       * testsuite/poke.pkl/trim-15.pk: Likewise.
+       * testsuite/poke.pkl/trim-19.pk: Likewise.
+       * testsuite/poke.pkl/trim-20.pk: Likewise.
+       * testsuite/poke.pkl/trim-21.pk: Likewise.
+       * testsuite/poke.pkl/trim-22.pk: Likewise.
+       * testsuite/poke.pkl/trim-23.pk: Likewise.
+       * testsuite/poke.pkl/trim-25.pk: Likewise.
+       * testsuite/poke.pkl/trim-26.pk: Likewise.
+       * testsuite/poke.pkl/trim-27.pk: New test.
+       * testsuite/poke.pkl/trim-28.pk: Likewise.
+       * testsuite/poke.pkl/trim-29.pk: Likewise.
+       * testsuite/poke.pkl/trim-30.pk: Likewise.
+       * testsuite/poke.pkl/trim-31.pk: Likewise.
+       * testsuite/poke.pkl/trim-32.pk: Likewise.
+       * testsuite/poke.pkl/trim-33.pk: Likewise.
+       * testsuite/poke.pkl/trim-34.pk: Likewise.
+       * testsuite/poke.pkl/trim-35.pk: Likewise.
+       * testsuite/Makefile.am (EXTRA_DIST): Add new tests.
+       * doc/poke.texi (Modifying SBM Images): Update accordingly.
+       (Array Trimming): Likewise.
+       * etc/poke.rec (Use semi-open ranges in array trims): Removed as
+       done.
+
 2020-11-16  Jose E. Marchesi  <jemarch@gnu.org>
 
        * pickles/elf.pk (Elf64_Ehdr): Initialize e_version to EV_CURRENT.
diff --git a/doc/poke.texi b/doc/poke.texi
index c3a7f9db..f9b67547 100644
--- a/doc/poke.texi
+++ b/doc/poke.texi
@@ -3384,18 +3384,18 @@ Given an array like the line @code{l0}, we can obtain 
the desired
 portion of it by issuing:
 
 @example
-(poke) l0[1:2]
+(poke) l0[1:3]
 [[255UB,99UB,71UB],[255UB,99UB,71UB]]
 @end example
 
 @noindent
-Note how the limits of the interval specified in the trim reflect
-array indexes (hence 0 based) and are both inclusive.  The result of
-an array trimming is always another array, even if it contains just
-one element:
+Note how the limits of the semi-open interval specified in the trim
+reflect array indexes (hence 0 based) and are both inclusive.  The
+result of an array trimming is always another array, even if it
+contains just one element:
 
 @example
-(poke) l0[1:1]
+(poke) l0[1:2]
 [[255UB,99UB,71UB]]
 @end example
 
@@ -6529,23 +6529,24 @@ called @dfn{trimming}, allows you to extract a subset 
of the array, as
 another array.
 
 Trims use the following notation, where a range is specified between
-square brackets.  Both sides of the range are included:
+square brackets.  The left sides of the range are closed, whereas the
+right sides of the range are open:
 
 @example
-(poke) [1,2,3][0:1]
+(poke) [1,2,3][0:2]
 [1,2]
-(poke) [1,2,3][1:1]
+(poke) [1,2,3][1:2]
 [2]
-(poke) [1,2,3][0:2]
+(poke) [1,2,3][0:3]
 [1,2,3]
 @end example
 
 If the minimum side of the range is omitted, it is assumed to be zero.
 If the maximum side of the range is omitted, it is assumed to be the
-length of the trimmed array minus one:
+length of the trimmed array:
 
 @example
-(poke) [1,2,3][:1]
+(poke) [1,2,3][:2]
 [1,2]
 (poke) [1,2,3][1:]
 [2,3]
@@ -6559,7 +6560,7 @@ means that for simple types, copies of the elements are 
done:
 
 @example
 (poke) var a = [1,2,3]
-(poke) var s = a[1:1]
+(poke) var s = a[1:2]
 (poke) s[0] = 66
 (poke) a
 [1,2,3]
@@ -6570,12 +6571,25 @@ shared:
 
 @example
 (poke) var a = Packet[] @@ 0#B
-(poke) var s = a[1:1]
+(poke) var s = a[1:2]
 (poke) s[0].field = 66
 (poke) a[1].field
 66
 @end example
 
+There is an alternative syntax that can be used in order to denote
+trims, in which the length of the trim is specified instead of the
+index of the second element.  It has this form:
+
+@example
+(poke) [1,2,3][0+:3]
+[1,2,3]
+(poke) [1,2,3][1+:2]
+[2,3]
+(poke) [1,2,3][1+:0]
+[]
+@end example
+
 @node Array Elements
 @subsection Array Elements
 
diff --git a/etc/poke.rec b/etc/poke.rec
index 741e62f6..1589a949 100644
--- a/etc/poke.rec
+++ b/etc/poke.rec
@@ -2262,30 +2262,6 @@ Component: Other
 Kind: ENH
 Priority: 2
 
-Summary: Use semi-open ranges in array trims
-Component: Language
-Kind: ENH
-Priority: 4
-Description:
-+ At the moment the ranges used to specify array trims are closed in
-+ both sides, i.e:
-+
-+   [1,2,3][0:1] -> [1,2]
-+   [0:0] -> [1]
-+
-+ We want to change the range so the right part is interpreted as open,
-+ like in:
-+
-+   [1,2,3][0:1] -> [1]
-+   [0:0] -> []
-+
-+ Also, we want to support this alternative syntax: if +: is used
-+ instead of : in the range, the second part denotes the number of
-+ elements to include in the trim:
-+
-+   [1,2,3,4,5][1+:3] -> [2,3,4]
-Target: 1.0
-
 %rec: Release
 %key: Version
 %type: Version regexp /^[0-9]+\.[0-9]+$/
diff --git a/libpoke/pkl-asm.pks b/libpoke/pkl-asm.pks
index d5873b9f..6767d301 100644
--- a/libpoke/pkl-asm.pks
+++ b/libpoke/pkl-asm.pks
@@ -434,7 +434,7 @@
         pushvar $array          ; ARR
         sel                     ; ARR NELEM
         pushvar $to             ; ARR NELEM TO
-        lelu                    ; ARR NELEM TO (NELEM<=TO)
+        ltlu                    ; ARR NELEM TO (NELEM<TO)
         bnzi .ebounds
         drop                    ; ARR NELEM TO
         drop                    ; ARR NELEM
@@ -474,7 +474,7 @@
       .while
         pushvar $idx            ; TARR IDX
         pushvar $to             ; TARR IDX TO
-        lelu                    ; TARR IDX TO (IDX<=TO)
+        ltlu                    ; TARR IDX TO (IDX<TO)
         nip2                    ; TARR (IDX<=TO)
       .loop
         ;; Add the IDX-FROMth element of the new array.
@@ -534,12 +534,12 @@
         pushvar $from           ; BOFFSET MAPPER WRITER TO FROM
         sublu
         nip2                    ; BOFFSET MAPPER WRITER (TO-FROM)
-        push ulong<64>1
-        addlu
-        nip2                    ; BOFFSET MAPPER WRITER (TO-FROM+1UL)
+;        push ulong<64>1
+;        addlu
+;        nip2                    ; BOFFSET MAPPER WRITER (TO-FROM+1UL)
         ;; Install mapper, writer, offset and ebound.
-        pushvar $tarr           ; BOFFSET MAPPER WRITER (TO-FROM+!UL) TARR
-        swap                    ; BOFFSET MAPPER WRITER TARR (TO-FROM+!UL)
+        pushvar $tarr           ; BOFFSET MAPPER WRITER (TO-FROM) TARR
+        swap                    ; BOFFSET MAPPER WRITER TARR (TO-FROM)
         msetsel                 ; BOFFSET MAPPER WRITER TARR
         swap                    ; BOFFSET MAPPER TARR WRITER
         msetw                   ; BOFFSET MAPPER TARR
diff --git a/libpoke/pkl-ast.c b/libpoke/pkl-ast.c
index cb45ccee..b64c5503 100644
--- a/libpoke/pkl-ast.c
+++ b/libpoke/pkl-ast.c
@@ -259,15 +259,20 @@ pkl_ast_make_func_arg (pkl_ast ast, pkl_ast_node type,
 
 pkl_ast_node
 pkl_ast_make_trimmer (pkl_ast ast, pkl_ast_node entity,
-                      pkl_ast_node from, pkl_ast_node to)
+                      pkl_ast_node from, pkl_ast_node to,
+                      pkl_ast_node addend)
 {
   pkl_ast_node trimmer = pkl_ast_make_node (ast, PKL_AST_TRIMMER);
 
+  assert (!to || !addend);
+
   PKL_AST_TRIMMER_ENTITY (trimmer) = ASTREF (entity);
   if (from)
     PKL_AST_TRIMMER_FROM (trimmer) = ASTREF (from);
   if (to)
     PKL_AST_TRIMMER_TO (trimmer) = ASTREF (to);
+  if (addend)
+    PKL_AST_TRIMMER_ADDEND (trimmer) = ASTREF (addend);
 
   return trimmer;
 }
@@ -1959,6 +1964,7 @@ pkl_ast_node_free (pkl_ast_node ast)
       pkl_ast_node_free (PKL_AST_TRIMMER_ENTITY (ast));
       pkl_ast_node_free (PKL_AST_TRIMMER_FROM (ast));
       pkl_ast_node_free (PKL_AST_TRIMMER_TO (ast));
+      pkl_ast_node_free (PKL_AST_TRIMMER_ADDEND (ast));
       break;
 
     case PKL_AST_FUNC:
@@ -2752,6 +2758,7 @@ pkl_ast_print_1 (FILE *fp, pkl_ast_node ast, int indent)
       PRINT_AST_SUBAST (from, TRIMMER_FROM);
       PRINT_AST_SUBAST (to, TRIMMER_TO);
       PRINT_AST_SUBAST (entity, TRIMMER_ENTITY);
+      PRINT_AST_SUBAST (addend, TRIMMER_ADDEND);
       break;
 
     case PKL_AST_INDEXER:
diff --git a/libpoke/pkl-ast.h b/libpoke/pkl-ast.h
index 3065ae05..cdc734c0 100644
--- a/libpoke/pkl-ast.h
+++ b/libpoke/pkl-ast.h
@@ -656,14 +656,21 @@ pkl_ast_node pkl_ast_make_func_arg (pkl_ast ast,
    the index of the first element of the trim.  If FROM is NULL, then
    the index of the first element of the trim is 0.
 
-   TO is an expression that should evaluate to an uint<64>, which is
-   the index of the last element of the trim.  If TO is NULL, then the
-   indes of the last element of the trim is L-1, where L is the length
-   of ENTITY.  */
+   If not NULL, TO is an expression that should evaluate to an
+   uint<64>, which is the index of the last element of the trim plus
+   one.
+
+   If not NULL, ADDEND is an expression that should evaluate to an
+   uint<64>, which is the number to be added to FROM to find the index
+   of the last element included in the trim.
+
+   If both TO and ADDEND are NULL then the index of the last element
+   of the trim is L-1, where L is the length of ENTITY.  */
 
 #define PKL_AST_TRIMMER_ENTITY(AST) ((AST)->trimmer.entity)
 #define PKL_AST_TRIMMER_FROM(AST) ((AST)->trimmer.from)
 #define PKL_AST_TRIMMER_TO(AST) ((AST)->trimmer.to)
+#define PKL_AST_TRIMMER_ADDEND(AST) ((AST)->trimmer.addend)
 
 struct pkl_ast_trimmer
 {
@@ -672,12 +679,14 @@ struct pkl_ast_trimmer
   union pkl_ast_node *entity;
   union pkl_ast_node *from;
   union pkl_ast_node *to;
+  union pkl_ast_node *addend;
 };
 
 pkl_ast_node pkl_ast_make_trimmer (pkl_ast ast,
                                    pkl_ast_node entity,
                                    pkl_ast_node from,
-                                   pkl_ast_node to);
+                                   pkl_ast_node to,
+                                   pkl_ast_node addend);
 
 /* PKL_AST_INDEXER nodes represent references to an array element.
 
diff --git a/libpoke/pkl-gen.c b/libpoke/pkl-gen.c
index f3d20d0a..0c8cd069 100644
--- a/libpoke/pkl-gen.c
+++ b/libpoke/pkl-gen.c
@@ -1932,16 +1932,24 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_array)
 PKL_PHASE_END_HANDLER
 
 /*
+ * TRIMMER
  * | ENTITY
  * | FROM
  * | TO
- * TRIMMER
+ * | ADDEND
  */
 
-PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_trimmer)
+PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_trimmer)
 {
   pkl_ast_node trimmer = PKL_PASS_NODE;
   pkl_ast_node trimmer_type = PKL_AST_TYPE (trimmer);
+  pkl_ast_node trimmer_entity = PKL_AST_TRIMMER_ENTITY (trimmer);
+  pkl_ast_node trimmer_from = PKL_AST_TRIMMER_FROM (trimmer);
+  pkl_ast_node trimmer_to = PKL_AST_TRIMMER_TO (trimmer);
+
+  PKL_PASS_SUBPASS (trimmer_entity);
+  PKL_PASS_SUBPASS (trimmer_from);
+  PKL_PASS_SUBPASS (trimmer_to);
 
   switch (PKL_AST_TYPE_CODE (trimmer_type))
     {
@@ -1961,6 +1969,8 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_trimmer)
     default:
       assert (0);
     }
+
+  PKL_PASS_BREAK;
 }
 PKL_PHASE_END_HANDLER
 
@@ -3520,7 +3530,7 @@ struct pkl_phase pkl_phase_gen
    PKL_PHASE_PS_HANDLER (PKL_AST_SCONS, pkl_gen_ps_scons),
    PKL_PHASE_PR_HANDLER (PKL_AST_ARRAY, pkl_gen_pr_array),
    PKL_PHASE_PS_HANDLER (PKL_AST_ARRAY, pkl_gen_ps_array),
-   PKL_PHASE_PS_HANDLER (PKL_AST_TRIMMER, pkl_gen_ps_trimmer),
+   PKL_PHASE_PR_HANDLER (PKL_AST_TRIMMER, pkl_gen_pr_trimmer),
    PKL_PHASE_PS_HANDLER (PKL_AST_INDEXER, pkl_gen_ps_indexer),
    PKL_PHASE_PR_HANDLER (PKL_AST_ARRAY_INITIALIZER, 
pkl_gen_pr_array_initializer),
    PKL_PHASE_PS_HANDLER (PKL_AST_ARRAY_INITIALIZER, 
pkl_gen_ps_array_initializer),
diff --git a/libpoke/pkl-lex.l b/libpoke/pkl-lex.l
index 45b517a9..441e4f2d 100644
--- a/libpoke/pkl-lex.l
+++ b/libpoke/pkl-lex.l
@@ -253,7 +253,8 @@ S ::
 "int<"          { return INTCONSTR; }
 "offset<"       { return OFFSETCONSTR; }
 
-"..."                { return THREEDOTS; }
+"..."           { return THREEDOTS; }
+"+:"            { return RANGEA; }
 
 "*="                { return MULA; }
 "/="                { return DIVA; }
diff --git a/libpoke/pkl-pass.c b/libpoke/pkl-pass.c
index be722e37..d5c1c0f7 100644
--- a/libpoke/pkl-pass.c
+++ b/libpoke/pkl-pass.c
@@ -375,6 +375,8 @@ pkl_do_pass_1 (pkl_compiler compiler,
         PKL_PASS (PKL_AST_TRIMMER_FROM (node));
       if (PKL_AST_TRIMMER_TO (node))
         PKL_PASS (PKL_AST_TRIMMER_TO (node));
+      if (PKL_AST_TRIMMER_ADDEND (node))
+        PKL_PASS (PKL_AST_TRIMMER_ADDEND (node));
 
       break;
     case PKL_AST_INDEXER:
diff --git a/libpoke/pkl-tab.y b/libpoke/pkl-tab.y
index 8df48807..910d8a37 100644
--- a/libpoke/pkl-tab.y
+++ b/libpoke/pkl-tab.y
@@ -355,6 +355,8 @@ token <integer> UNION    _("keyword `union'")
 %token <opcode> XORA    _("bit-xor-and-assign operator")
 %token <opcode> IORA    _("bit-or-and-assign operator")
 
+%token RANGEA           _("range separator")
+
 %token OR               _("logical or operator")
 %token AND              _("logical and operator")
 %token '|'              _("bit-wise or operator")
@@ -943,28 +945,34 @@ primary:
                   $$ = pkl_ast_make_indexer (pkl_parser->ast, $1, $3);
                   PKL_AST_LOC ($$) = @$;
                 }
+        | primary '[' expression RANGEA expression ']' %prec '.'
+                {
+                  $$ = pkl_ast_make_trimmer (pkl_parser->ast,
+                                             $1, $3, NULL, $5);
+                  PKL_AST_LOC ($$) = @$;
+                }
         | primary '[' expression ':' expression ']' %prec '.'
                 {
                   $$ = pkl_ast_make_trimmer (pkl_parser->ast,
-                                             $1, $3, $5);
+                                             $1, $3, $5, NULL);
                   PKL_AST_LOC ($$) = @$;
                 }
         | primary '[' ':' ']' %prec '.'
                 {
                   $$ = pkl_ast_make_trimmer (pkl_parser->ast,
-                                             $1, NULL, NULL);
+                                             $1, NULL, NULL, NULL);
                   PKL_AST_LOC ($$) = @$;
                 }
         | primary '[' ':' expression ']' %prec '.'
                 {
                   $$ = pkl_ast_make_trimmer (pkl_parser->ast,
-                                             $1, NULL, $4);
+                                             $1, NULL, $4, NULL);
                   PKL_AST_LOC ($$) = @$;
                 }
         | primary '[' expression ':' ']' %prec '.'
                 {
                   $$ = pkl_ast_make_trimmer (pkl_parser->ast,
-                                             $1, $3, NULL);
+                                             $1, $3, NULL, NULL);
                   PKL_AST_LOC ($$) = @$;
                 }
         | funcall
diff --git a/libpoke/pkl-trans.c b/libpoke/pkl-trans.c
index 2fa40a7b..69398da6 100644
--- a/libpoke/pkl-trans.c
+++ b/libpoke/pkl-trans.c
@@ -557,6 +557,7 @@ PKL_PHASE_BEGIN_HANDLER (pkl_trans1_ps_trimmer)
   pkl_ast_node entity = PKL_AST_TRIMMER_ENTITY (trimmer);
   pkl_ast_node from = PKL_AST_TRIMMER_FROM (trimmer);
   pkl_ast_node to = PKL_AST_TRIMMER_TO (trimmer);
+  pkl_ast_node addend = PKL_AST_TRIMMER_ADDEND (trimmer);
 
   /* If the FROM index of a trimmer isn't specified, it defaults to
      0UL.  */
@@ -573,30 +574,29 @@ PKL_PHASE_BEGIN_HANDLER (pkl_trans1_ps_trimmer)
       PKL_AST_TRIMMER_FROM (trimmer) = ASTREF (from);
     }
 
-  /* If the TO index of a trimmer isn't specified, it defaults to an
-     expression that evaluates to the size of the container, minus
-     one.  */
-  if (!to)
+  if (addend)
     {
-      pkl_ast_node idx_type
-        = pkl_ast_make_integral_type (PKL_PASS_AST, 64, 0);
+      /* If an ADDEND is specified, we set `TO' to an expression that
+         evaluates to FROM + ADDEND.  */
+      pkl_ast_node plus_exp
+        = pkl_ast_make_binary_exp (PKL_PASS_AST,
+                                   PKL_AST_OP_ADD,
+                                   from, addend);
+
+      PKL_AST_TRIMMER_TO (trimmer) = ASTREF (plus_exp);
+      PKL_PASS_RESTART = 1;
+    }
+  else if (!to)
+    {
+      /* If the TO index of a trimmer isn't specified, it defaults to
+         an expression that evaluates to the size of the
+         container.  */
       pkl_ast_node length_op = pkl_ast_make_unary_exp (PKL_PASS_AST,
                                                        PKL_AST_OP_ATTR,
                                                        entity);
-      pkl_ast_node one = pkl_ast_make_integer (PKL_PASS_AST, 1);
-      pkl_ast_node sub_op = pkl_ast_make_binary_exp (PKL_PASS_AST,
-                                                     PKL_AST_OP_SUB,
-                                                     length_op, one);
 
       PKL_AST_EXP_ATTR (length_op) = PKL_AST_ATTR_LENGTH;
-      PKL_AST_TYPE (one) = ASTREF (idx_type);
-
-      PKL_AST_LOC (length_op) = PKL_AST_LOC (trimmer);
-      PKL_AST_LOC (idx_type) = PKL_AST_LOC (trimmer);
-      PKL_AST_LOC (one) = PKL_AST_LOC (trimmer);
-      PKL_AST_LOC (sub_op) = PKL_AST_LOC (trimmer);
-
-      PKL_AST_TRIMMER_TO (trimmer) = ASTREF (sub_op);
+      PKL_AST_TRIMMER_TO (trimmer) = ASTREF (length_op);
       PKL_PASS_RESTART = 1;
     }
 }
diff --git a/libpoke/pvm.jitter b/libpoke/pvm.jitter
index c9c9757e..fb1dc46d 100644
--- a/libpoke/pvm.jitter
+++ b/libpoke/pvm.jitter
@@ -3413,20 +3413,33 @@ instruction strref () # ( STR ULONG -- STR ULONG VAL )
   end
 end
 
+# Instruction: substr
+#
+# Given a string and two indexes FROM AND to conforming a semi-open
+# interval [FROM,TO), push the substring enclosed by that interval.
+#
+# Both indexes are zero-based.
+#
+# If FROM >= the size of the string, or if TO > the size of the
+# string, or if FROM >= TO, raise the PVM_E_OUT_OF_BOUNDS exception.
+#
+# Stack: ( STR ULONG(from) ULONG(to) -- STR ULONG(from) ULONG(to) STR )
+# Exceptions: PVM_E_OUT_OF_BOUNDS
+
 instruction substr () # ( STR ULONG ULONG -- STR ULONG ULONG STR )
   code
     pvm_val str;
     char *s;
     pvm_val to = JITTER_TOP_STACK ();
     pvm_val from = JITTER_UNDER_TOP_STACK ();
-    size_t slen = PVM_VAL_ULONG (to) - PVM_VAL_ULONG (from) + 1;
+    size_t slen = PVM_VAL_ULONG (to) - PVM_VAL_ULONG (from);
 
     JITTER_DROP_STACK ();
     str = JITTER_UNDER_TOP_STACK ();
     JITTER_PUSH_STACK (to);
 
     if (PVM_VAL_ULONG (from) >= strlen (PVM_VAL_STR (str))
-        || PVM_VAL_ULONG (to) >= strlen (PVM_VAL_STR (str))
+        || PVM_VAL_ULONG (to) > strlen (PVM_VAL_STR (str))
         || PVM_VAL_ULONG (from) > PVM_VAL_ULONG (to))
         PVM_RAISE_DFL (PVM_E_OUT_OF_BOUNDS);
 
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
index 8420aad8..64ed8a51 100644
--- a/testsuite/Makefile.am
+++ b/testsuite/Makefile.am
@@ -1519,6 +1519,15 @@ EXTRA_DIST = \
   poke.pkl/trim-24.pk \
   poke.pkl/trim-25.pk \
   poke.pkl/trim-26.pk \
+  poke.pkl/trim-27.pk \
+  poke.pkl/trim-28.pk \
+  poke.pkl/trim-29.pk \
+  poke.pkl/trim-30.pk \
+  poke.pkl/trim-31.pk \
+  poke.pkl/trim-32.pk \
+  poke.pkl/trim-33.pk \
+  poke.pkl/trim-34.pk \
+  poke.pkl/trim-35.pk \
   poke.pkl/trim-diag-1.pk \
   poke.pkl/trim-diag-2.pk \
   poke.pkl/trim-diag-3.pk \
diff --git a/testsuite/poke.map/maps-trims-1.pk 
b/testsuite/poke.map/maps-trims-1.pk
index d759b558..63a09846 100644
--- a/testsuite/poke.map/maps-trims-1.pk
+++ b/testsuite/poke.map/maps-trims-1.pk
@@ -2,5 +2,5 @@
 /* { dg-data {c*} {0x10 0x20 0x30 0x40  0x50 0x60 0x70 0x80   0x90 0xa0 0xb0 
0xc0} } */
 
 /* { dg-command { .set obase 16 } } */
-/* { dg-command { (byte[2] @ 1#B)[0:1] } } */
+/* { dg-command { (byte[2] @ 1#B)[0:2] } } */
 /* { dg-output "\\\[0x20UB,0x30UB\\\]" } */
diff --git a/testsuite/poke.map/trimmed-map-2.pk 
b/testsuite/poke.map/trimmed-map-2.pk
index 3dbdf335..e1503ec0 100644
--- a/testsuite/poke.map/trimmed-map-2.pk
+++ b/testsuite/poke.map/trimmed-map-2.pk
@@ -4,7 +4,7 @@
 /* { dg-command {.set obase 16} } */
 /* { dg-command {.set endian big} } */
 /* { dg-command { var a = int[3] @ 0#B } } */
-/* { dg-command { var b = a[1:1] } } */
+/* { dg-command { var b = a[1:2] } } */
 /* { dg-command { b[0] = 0x0eadbeef } } */
 /* { dg-command { a[1] } } */
 /* { dg-output "0xeadbeef" } */
diff --git a/testsuite/poke.map/trimmed-map-3.pk 
b/testsuite/poke.map/trimmed-map-3.pk
index 100f2f5b..b1a90a9c 100644
--- a/testsuite/poke.map/trimmed-map-3.pk
+++ b/testsuite/poke.map/trimmed-map-3.pk
@@ -4,8 +4,8 @@
 /* { dg-command {.set obase 16} } */
 /* { dg-command {.set endian big} } */
 /* { dg-command { var a = int[12#B] @ 0#B } } */
-/* { dg-command { var b = a[1:2] } } */
-/* { dg-command { var c = a[0:1] } } */
+/* { dg-command { var b = a[1:3] } } */
+/* { dg-command { var c = a[0:2] } } */
 /* { dg-command { a[1] = 0xeadbeef } } */
 /* { dg-command { a } } */
 /* { dg-output "\\\[0x10203040,0xeadbeef,0x90a0b0c0\\\]" } */
diff --git a/testsuite/poke.map/trimmed-map-4.pk 
b/testsuite/poke.map/trimmed-map-4.pk
index 8b03978c..e9517149 100644
--- a/testsuite/poke.map/trimmed-map-4.pk
+++ b/testsuite/poke.map/trimmed-map-4.pk
@@ -4,8 +4,8 @@
 /* { dg-command {.set obase 16} } */
 /* { dg-command {.set endian big} } */
 /* { dg-command { var a = int[] @ 0#B } } */
-/* { dg-command { var b = a[1:2] } } */
-/* { dg-command { var c = a[0:1] } } */
+/* { dg-command { var b = a[1:3] } } */
+/* { dg-command { var c = a[0:2] } } */
 /* { dg-command { a[1] = 0xeadbeef } } */
 /* { dg-command { a } } */
 /* { dg-output "\\\[0x10203040,0xeadbeef,0x90a0b0c0\\\]" } */
diff --git a/testsuite/poke.pkl/getenv-1.pk b/testsuite/poke.pkl/getenv-1.pk
index 6c513738..4c81f209 100644
--- a/testsuite/poke.pkl/getenv-1.pk
+++ b/testsuite/poke.pkl/getenv-1.pk
@@ -6,5 +6,5 @@
 var picklesdir = getenv ("POKEPICKLESDIR");
 var length = picklesdir'length;
 
-/* { dg-command { picklesdir[length-8:length-1] } } */
+/* { dg-command { picklesdir[length-8:length] } } */
 /* { dg-output {"/pickles"} } */
diff --git a/testsuite/poke.pkl/strings-esc-2.pk 
b/testsuite/poke.pkl/strings-esc-2.pk
index 6922d20c..10a1928f 100644
--- a/testsuite/poke.pkl/strings-esc-2.pk
+++ b/testsuite/poke.pkl/strings-esc-2.pk
@@ -21,5 +21,5 @@ var s = "He\x1llo \x12\x123, World!";
 /* { dg-command {s[9]} } */
 /* { dg-output "\n0x33UB" } */
 
-/* { dg-command {s[0:1] + s[3:5] + s[10:]} } */
+/* { dg-command {s[0:2] + s[3:6] + s[10:]} } */
 /* { dg-output "\n\"Hello, World!\"" } */
diff --git a/testsuite/poke.pkl/trim-10.pk b/testsuite/poke.pkl/trim-10.pk
index 7e0260ff..de970460 100644
--- a/testsuite/poke.pkl/trim-10.pk
+++ b/testsuite/poke.pkl/trim-10.pk
@@ -1,4 +1,4 @@
 /* { dg-do run } */
 
-/* { dg-command { "foo"[1:1] } } */
+/* { dg-command { "foo"[1:2] } } */
 /* { dg-output "\"o\"" } */
diff --git a/testsuite/poke.pkl/trim-11.pk b/testsuite/poke.pkl/trim-11.pk
index 7e48cd33..a30272ba 100644
--- a/testsuite/poke.pkl/trim-11.pk
+++ b/testsuite/poke.pkl/trim-11.pk
@@ -1,4 +1,4 @@
 /* { dg-do run } */
 
-/* { dg-command { try "foo"[:3]; catch if E_out_of_bounds { print "caught\n"; 
} } } */
+/* { dg-command { try "foo"[:4]; catch if E_out_of_bounds { print "caught\n"; 
} } } */
 /* { dg-output "caught" } */
diff --git a/testsuite/poke.pkl/trim-13.pk b/testsuite/poke.pkl/trim-13.pk
index 594f5f4b..fd0f21ad 100644
--- a/testsuite/poke.pkl/trim-13.pk
+++ b/testsuite/poke.pkl/trim-13.pk
@@ -1,4 +1,4 @@
 /* { dg-do run } */
 
-/* { dg-command { try [1,2,3][:3]; catch if E_out_of_bounds { print 
"caught\n"; } } } */
+/* { dg-command { try [1,2,3][:4]; catch if E_out_of_bounds { print 
"caught\n"; } } } */
 /* { dg-output "caught" } */
diff --git a/testsuite/poke.pkl/trim-15.pk b/testsuite/poke.pkl/trim-15.pk
index 7c066603..f5f27470 100644
--- a/testsuite/poke.pkl/trim-15.pk
+++ b/testsuite/poke.pkl/trim-15.pk
@@ -1,4 +1,4 @@
 /* { dg-do run } */
 
-/* { dg-command { try [1,2,3][2:1]; catch if E_out_of_bounds { print 
"caught\n"; } } } */
+/* { dg-command { try [1,2,3][2:4]; catch if E_out_of_bounds { print 
"caught\n"; } } } */
 /* { dg-output "caught" } */
diff --git a/testsuite/poke.pkl/trim-19.pk b/testsuite/poke.pkl/trim-19.pk
index 6acc3d43..9f4bfb00 100644
--- a/testsuite/poke.pkl/trim-19.pk
+++ b/testsuite/poke.pkl/trim-19.pk
@@ -1,4 +1,4 @@
 /* { dg-do run } */
 
-/* { dg-command { [1,2,3][2:2] } } */
+/* { dg-command { [1,2,3][2:3] } } */
 /* { dg-output "\\\[3\\\]" } */
diff --git a/testsuite/poke.pkl/trim-20.pk b/testsuite/poke.pkl/trim-20.pk
index e9c3e3b2..c9e0fa32 100644
--- a/testsuite/poke.pkl/trim-20.pk
+++ b/testsuite/poke.pkl/trim-20.pk
@@ -1,4 +1,4 @@
 /* { dg-do run } */
 
-/* { dg-command { [1,2,3][:2] } } */
+/* { dg-command { [1,2,3][:3] } } */
 /* { dg-output "\\\[1,2,3\\\]" } */
diff --git a/testsuite/poke.pkl/trim-21.pk b/testsuite/poke.pkl/trim-21.pk
index ec34670c..119c3749 100644
--- a/testsuite/poke.pkl/trim-21.pk
+++ b/testsuite/poke.pkl/trim-21.pk
@@ -1,4 +1,4 @@
 /* { dg-do run } */
 
-/* { dg-command { [1,2,3][:1] } } */
+/* { dg-command { [1,2,3][:2] } } */
 /* { dg-output "\\\[1,2\\\]" } */
diff --git a/testsuite/poke.pkl/trim-22.pk b/testsuite/poke.pkl/trim-22.pk
index e19ad73b..fe8583b7 100644
--- a/testsuite/poke.pkl/trim-22.pk
+++ b/testsuite/poke.pkl/trim-22.pk
@@ -1,4 +1,4 @@
 /* { dg-do run } */
 
-/* { dg-command { [1,2,3][:0] } } */
+/* { dg-command { [1,2,3][:1] } } */
 /* { dg-output "\\\[1\\\]" } */
diff --git a/testsuite/poke.pkl/trim-23.pk b/testsuite/poke.pkl/trim-23.pk
index eb6af5a2..3c9940bc 100644
--- a/testsuite/poke.pkl/trim-23.pk
+++ b/testsuite/poke.pkl/trim-23.pk
@@ -1,4 +1,4 @@
 /* { dg-do run } */
 
-/* { dg-command { [1,2,3][0:0] } } */
+/* { dg-command { [1,2,3][0:1] } } */
 /* { dg-output "\\\[1\\\]" } */
diff --git a/testsuite/poke.pkl/trim-25.pk b/testsuite/poke.pkl/trim-25.pk
index 461be771..7ccd5a44 100644
--- a/testsuite/poke.pkl/trim-25.pk
+++ b/testsuite/poke.pkl/trim-25.pk
@@ -1,6 +1,6 @@
 /* { dg-do run } */
 
-var x = [1,2,3][1:2];
+var x = [1,2,3][1:3];
 
 /* { dg-command {.set obase 10} } */
 /* { dg-command { x[1] = 20 } } */
diff --git a/testsuite/poke.pkl/trim-26.pk b/testsuite/poke.pkl/trim-26.pk
index 2b6fbf87..84a5bf02 100644
--- a/testsuite/poke.pkl/trim-26.pk
+++ b/testsuite/poke.pkl/trim-26.pk
@@ -1,7 +1,7 @@
 /* { dg-do run } */
 
 var a = [1,2,3];
-var b = a[0:1];
+var b = a[0:2];
 
 /* { dg-command { a == b } } */
 /* { dg-output "0" } */
diff --git a/testsuite/poke.pkl/trim-27.pk b/testsuite/poke.pkl/trim-27.pk
new file mode 100644
index 00000000..9fe8da77
--- /dev/null
+++ b/testsuite/poke.pkl/trim-27.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command { "foo"[1:1] } } */
+/* { dg-output "\"\"" } */
diff --git a/testsuite/poke.pkl/trim-28.pk b/testsuite/poke.pkl/trim-28.pk
new file mode 100644
index 00000000..5ea05f00
--- /dev/null
+++ b/testsuite/poke.pkl/trim-28.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command { [1,2,3][1:1] } } */
+/* { dg-output "\\\[\\\]" } */
diff --git a/testsuite/poke.pkl/trim-29.pk b/testsuite/poke.pkl/trim-29.pk
new file mode 100644
index 00000000..e537405e
--- /dev/null
+++ b/testsuite/poke.pkl/trim-29.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {[1,2,3,4][1+:1]} } */
+/* { dg-output "\\\[2\\\]" } */
diff --git a/testsuite/poke.pkl/trim-30.pk b/testsuite/poke.pkl/trim-30.pk
new file mode 100644
index 00000000..7efcbcca
--- /dev/null
+++ b/testsuite/poke.pkl/trim-30.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {[1,2,3,4][1+:2]} } */
+/* { dg-output "\\\[2,3\\\]" } */
diff --git a/testsuite/poke.pkl/trim-31.pk b/testsuite/poke.pkl/trim-31.pk
new file mode 100644
index 00000000..2c169995
--- /dev/null
+++ b/testsuite/poke.pkl/trim-31.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {try [1,2,3,4][1+:4]; catch if E_out_of_bounds { printf 
"caught\n"; } } } */
+/* { dg-output "caught" } */
diff --git a/testsuite/poke.pkl/trim-32.pk b/testsuite/poke.pkl/trim-32.pk
new file mode 100644
index 00000000..545d1cd8
--- /dev/null
+++ b/testsuite/poke.pkl/trim-32.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {try [1,2,3,4][1+:-3]; catch if E_out_of_bounds { printf 
"caught\n"; } } } */
+/* { dg-output "caught" } */
diff --git a/testsuite/poke.pkl/trim-33.pk b/testsuite/poke.pkl/trim-33.pk
new file mode 100644
index 00000000..629fd3cf
--- /dev/null
+++ b/testsuite/poke.pkl/trim-33.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {"foobar"[1+:1]} } */
+/* { dg-output "\"o\"" } */
diff --git a/testsuite/poke.pkl/trim-34.pk b/testsuite/poke.pkl/trim-34.pk
new file mode 100644
index 00000000..a5e78d27
--- /dev/null
+++ b/testsuite/poke.pkl/trim-34.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {try "foobar"[1+:-3]; catch if E_out_of_bounds { printf 
"caught\n"; } } } */
+/* { dg-output "caught" } */
diff --git a/testsuite/poke.pkl/trim-35.pk b/testsuite/poke.pkl/trim-35.pk
new file mode 100644
index 00000000..98a666f4
--- /dev/null
+++ b/testsuite/poke.pkl/trim-35.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {"foobar"[1+:0]} } */
+/* { dg-output "\"\"" } */
diff --git a/testsuite/poke.pkl/trim-5.pk b/testsuite/poke.pkl/trim-5.pk
index bc5f8dd3..a95ee12b 100644
--- a/testsuite/poke.pkl/trim-5.pk
+++ b/testsuite/poke.pkl/trim-5.pk
@@ -1,4 +1,4 @@
 /* { dg-do run } */
 
-/* { dg-command { "foo"[2:2] } } */
+/* { dg-command { "foo"[2:3] } } */
 /* { dg-output "\"o\"" } */
diff --git a/testsuite/poke.pkl/trim-6.pk b/testsuite/poke.pkl/trim-6.pk
index 63d6f1b5..4d9c3bca 100644
--- a/testsuite/poke.pkl/trim-6.pk
+++ b/testsuite/poke.pkl/trim-6.pk
@@ -1,4 +1,4 @@
 /* { dg-do run } */
 
-/* { dg-command { "foo"[:2] } } */
+/* { dg-command { "foo"[:3] } } */
 /* { dg-output "\"foo\"" } */
diff --git a/testsuite/poke.pkl/trim-7.pk b/testsuite/poke.pkl/trim-7.pk
index 04df318c..91fe917b 100644
--- a/testsuite/poke.pkl/trim-7.pk
+++ b/testsuite/poke.pkl/trim-7.pk
@@ -1,4 +1,4 @@
 /* { dg-do run } */
 
-/* { dg-command { "foo"[:1] } } */
+/* { dg-command { "foo"[:2] } } */
 /* { dg-output "\"fo\"" } */
diff --git a/testsuite/poke.pkl/trim-8.pk b/testsuite/poke.pkl/trim-8.pk
index cf49e5fd..519395ea 100644
--- a/testsuite/poke.pkl/trim-8.pk
 +++ b/testsuite/poke.pkl/trim-8.pk
@@ -1,4 +1,4 @@
 /* { dg-do run } */
 
-/* { dg-command { "foo"[:0] } } */
+/* { dg-command { "foo"[:1] } } */
 /* { dg-output "\"f\"" } */
diff --git a/testsuite/poke.pkl/trim-9.pk b/testsuite/poke.pkl/trim-9.pk
index 91c368dd..25255e06 100644
--- a/testsuite/poke.pkl/trim-9.pk
+++ b/testsuite/poke.pkl/trim-9.pk
@@ -1,4 +1,4 @@
 /* { dg-do run } */
 
-/* { dg-command { "foo"[1:2] } } */
+/* { dg-command { "foo"[1:3] } } */
 /* { dg-output "\"oo\"" } */
-- 
2.25.0.2.g232378479e




reply via email to

[Prev in Thread] Current Thread [Next in Thread]