2
0

2 Commits aeb98de6cf ... e7e8713727

Autor SHA1 Nachricht Datum
  Chimrod e7e8713727 Updated the syntax with for...end vor 5 Monaten
  Chimrod a062bfee6d Updated the tests with the for...end syntax vor 5 Monaten
5 geänderte Dateien mit 79 neuen und 9 gelöschten Zeilen
  1. 3 0
      lib/qparser/idents.ml
  2. 17 0
      lib/qparser/parser.mly
  3. 1 0
      lib/qparser/tokens.mly
  4. 44 9
      lib/syntax/check.ml
  5. 14 0
      lib/syntax/locations.ml

+ 3 - 0
lib/qparser/idents.ml

@@ -61,6 +61,7 @@ let _ =
       ("END", END);
       ("END", END);
       ("EXEC", KEYWORD T.Exec);
       ("EXEC", KEYWORD T.Exec);
       ("EXIT", KEYWORD T.Exit);
       ("EXIT", KEYWORD T.Exit);
+      ("FOR", FOR);
       ("FREELIB", KEYWORD T.FreeLib);
       ("FREELIB", KEYWORD T.FreeLib);
       ("FUNC", FUNCTION T.Func);
       ("FUNC", FUNCTION T.Func);
       ("$FUNC", FUNCTION T.Func');
       ("$FUNC", FUNCTION T.Func');
@@ -141,12 +142,14 @@ let _ =
       ("SHOWSTAT", KEYWORD T.ShowStat);
       ("SHOWSTAT", KEYWORD T.ShowStat);
       ("STATTXT", IDENT "STATTXT");
       ("STATTXT", IDENT "STATTXT");
       ("$STATTXT", IDENT "$STATTXT");
       ("$STATTXT", IDENT "$STATTXT");
+      ("STEP", STEP);
       ("STR", FUNCTION T.Str);
       ("STR", FUNCTION T.Str);
       ("$STR", FUNCTION T.Str');
       ("$STR", FUNCTION T.Str');
       ("STRCOMP", FUNCTION T.Strcomp);
       ("STRCOMP", FUNCTION T.Strcomp);
       ("STRFIND", FUNCTION T.Strfind);
       ("STRFIND", FUNCTION T.Strfind);
       ("$STRFIND", FUNCTION T.Strfind');
       ("$STRFIND", FUNCTION T.Strfind');
       ("STRPOS", FUNCTION T.Strpos);
       ("STRPOS", FUNCTION T.Strpos);
+      ("TO", TO);
       ("TRIM", FUNCTION T.Trim);
       ("TRIM", FUNCTION T.Trim);
       ("$TRIM", FUNCTION T.Trim');
       ("$TRIM", FUNCTION T.Trim');
       ("UCASE", FUNCTION T.Ucase);
       ("UCASE", FUNCTION T.Ucase);

+ 17 - 0
lib/qparser/parser.mly

@@ -68,6 +68,23 @@ line_statement:
       { let {loc; expression; body;  _}  = a in 
       { let {loc; expression; body;  _}  = a in 
         Analyzer.Instruction.act loc ~label:expression body
         Analyzer.Instruction.act loc ~label:expression body
       }
       }
+    | FOR 
+      variable = variable
+      EQUAL
+      start = expression
+      TO 
+      to_ = expression
+      step = option(pair(STEP, expression))
+      COLUMN EOL+
+      s = line_statement*
+      END
+      {
+          let variable = Helper.variable variable in
+          let start = Analyzer.Expression.v start in
+          let to_ = Analyzer.Expression.v to_ in
+          let step = Option.map (fun v -> Analyzer.Expression.v (snd v)) step in
+          Analyzer.Instruction.for_ $loc variable ~start ~to_ ~step s
+      }
 
 
 (** Represent an instruction which can either be on a single line, 
 (** Represent an instruction which can either be on a single line, 
     or created in a block until an END 
     or created in a block until an END 

+ 1 - 0
lib/qparser/tokens.mly

@@ -41,6 +41,7 @@
 %token <Qsp_syntax.T.keywords>KEYWORD
 %token <Qsp_syntax.T.keywords>KEYWORD
 %token <Qsp_syntax.T.function_>FUNCTION
 %token <Qsp_syntax.T.function_>FUNCTION
 %token <Qsp_syntax.T.function_>FUNCTION_NOARGS
 %token <Qsp_syntax.T.function_>FUNCTION_NOARGS
+%token FOR TO STEP
 
 
 (* 
 (* 
 (b) if the token was declared left-associative, then the conflict is resolved
 (b) if the token was declared left-associative, then the conflict is resolved

+ 44 - 9
lib/syntax/check.ml

@@ -108,6 +108,9 @@ open StdLabels
 module Helper = struct
 module Helper = struct
   type 'a expr_list = { witness : 'a Id.typeid; values : 'a list }
   type 'a expr_list = { witness : 'a Id.typeid; values : 'a list }
 
 
+  (** Extract a list of statements from the argements. 
+      The function return the list in reverse order.
+   *)
   let expr_i : result array list -> 'a Id.typeid -> int -> 'a expr_list =
   let expr_i : result array list -> 'a Id.typeid -> int -> 'a expr_list =
    fun args witness i ->
    fun args witness i ->
     let result =
     let result =
@@ -118,6 +121,19 @@ module Helper = struct
           | Some value_1 -> { values = value_1 :: values; witness })
           | Some value_1 -> { values = value_1 :: values; witness })
     in
     in
     { result with values = result.values }
     { result with values = result.values }
+
+  let variable :
+      'a Id.typeid ->
+      int ->
+      (S.pos, result array) S.variable ->
+      (S.pos, 'a) S.variable =
+   fun typeid i { pos = var_pos; name; index } ->
+    let index_i =
+      Option.map
+        (fun expression -> Option.get (get typeid (Array.get expression i)))
+        index
+    in
+    S.{ pos = var_pos; name; index = index_i }
 end
 end
 
 
 module Make (A : App) = struct
 module Make (A : App) = struct
@@ -331,19 +347,12 @@ module Make (A : App) = struct
         T.assignation_operator ->
         T.assignation_operator ->
         expression ->
         expression ->
         t =
         t =
-     fun pos { pos = var_pos; name; index } op expression ->
+     fun pos variable op expression ->
       Array.init len ~f:(fun i ->
       Array.init len ~f:(fun i ->
           let (E { module_ = (module A); instr_witness; expr'; _ }) =
           let (E { module_ = (module A); instr_witness; expr'; _ }) =
             Array.get A.t i
             Array.get A.t i
           in
           in
-
-          let index_i =
-            Option.map
-              (fun expression ->
-                Option.get (get expr' (Array.get expression i)))
-              index
-          in
-          let variable = S.{ pos = var_pos; name; index = index_i } in
+          let variable = Helper.variable expr' i variable in
 
 
           match get expr' (Array.get expression i) with
           match get expr' (Array.get expression i) with
           | None -> failwith "Does not match"
           | None -> failwith "Does not match"
@@ -400,6 +409,32 @@ module Make (A : App) = struct
           let value = A.Instruction.if_ pos clause ~elifs ~else_ in
           let value = A.Instruction.if_ pos clause ~elifs ~else_ in
           R { value; witness = instr_witness })
           R { value; witness = instr_witness })
 
 
+    let for_ :
+        S.pos ->
+        (S.pos, expression) S.variable ->
+        start:expression ->
+        to_:expression ->
+        step:expression option ->
+        t list ->
+        t =
+     fun loc variable ~start ~to_ ~step statements ->
+      Array.init len ~f:(fun i ->
+          let (E { module_ = (module A); expr'; instr_witness; _ }) =
+            Array.get A.t i
+          in
+          let start = Option.get @@ get expr' (Array.get start i)
+          and to_ = Option.get @@ get expr' (Array.get to_ i)
+          and step = Option.bind step (fun v -> get expr' (Array.get v i))
+          and variable' = Helper.variable expr' i variable
+          and statements' =
+            List.rev (Helper.expr_i statements instr_witness i).values
+          in
+
+          let value =
+            A.Instruction.for_ loc variable' ~start ~to_ ~step statements'
+          in
+          R { value; witness = instr_witness })
+
     (** This code is almost a copy/paste from Expression.v but I did not found
     (** This code is almost a copy/paste from Expression.v but I did not found
         a way to factorize it. *)
         a way to factorize it. *)
     let v : t -> t' =
     let v : t -> t' =

+ 14 - 0
lib/syntax/locations.ml

@@ -140,6 +140,20 @@ module Instruction = struct
       Expression.t' ->
       Expression.t' ->
       t =
       t =
    fun _ _ _ _ -> Fun.id
    fun _ _ _ _ -> Fun.id
+
+  let for_ :
+      S.pos ->
+      (S.pos, Expression.t') S.variable ->
+      start:Expression.t' ->
+      to_:Expression.t' ->
+      step:Expression.t' option ->
+      t list ->
+      t =
+   fun _ _ ~start ~to_ ~step statements t ->
+    ignore start;
+    ignore to_;
+    ignore step;
+    List.fold_left statements ~init:t ~f:(fun t instruction -> instruction t)
 end
 end
 
 
 module Location = struct
 module Location = struct